FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record );
   6 use vars qw( @EXPORT_OK $DEBUG $me $conf
   7              @encrypted_fields
   8              $import $ignore_expired_card
   9              $skip_fuzzyfiles @fuzzyfields
  10              @paytypes
  11            );
  12 use vars qw( $realtime_bop_decline_quiet ); #ugh
  13 use Safe;
  14 use Carp;
  15 use Exporter;
  16 use Scalar::Util qw( blessed );
  17 use List::Util qw( min );
  18 use Time::Local qw(timelocal);
  19 use Data::Dumper;
  20 use Tie::IxHash;
  21 use Digest::MD5 qw(md5_base64);
  22 use Date::Format;
  23 #use Date::Manip;
  24 use File::Temp qw( tempfile );
  25 use String::Approx qw(amatch);
  26 use Business::CreditCard 0.28;
  27 use Locale::Country;
  28 use FS::UID qw( getotaker dbh driver_name );
  29 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  30 use FS::Misc qw( generate_email send_email generate_ps do_print );
  31 use FS::Msgcat qw(gettext);
  32 use FS::payby;
  33 use FS::cust_pkg;
  34 use FS::cust_svc;
  35 use FS::cust_bill;
  36 use FS::cust_bill_pkg;
  37 use FS::cust_bill_pkg_display;
  38 use FS::cust_bill_pkg_tax_location;
  39 use FS::cust_bill_pkg_tax_rate_location;
  40 use FS::cust_pay;
  41 use FS::cust_pay_pending;
  42 use FS::cust_pay_void;
  43 use FS::cust_pay_batch;
  44 use FS::cust_credit;
  45 use FS::cust_refund;
  46 use FS::part_referral;
  47 use FS::cust_main_county;
  48 use FS::cust_location;
  49 use FS::cust_class;
  50 use FS::cust_main_exemption;
  51 use FS::cust_tax_adjustment;
  52 use FS::tax_rate;
  53 use FS::tax_rate_location;
  54 use FS::cust_tax_location;
  55 use FS::part_pkg_taxrate;
  56 use FS::agent;
  57 use FS::cust_main_invoice;
  58 use FS::cust_credit_bill;
  59 use FS::cust_bill_pay;
  60 use FS::prepay_credit;
  61 use FS::queue;
  62 use FS::part_pkg;
  63 use FS::part_event;
  64 use FS::part_event_condition;
  65 use FS::part_export;
  66 #use FS::cust_event;
  67 use FS::type_pkgs;
  68 use FS::payment_gateway;
  69 use FS::agent_payment_gateway;
  70 use FS::banned_pay;
  71 use FS::TicketSystem;
  72
  73 @EXPORT_OK = qw( smart_search );
  74
  75 $realtime_bop_decline_quiet = 0;
  76
  77 # 1 is mostly method/subroutine entry and options
  78 # 2 traces progress of some operations
  79 # 3 is even more information including possibly sensitive data
  80 $DEBUG = 0;
  81 $me = '[FS::cust_main]';
  82
  83 $import = 0;
  84 $ignore_expired_card = 0;
  85
  86 $skip_fuzzyfiles = 0;
  87 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  88
  89 @encrypted_fields = ('payinfo', 'paycvv');
  90 sub nohistory_fields { ('payinfo', 'paycvv'); }
  91
  92 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  93
  94 #ask FS::UID to run this stuff for us later
  95 #$FS::UID::callback{'FS::cust_main'} = sub {
  96 install_callback FS::UID sub {
  97   $conf = new FS::Conf;
  98   #yes, need it for stuff below (prolly should be cached)
  99 };
 100
 101 sub _cache {
 102   my $self = shift;
 103   my ( $hashref, $cache ) = @_;
 104   if ( exists $hashref->{'pkgnum'} ) {
 105     #@{ $self->{'_pkgnum'} } = ();
 106     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 107     $self->{'_pkgnum'} = $subcache;
 108     #push @{ $self->{'_pkgnum'} },
 109     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 110   }
 111 }
 112
 113 =head1 NAME
 114
 115 FS::cust_main - Object methods for cust_main records
 116
 117 =head1 SYNOPSIS
 118
 119   use FS::cust_main;
 120
 121   $record = new FS::cust_main \%hash;
 122   $record = new FS::cust_main { 'column' => 'value' };
 123
 124   $error = $record->insert;
 125
 126   $error = $new_record->replace($old_record);
 127
 128   $error = $record->delete;
 129
 130   $error = $record->check;
 131
 132   @cust_pkg = $record->all_pkgs;
 133
 134   @cust_pkg = $record->ncancelled_pkgs;
 135
 136   @cust_pkg = $record->suspended_pkgs;
 137
 138   $error = $record->bill;
 139   $error = $record->bill %options;
 140   $error = $record->bill 'time' => $time;
 141
 142   $error = $record->collect;
 143   $error = $record->collect %options;
 144   $error = $record->collect 'invoice_time'   => $time,
 145                           ;
 146
 147 =head1 DESCRIPTION
 148
 149 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 150 FS::Record.  The following fields are currently supported:
 151
 152 =over 4
 153
 154 =item custnum
 155
 156 Primary key (assigned automatically for new customers)
 157
 158 =item agentnum
 159
 160 Agent (see L<FS::agent>)
 161
 162 =item refnum
 163
 164 Advertising source (see L<FS::part_referral>)
 165
 166 =item first
 167
 168 First name
 169
 170 =item last
 171
 172 Last name
 173
 174 =item ss
 175
 176 Cocial security number (optional)
 177
 178 =item company
 179
 180 (optional)
 181
 182 =item address1
 183
 184 =item address2
 185
 186 (optional)
 187
 188 =item city
 189
 190 =item county
 191
 192 (optional, see L<FS::cust_main_county>)
 193
 194 =item state
 195
 196 (see L<FS::cust_main_county>)
 197
 198 =item zip
 199
 200 =item country
 201
 202 (see L<FS::cust_main_county>)
 203
 204 =item daytime
 205
 206 phone (optional)
 207
 208 =item night
 209
 210 phone (optional)
 211
 212 =item fax
 213
 214 phone (optional)
 215
 216 =item ship_first
 217
 218 Shipping first name
 219
 220 =item ship_last
 221
 222 Shipping last name
 223
 224 =item ship_company
 225
 226 (optional)
 227
 228 =item ship_address1
 229
 230 =item ship_address2
 231
 232 (optional)
 233
 234 =item ship_city
 235
 236 =item ship_county
 237
 238 (optional, see L<FS::cust_main_county>)
 239
 240 =item ship_state
 241
 242 (see L<FS::cust_main_county>)
 243
 244 =item ship_zip
 245
 246 =item ship_country
 247
 248 (see L<FS::cust_main_county>)
 249
 250 =item ship_daytime
 251
 252 phone (optional)
 253
 254 =item ship_night
 255
 256 phone (optional)
 257
 258 =item ship_fax
 259
 260 phone (optional)
 261
 262 =item payby
 263
 264 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 265
 266 =item payinfo
 267
 268 Payment Information (See L<FS::payinfo_Mixin> for data format)
 269
 270 =item paymask
 271
 272 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 273
 274 =item paycvv
 275
 276 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
 277
 278 =item paydate
 279
 280 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 281
 282 =item paystart_month
 283
 284 Start date month (maestro/solo cards only)
 285
 286 =item paystart_year
 287
 288 Start date year (maestro/solo cards only)
 289
 290 =item payissue
 291
 292 Issue number (maestro/solo cards only)
 293
 294 =item payname
 295
 296 Name on card or billing name
 297
 298 =item payip
 299
 300 IP address from which payment information was received
 301
 302 =item tax
 303
 304 Tax exempt, empty or `Y'
 305
 306 =item usernum
 307
 308 Order taker (see L<FS::access_user>)
 309
 310 =item comments
 311
 312 Comments (optional)
 313
 314 =item referral_custnum
 315
 316 Referring customer number
 317
 318 =item spool_cdr
 319
 320 Enable individual CDR spooling, empty or `Y'
 321
 322 =item dundate
 323
 324 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 325
 326 =item squelch_cdr
 327
 328 Discourage individual CDR printing, empty or `Y'
 329
 330 =back
 331
 332 =head1 METHODS
 333
 334 =over 4
 335
 336 =item new HASHREF
 337
 338 Creates a new customer.  To add the customer to the database, see L<"insert">.
 339
 340 Note that this stores the hash reference, not a distinct copy of the hash it
 341 points to.  You can ask the object for a copy with the I<hash> method.
 342
 343 =cut
 344
 345 sub table { 'cust_main'; }
 346
 347 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 348
 349 Adds this customer to the database.  If there is an error, returns the error,
 350 otherwise returns false.
 351
 352 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 353 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 354 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 355 hash reference is equivalent to not supplying this parameter.  There should be
 356 a better explanation of this, but until then, here's an example:
 357
 358   use Tie::RefHash;
 359   tie %hash, 'Tie::RefHash'; #this part is important
 360   %hash = (
 361     $cust_pkg => [ $svc_acct ],
 362     ...
 363   );
 364   $cust_main->insert( \%hash );
 365
 366 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 367 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 368 expected and rollback the entire transaction; it is not necessary to call
 369 check_invoicing_list first.  The invoicing_list is set after the records in the
 370 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 371 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 372
 373   $cust_main->insert( {}, [ $email, 'POST' ] );
 374
 375 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 376
 377 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 378 on the supplied jobnum (they will not run until the specific job completes).
 379 This can be used to defer provisioning until some action completes (such
 380 as running the customer's credit card successfully).
 381
 382 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 383 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 384 the B<reexport> method.)
 385
 386 The I<tax_exemption> option can be set to an arrayref of tax names.
 387 FS::cust_main_exemption records will be created and inserted.
 388
 389 =cut
 390
 391 sub insert {
 392   my $self = shift;
 393   my $cust_pkgs = @_ ? shift : {};
 394   my $invoicing_list = @_ ? shift : '';
 395   my %options = @_;
 396   warn "$me insert called with options ".
 397        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 398     if $DEBUG;
 399
 400   local $SIG{HUP} = 'IGNORE';
 401   local $SIG{INT} = 'IGNORE';
 402   local $SIG{QUIT} = 'IGNORE';
 403   local $SIG{TERM} = 'IGNORE';
 404   local $SIG{TSTP} = 'IGNORE';
 405   local $SIG{PIPE} = 'IGNORE';
 406
 407   my $oldAutoCommit = $FS::UID::AutoCommit;
 408   local $FS::UID::AutoCommit = 0;
 409   my $dbh = dbh;
 410
 411   my $prepay_identifier = '';
 412   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 413   my $payby = '';
 414   if ( $self->payby eq 'PREPAY' ) {
 415
 416     $self->payby('BILL');
 417     $prepay_identifier = $self->payinfo;
 418     $self->payinfo('');
 419
 420     warn "  looking up prepaid card $prepay_identifier\n"
 421       if $DEBUG > 1;
 422
 423     my $error = $self->get_prepay( $prepay_identifier,
 424                                    'amount_ref'     => \$amount,
 425                                    'seconds_ref'    => \$seconds,
 426                                    'upbytes_ref'    => \$upbytes,
 427                                    'downbytes_ref'  => \$downbytes,
 428                                    'totalbytes_ref' => \$totalbytes,
 429                                  );
 430     if ( $error ) {
 431       $dbh->rollback if $oldAutoCommit;
 432       #return "error applying prepaid card (transaction rolled back): $error";
 433       return $error;
 434     }
 435
 436     $payby = 'PREP' if $amount;
 437
 438   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 439
 440     $payby = $1;
 441     $self->payby('BILL');
 442     $amount = $self->paid;
 443
 444   }
 445
 446   warn "  inserting $self\n"
 447     if $DEBUG > 1;
 448
 449   $self->signupdate(time) unless $self->signupdate;
 450
 451   $self->auto_agent_custid()
 452     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 453
 454   my $error = $self->SUPER::insert;
 455   if ( $error ) {
 456     $dbh->rollback if $oldAutoCommit;
 457     #return "inserting cust_main record (transaction rolled back): $error";
 458     return $error;
 459   }
 460
 461   warn "  setting invoicing list\n"
 462     if $DEBUG > 1;
 463
 464   if ( $invoicing_list ) {
 465     $error = $self->check_invoicing_list( $invoicing_list );
 466     if ( $error ) {
 467       $dbh->rollback if $oldAutoCommit;
 468       #return "checking invoicing_list (transaction rolled back): $error";
 469       return $error;
 470     }
 471     $self->invoicing_list( $invoicing_list );
 472   }
 473
 474   warn "  setting cust_main_exemption\n"
 475     if $DEBUG > 1;
 476
 477   my $tax_exemption = delete $options{'tax_exemption'};
 478   if ( $tax_exemption ) {
 479     foreach my $taxname ( @$tax_exemption ) {
 480       my $cust_main_exemption = new FS::cust_main_exemption {
 481         'custnum' => $self->custnum,
 482         'taxname' => $taxname,
 483       };
 484       my $error = $cust_main_exemption->insert;
 485       if ( $error ) {
 486         $dbh->rollback if $oldAutoCommit;
 487         return "inserting cust_main_exemption (transaction rolled back): $error";
 488       }
 489     }
 490   }
 491
 492   if (    $conf->config('cust_main-skeleton_tables')
 493        && $conf->config('cust_main-skeleton_custnum') ) {
 494
 495     warn "  inserting skeleton records\n"
 496       if $DEBUG > 1;
 497
 498     my $error = $self->start_copy_skel;
 499     if ( $error ) {
 500       $dbh->rollback if $oldAutoCommit;
 501       return $error;
 502     }
 503
 504   }
 505
 506   warn "  ordering packages\n"
 507     if $DEBUG > 1;
 508
 509   $error = $self->order_pkgs( $cust_pkgs,
 510                               %options,
 511                               'seconds_ref'    => \$seconds,
 512                               'upbytes_ref'    => \$upbytes,
 513                               'downbytes_ref'  => \$downbytes,
 514                               'totalbytes_ref' => \$totalbytes,
 515                             );
 516   if ( $error ) {
 517     $dbh->rollback if $oldAutoCommit;
 518     return $error;
 519   }
 520
 521   if ( $seconds ) {
 522     $dbh->rollback if $oldAutoCommit;
 523     return "No svc_acct record to apply pre-paid time";
 524   }
 525   if ( $upbytes || $downbytes || $totalbytes ) {
 526     $dbh->rollback if $oldAutoCommit;
 527     return "No svc_acct record to apply pre-paid data";
 528   }
 529
 530   if ( $amount ) {
 531     warn "  inserting initial $payby payment of $amount\n"
 532       if $DEBUG > 1;
 533     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 534     if ( $error ) {
 535       $dbh->rollback if $oldAutoCommit;
 536       return "inserting payment (transaction rolled back): $error";
 537     }
 538   }
 539
 540   unless ( $import || $skip_fuzzyfiles ) {
 541     warn "  queueing fuzzyfiles update\n"
 542       if $DEBUG > 1;
 543     $error = $self->queue_fuzzyfiles_update;
 544     if ( $error ) {
 545       $dbh->rollback if $oldAutoCommit;
 546       return "updating fuzzy search cache: $error";
 547     }
 548   }
 549
 550   # cust_main exports!
 551   warn "  exporting\n" if $DEBUG > 1;
 552
 553   my $export_args = $options{'export_args'} || [];
 554
 555   my @part_export =
 556     map qsearch( 'part_export', {exportnum=>$_} ),
 557       $conf->config('cust_main-exports'); #, $agentnum
 558
 559   foreach my $part_export ( @part_export ) {
 560     my $error = $part_export->export_insert($self, @$export_args);
 561     if ( $error ) {
 562       $dbh->rollback if $oldAutoCommit;
 563       return "exporting to ". $part_export->exporttype.
 564              " (transaction rolled back): $error";
 565     }
 566   }
 567
 568   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 569   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 570   #      if $DEBUG;
 571   #    foreach my $jobnum ( @jobnums ) {
 572   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 573   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 574   #        if $DEBUG;
 575   #      my $error = $queue->depend_insert($depend_jobnum);
 576   #      if ( $error ) {
 577   #        $dbh->rollback if $oldAutoCommit;
 578   #        return "error queuing job dependancy: $error";
 579   #      }
 580   #    }
 581   #  }
 582   #
 583   #}
 584   #
 585   #if ( exists $options{'jobnums'} ) {
 586   #  push @{ $options{'jobnums'} }, @jobnums;
 587   #}
 588
 589   warn "  insert complete; committing transaction\n"
 590     if $DEBUG > 1;
 591
 592   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 593   '';
 594
 595 }
 596
 597 use File::CounterFile;
 598 sub auto_agent_custid {
 599   my $self = shift;
 600
 601   my $format = $conf->config('cust_main-auto_agent_custid');
 602   my $agent_custid;
 603   if ( $format eq '1YMMXXXXXXXX' ) {
 604
 605     my $counter = new File::CounterFile 'cust_main.agent_custid';
 606     $counter->lock;
 607
 608     my $ym = 100000000000 + time2str('%y%m00000000', time);
 609     if ( $ym > $counter->value ) {
 610       $counter->{'value'} = $agent_custid = $ym;
 611       $counter->{'updated'} = 1;
 612     } else {
 613       $agent_custid = $counter->inc;
 614     }
 615
 616     $counter->unlock;
 617
 618   } else {
 619     die "Unknown cust_main-auto_agent_custid format: $format";
 620   }
 621
 622   $self->agent_custid($agent_custid);
 623
 624 }
 625
 626 sub start_copy_skel {
 627   my $self = shift;
 628
 629   #'mg_user_preference' => {},
 630   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 631   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 632   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 633   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 634   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 635   die $@ if $@;
 636
 637   _copy_skel( 'cust_main',                                 #tablename
 638               $conf->config('cust_main-skeleton_custnum'), #sourceid
 639               $self->custnum,                              #destid
 640               @tables,                                     #child tables
 641             );
 642 }
 643
 644 #recursive subroutine, not a method
 645 sub _copy_skel {
 646   my( $table, $sourceid, $destid, %child_tables ) = @_;
 647
 648   my $primary_key;
 649   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 650     ( $table, $primary_key ) = ( $1, $2 );
 651   } else {
 652     my $dbdef_table = dbdef->table($table);
 653     $primary_key = $dbdef_table->primary_key
 654       or return "$table has no primary key".
 655                 " (or do you need to run dbdef-create?)";
 656   }
 657
 658   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 659        join (', ', keys %child_tables). "\n"
 660     if $DEBUG > 2;
 661
 662   foreach my $child_table_def ( keys %child_tables ) {
 663
 664     my $child_table;
 665     my $child_pkey = '';
 666     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 667       ( $child_table, $child_pkey ) = ( $1, $2 );
 668     } else {
 669       $child_table = $child_table_def;
 670
 671       $child_pkey = dbdef->table($child_table)->primary_key;
 672       #  or return "$table has no primary key".
 673       #            " (or do you need to run dbdef-create?)\n";
 674     }
 675
 676     my $sequence = '';
 677     if ( keys %{ $child_tables{$child_table_def} } ) {
 678
 679       return "$child_table has no primary key".
 680              " (run dbdef-create or try specifying it?)\n"
 681         unless $child_pkey;
 682
 683       #false laziness w/Record::insert and only works on Pg
 684       #refactor the proper last-inserted-id stuff out of Record::insert if this
 685       # ever gets use for anything besides a quick kludge for one customer
 686       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 687       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 688         or return "can't parse $child_table.$child_pkey default value ".
 689                   " for sequence name: $default";
 690       $sequence = $1;
 691
 692     }
 693
 694     my @sel_columns = grep { $_ ne $primary_key }
 695                            dbdef->table($child_table)->columns;
 696     my $sel_columns = join(', ', @sel_columns );
 697
 698     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 699     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 700     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 701
 702     my $sel_st = "SELECT $sel_columns FROM $child_table".
 703                  " WHERE $primary_key = $sourceid";
 704     warn "    $sel_st\n"
 705       if $DEBUG > 2;
 706     my $sel_sth = dbh->prepare( $sel_st )
 707       or return dbh->errstr;
 708
 709     $sel_sth->execute or return $sel_sth->errstr;
 710
 711     while ( my $row = $sel_sth->fetchrow_hashref ) {
 712
 713       warn "    selected row: ".
 714            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 715         if $DEBUG > 2;
 716
 717       my $statement =
 718         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 719       my $ins_sth =dbh->prepare($statement)
 720           or return dbh->errstr;
 721       my @param = ( $destid, map $row->{$_}, @ins_columns );
 722       warn "    $statement: [ ". join(', ', @param). " ]\n"
 723         if $DEBUG > 2;
 724       $ins_sth->execute( @param )
 725         or return $ins_sth->errstr;
 726
 727       #next unless keys %{ $child_tables{$child_table} };
 728       next unless $sequence;
 729
 730       #another section of that laziness
 731       my $seq_sql = "SELECT currval('$sequence')";
 732       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 733       $seq_sth->execute or return $seq_sth->errstr;
 734       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 735
 736       # don't drink soap!  recurse!  recurse!  okay!
 737       my $error =
 738         _copy_skel( $child_table_def,
 739                     $row->{$child_pkey}, #sourceid
 740                     $insertid, #destid
 741                     %{ $child_tables{$child_table_def} },
 742                   );
 743       return $error if $error;
 744
 745     }
 746
 747   }
 748
 749   return '';
 750
 751 }
 752
 753 =item order_pkg HASHREF | OPTION => VALUE ...
 754
 755 Orders a single package.
 756
 757 Options may be passed as a list of key/value pairs or as a hash reference.
 758 Options are:
 759
 760 =over 4
 761
 762 =item cust_pkg
 763
 764 FS::cust_pkg object
 765
 766 =item cust_location
 767
 768 Optional FS::cust_location object
 769
 770 =item svcs
 771
 772 Optional arryaref of FS::svc_* service objects.
 773
 774 =item depend_jobnum
 775
 776 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 777 jobs will have a dependancy on the supplied job (they will not run until the
 778 specific job completes).  This can be used to defer provisioning until some
 779 action completes (such as running the customer's credit card successfully).
 780
 781 =item ticket_subject
 782
 783 Optional subject for a ticket created and attached to this customer
 784
 785 =item ticket_subject
 786
 787 Optional queue name for ticket additions
 788
 789 =back
 790
 791 =cut
 792
 793 sub order_pkg {
 794   my $self = shift;
 795   my $opt = ref($_[0]) ? shift : { @_ };
 796
 797   warn "$me order_pkg called with options ".
 798        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 799     if $DEBUG;
 800
 801   my $cust_pkg = $opt->{'cust_pkg'};
 802   my $svcs     = $opt->{'svcs'} || [];
 803
 804   my %svc_options = ();
 805   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 806     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 807
 808   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 809                           qw( ticket_subject ticket_queue );
 810
 811   local $SIG{HUP} = 'IGNORE';
 812   local $SIG{INT} = 'IGNORE';
 813   local $SIG{QUIT} = 'IGNORE';
 814   local $SIG{TERM} = 'IGNORE';
 815   local $SIG{TSTP} = 'IGNORE';
 816   local $SIG{PIPE} = 'IGNORE';
 817
 818   my $oldAutoCommit = $FS::UID::AutoCommit;
 819   local $FS::UID::AutoCommit = 0;
 820   my $dbh = dbh;
 821
 822   if ( $opt->{'cust_location'} &&
 823        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 824     my $error = $opt->{'cust_location'}->insert;
 825     if ( $error ) {
 826       $dbh->rollback if $oldAutoCommit;
 827       return "inserting cust_location (transaction rolled back): $error";
 828     }
 829     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 830   }
 831
 832   $cust_pkg->custnum( $self->custnum );
 833
 834   my $error = $cust_pkg->insert( %insert_params );
 835   if ( $error ) {
 836     $dbh->rollback if $oldAutoCommit;
 837     return "inserting cust_pkg (transaction rolled back): $error";
 838   }
 839
 840   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 841     if ( $svc_something->svcnum ) {
 842       my $old_cust_svc = $svc_something->cust_svc;
 843       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 844       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 845       $error = $new_cust_svc->replace($old_cust_svc);
 846     } else {
 847       $svc_something->pkgnum( $cust_pkg->pkgnum );
 848       if ( $svc_something->isa('FS::svc_acct') ) {
 849         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 850                        qw( seconds upbytes downbytes totalbytes )      ) {
 851           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 852           ${ $opt->{$_.'_ref'} } = 0;
 853         }
 854       }
 855       $error = $svc_something->insert(%svc_options);
 856     }
 857     if ( $error ) {
 858       $dbh->rollback if $oldAutoCommit;
 859       return "inserting svc_ (transaction rolled back): $error";
 860     }
 861   }
 862
 863   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 864   ''; #no error
 865
 866 }
 867
 868 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 869 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 870
 871 Like the insert method on an existing record, this method orders multiple
 872 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 873 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 874 There should be a better explanation of this, but until then, here's an
 875 example:
 876
 877   use Tie::RefHash;
 878   tie %hash, 'Tie::RefHash'; #this part is important
 879   %hash = (
 880     $cust_pkg => [ $svc_acct ],
 881     ...
 882   );
 883   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 884
 885 Services can be new, in which case they are inserted, or existing unaudited
 886 services, in which case they are linked to the newly-created package.
 887
 888 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 889 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 890
 891 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 892 on the supplied jobnum (they will not run until the specific job completes).
 893 This can be used to defer provisioning until some action completes (such
 894 as running the customer's credit card successfully).
 895
 896 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 897 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 898 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 899 on the cust_main object is not recommended, as existing services will also be
 900 reexported.)
 901
 902 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 903 provided, the scalars (provided by references) will be incremented by the
 904 values of the prepaid card.`
 905
 906 =cut
 907
 908 sub order_pkgs {
 909   my $self = shift;
 910   my $cust_pkgs = shift;
 911   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 912   my %options = @_;
 913   $seconds_ref ||= $options{'seconds_ref'};
 914
 915   warn "$me order_pkgs called with options ".
 916        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 917     if $DEBUG;
 918
 919   local $SIG{HUP} = 'IGNORE';
 920   local $SIG{INT} = 'IGNORE';
 921   local $SIG{QUIT} = 'IGNORE';
 922   local $SIG{TERM} = 'IGNORE';
 923   local $SIG{TSTP} = 'IGNORE';
 924   local $SIG{PIPE} = 'IGNORE';
 925
 926   my $oldAutoCommit = $FS::UID::AutoCommit;
 927   local $FS::UID::AutoCommit = 0;
 928   my $dbh = dbh;
 929
 930   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 931
 932   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 933
 934     my $error = $self->order_pkg(
 935       'cust_pkg'     => $cust_pkg,
 936       'svcs'         => $cust_pkgs->{$cust_pkg},
 937       'seconds_ref'  => $seconds_ref,
 938       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 939                                      depend_jobnum
 940                                    )
 941     );
 942     if ( $error ) {
 943       $dbh->rollback if $oldAutoCommit;
 944       return $error;
 945     }
 946
 947   }
 948
 949   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 950   ''; #no error
 951 }
 952
 953 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 954
 955 Recharges this (existing) customer with the specified prepaid card (see
 956 L<FS::prepay_credit>), specified either by I<identifier> or as an
 957 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 958 returns false.
 959
 960 Optionally, five scalar references can be passed as well.  They will have their
 961 values filled in with the amount, number of seconds, and number of upload,
 962 download, and total bytes applied by this prepaid card.
 963
 964 =cut
 965
 966 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 967 #the only place that uses these args
 968 sub recharge_prepay {
 969   my( $self, $prepay_credit, $amountref, $secondsref,
 970       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 971
 972   local $SIG{HUP} = 'IGNORE';
 973   local $SIG{INT} = 'IGNORE';
 974   local $SIG{QUIT} = 'IGNORE';
 975   local $SIG{TERM} = 'IGNORE';
 976   local $SIG{TSTP} = 'IGNORE';
 977   local $SIG{PIPE} = 'IGNORE';
 978
 979   my $oldAutoCommit = $FS::UID::AutoCommit;
 980   local $FS::UID::AutoCommit = 0;
 981   my $dbh = dbh;
 982
 983   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 984
 985   my $error = $self->get_prepay( $prepay_credit,
 986                                  'amount_ref'     => \$amount,
 987                                  'seconds_ref'    => \$seconds,
 988                                  'upbytes_ref'    => \$upbytes,
 989                                  'downbytes_ref'  => \$downbytes,
 990                                  'totalbytes_ref' => \$totalbytes,
 991                                )
 992            || $self->increment_seconds($seconds)
 993            || $self->increment_upbytes($upbytes)
 994            || $self->increment_downbytes($downbytes)
 995            || $self->increment_totalbytes($totalbytes)
 996            || $self->insert_cust_pay_prepay( $amount,
 997                                              ref($prepay_credit)
 998                                                ? $prepay_credit->identifier
 999                                                : $prepay_credit
1000                                            );
1001
1002   if ( $error ) {
1003     $dbh->rollback if $oldAutoCommit;
1004     return $error;
1005   }
1006
1007   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1008   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1009   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1010   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1011   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1012
1013   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1014   '';
1015
1016 }
1017
1018 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1019
1020 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1021 specified either by I<identifier> or as an FS::prepay_credit object.
1022
1023 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
1024 incremented by the values of the prepaid card.
1025
1026 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1027 check or set this customer's I<agentnum>.
1028
1029 If there is an error, returns the error, otherwise returns false.
1030
1031 =cut
1032
1033
1034 sub get_prepay {
1035   my( $self, $prepay_credit, %opt ) = @_;
1036
1037   local $SIG{HUP} = 'IGNORE';
1038   local $SIG{INT} = 'IGNORE';
1039   local $SIG{QUIT} = 'IGNORE';
1040   local $SIG{TERM} = 'IGNORE';
1041   local $SIG{TSTP} = 'IGNORE';
1042   local $SIG{PIPE} = 'IGNORE';
1043
1044   my $oldAutoCommit = $FS::UID::AutoCommit;
1045   local $FS::UID::AutoCommit = 0;
1046   my $dbh = dbh;
1047
1048   unless ( ref($prepay_credit) ) {
1049
1050     my $identifier = $prepay_credit;
1051
1052     $prepay_credit = qsearchs(
1053       'prepay_credit',
1054       { 'identifier' => $prepay_credit },
1055       '',
1056       'FOR UPDATE'
1057     );
1058
1059     unless ( $prepay_credit ) {
1060       $dbh->rollback if $oldAutoCommit;
1061       return "Invalid prepaid card: ". $identifier;
1062     }
1063
1064   }
1065
1066   if ( $prepay_credit->agentnum ) {
1067     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1068       $dbh->rollback if $oldAutoCommit;
1069       return "prepaid card not valid for agent ". $self->agentnum;
1070     }
1071     $self->agentnum($prepay_credit->agentnum);
1072   }
1073
1074   my $error = $prepay_credit->delete;
1075   if ( $error ) {
1076     $dbh->rollback if $oldAutoCommit;
1077     return "removing prepay_credit (transaction rolled back): $error";
1078   }
1079
1080   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1081     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1082
1083   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1084   '';
1085
1086 }
1087
1088 =item increment_upbytes SECONDS
1089
1090 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1091 the specified number of upbytes.  If there is an error, returns the error,
1092 otherwise returns false.
1093
1094 =cut
1095
1096 sub increment_upbytes {
1097   _increment_column( shift, 'upbytes', @_);
1098 }
1099
1100 =item increment_downbytes SECONDS
1101
1102 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1103 the specified number of downbytes.  If there is an error, returns the error,
1104 otherwise returns false.
1105
1106 =cut
1107
1108 sub increment_downbytes {
1109   _increment_column( shift, 'downbytes', @_);
1110 }
1111
1112 =item increment_totalbytes SECONDS
1113
1114 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1115 the specified number of totalbytes.  If there is an error, returns the error,
1116 otherwise returns false.
1117
1118 =cut
1119
1120 sub increment_totalbytes {
1121   _increment_column( shift, 'totalbytes', @_);
1122 }
1123
1124 =item increment_seconds SECONDS
1125
1126 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1127 the specified number of seconds.  If there is an error, returns the error,
1128 otherwise returns false.
1129
1130 =cut
1131
1132 sub increment_seconds {
1133   _increment_column( shift, 'seconds', @_);
1134 }
1135
1136 =item _increment_column AMOUNT
1137
1138 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1139 the specified number of seconds or bytes.  If there is an error, returns
1140 the error, otherwise returns false.
1141
1142 =cut
1143
1144 sub _increment_column {
1145   my( $self, $column, $amount ) = @_;
1146   warn "$me increment_column called: $column, $amount\n"
1147     if $DEBUG;
1148
1149   return '' unless $amount;
1150
1151   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1152                       $self->ncancelled_pkgs;
1153
1154   if ( ! @cust_pkg ) {
1155     return 'No packages with primary or single services found'.
1156            ' to apply pre-paid time';
1157   } elsif ( scalar(@cust_pkg) > 1 ) {
1158     #maybe have a way to specify the package/account?
1159     return 'Multiple packages found to apply pre-paid time';
1160   }
1161
1162   my $cust_pkg = $cust_pkg[0];
1163   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1164     if $DEBUG > 1;
1165
1166   my @cust_svc =
1167     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1168
1169   if ( ! @cust_svc ) {
1170     return 'No account found to apply pre-paid time';
1171   } elsif ( scalar(@cust_svc) > 1 ) {
1172     return 'Multiple accounts found to apply pre-paid time';
1173   }
1174
1175   my $svc_acct = $cust_svc[0]->svc_x;
1176   warn "  found service svcnum ". $svc_acct->pkgnum.
1177        ' ('. $svc_acct->email. ")\n"
1178     if $DEBUG > 1;
1179
1180   $column = "increment_$column";
1181   $svc_acct->$column($amount);
1182
1183 }
1184
1185 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1186
1187 Inserts a prepayment in the specified amount for this customer.  An optional
1188 second argument can specify the prepayment identifier for tracking purposes.
1189 If there is an error, returns the error, otherwise returns false.
1190
1191 =cut
1192
1193 sub insert_cust_pay_prepay {
1194   shift->insert_cust_pay('PREP', @_);
1195 }
1196
1197 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1198
1199 Inserts a cash payment in the specified amount for this customer.  An optional
1200 second argument can specify the payment identifier for tracking purposes.
1201 If there is an error, returns the error, otherwise returns false.
1202
1203 =cut
1204
1205 sub insert_cust_pay_cash {
1206   shift->insert_cust_pay('CASH', @_);
1207 }
1208
1209 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1210
1211 Inserts a Western Union payment in the specified amount for this customer.  An
1212 optional second argument can specify the prepayment identifier for tracking
1213 purposes.  If there is an error, returns the error, otherwise returns false.
1214
1215 =cut
1216
1217 sub insert_cust_pay_west {
1218   shift->insert_cust_pay('WEST', @_);
1219 }
1220
1221 sub insert_cust_pay {
1222   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1223   my $payinfo = scalar(@_) ? shift : '';
1224
1225   my $cust_pay = new FS::cust_pay {
1226     'custnum' => $self->custnum,
1227     'paid'    => sprintf('%.2f', $amount),
1228     #'_date'   => #date the prepaid card was purchased???
1229     'payby'   => $payby,
1230     'payinfo' => $payinfo,
1231   };
1232   $cust_pay->insert;
1233
1234 }
1235
1236 =item reexport
1237
1238 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1239 order_pkgs methods for a better way to defer provisioning.
1240
1241 Re-schedules all exports by calling the B<reexport> method of all associated
1242 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1243 otherwise returns false.
1244
1245 =cut
1246
1247 sub reexport {
1248   my $self = shift;
1249
1250   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1251        "use the depend_jobnum option to insert or order_pkgs to delay export";
1252
1253   local $SIG{HUP} = 'IGNORE';
1254   local $SIG{INT} = 'IGNORE';
1255   local $SIG{QUIT} = 'IGNORE';
1256   local $SIG{TERM} = 'IGNORE';
1257   local $SIG{TSTP} = 'IGNORE';
1258   local $SIG{PIPE} = 'IGNORE';
1259
1260   my $oldAutoCommit = $FS::UID::AutoCommit;
1261   local $FS::UID::AutoCommit = 0;
1262   my $dbh = dbh;
1263
1264   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1265     my $error = $cust_pkg->reexport;
1266     if ( $error ) {
1267       $dbh->rollback if $oldAutoCommit;
1268       return $error;
1269     }
1270   }
1271
1272   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1273   '';
1274
1275 }
1276
1277 =item delete NEW_CUSTNUM
1278
1279 This deletes the customer.  If there is an error, returns the error, otherwise
1280 returns false.
1281
1282 This will completely remove all traces of the customer record.  This is not
1283 what you want when a customer cancels service; for that, cancel all of the
1284 customer's packages (see L</cancel>).
1285
1286 If the customer has any uncancelled packages, you need to pass a new (valid)
1287 customer number for those packages to be transferred to.  Cancelled packages
1288 will be deleted.  Did I mention that this is NOT what you want when a customer
1289 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
1290
1291 You can't delete a customer with invoices (see L<FS::cust_bill>),
1292 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
1293 refunds (see L<FS::cust_refund>).
1294
1295 =cut
1296
1297 sub delete {
1298   my $self = shift;
1299
1300   local $SIG{HUP} = 'IGNORE';
1301   local $SIG{INT} = 'IGNORE';
1302   local $SIG{QUIT} = 'IGNORE';
1303   local $SIG{TERM} = 'IGNORE';
1304   local $SIG{TSTP} = 'IGNORE';
1305   local $SIG{PIPE} = 'IGNORE';
1306
1307   my $oldAutoCommit = $FS::UID::AutoCommit;
1308   local $FS::UID::AutoCommit = 0;
1309   my $dbh = dbh;
1310
1311   if ( $self->cust_bill ) {
1312     $dbh->rollback if $oldAutoCommit;
1313     return "Can't delete a customer with invoices";
1314   }
1315   if ( $self->cust_credit ) {
1316     $dbh->rollback if $oldAutoCommit;
1317     return "Can't delete a customer with credits";
1318   }
1319   if ( $self->cust_pay ) {
1320     $dbh->rollback if $oldAutoCommit;
1321     return "Can't delete a customer with payments";
1322   }
1323   if ( $self->cust_refund ) {
1324     $dbh->rollback if $oldAutoCommit;
1325     return "Can't delete a customer with refunds";
1326   }
1327
1328   my @cust_pkg = $self->ncancelled_pkgs;
1329   if ( @cust_pkg ) {
1330     my $new_custnum = shift;
1331     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1332       $dbh->rollback if $oldAutoCommit;
1333       return "Invalid new customer number: $new_custnum";
1334     }
1335     foreach my $cust_pkg ( @cust_pkg ) {
1336       my %hash = $cust_pkg->hash;
1337       $hash{'custnum'} = $new_custnum;
1338       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1339       my $error = $new_cust_pkg->replace($cust_pkg,
1340                                          options => { $cust_pkg->options },
1341                                         );
1342       if ( $error ) {
1343         $dbh->rollback if $oldAutoCommit;
1344         return $error;
1345       }
1346     }
1347   }
1348   my @cancelled_cust_pkg = $self->all_pkgs;
1349   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1350     my $error = $cust_pkg->delete;
1351     if ( $error ) {
1352       $dbh->rollback if $oldAutoCommit;
1353       return $error;
1354     }
1355   }
1356
1357   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1358     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1359   ) {
1360     my $error = $cust_main_invoice->delete;
1361     if ( $error ) {
1362       $dbh->rollback if $oldAutoCommit;
1363       return $error;
1364     }
1365   }
1366
1367   foreach my $cust_main_exemption (
1368     qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } )
1369   ) {
1370     my $error = $cust_main_exemption->delete;
1371     if ( $error ) {
1372       $dbh->rollback if $oldAutoCommit;
1373       return $error;
1374     }
1375   }
1376
1377   my $error = $self->SUPER::delete;
1378   if ( $error ) {
1379     $dbh->rollback if $oldAutoCommit;
1380     return $error;
1381   }
1382
1383   # cust_main exports!
1384
1385   #my $export_args = $options{'export_args'} || [];
1386
1387   my @part_export =
1388     map qsearch( 'part_export', {exportnum=>$_} ),
1389       $conf->config('cust_main-exports'); #, $agentnum
1390
1391   foreach my $part_export ( @part_export ) {
1392     my $error = $part_export->export_delete( $self ); #, @$export_args);
1393     if ( $error ) {
1394       $dbh->rollback if $oldAutoCommit;
1395       return "exporting to ". $part_export->exporttype.
1396              " (transaction rolled back): $error";
1397     }
1398   }
1399
1400   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1401   '';
1402
1403 }
1404
1405 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1406
1407
1408 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1409 returns the error, otherwise returns false.
1410
1411 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1412 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1413 expected and rollback the entire transaction; it is not necessary to call
1414 check_invoicing_list first.  Here's an example:
1415
1416   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1417
1418 Currently available options are: I<tax_exemption>.
1419
1420 The I<tax_exemption> option can be set to an arrayref of tax names.
1421 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1422
1423 =cut
1424
1425 sub replace {
1426   my $self = shift;
1427
1428   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1429               ? shift
1430               : $self->replace_old;
1431
1432   my @param = @_;
1433
1434   warn "$me replace called\n"
1435     if $DEBUG;
1436
1437   my $curuser = $FS::CurrentUser::CurrentUser;
1438   if (    $self->payby eq 'COMP'
1439        && $self->payby ne $old->payby
1440        && ! $curuser->access_right('Complimentary customer')
1441      )
1442   {
1443     return "You are not permitted to create complimentary accounts.";
1444   }
1445
1446   local($ignore_expired_card) = 1
1447     if $old->payby  =~ /^(CARD|DCRD)$/
1448     && $self->payby =~ /^(CARD|DCRD)$/
1449     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1450
1451   local $SIG{HUP} = 'IGNORE';
1452   local $SIG{INT} = 'IGNORE';
1453   local $SIG{QUIT} = 'IGNORE';
1454   local $SIG{TERM} = 'IGNORE';
1455   local $SIG{TSTP} = 'IGNORE';
1456   local $SIG{PIPE} = 'IGNORE';
1457
1458   my $oldAutoCommit = $FS::UID::AutoCommit;
1459   local $FS::UID::AutoCommit = 0;
1460   my $dbh = dbh;
1461
1462   my $error = $self->SUPER::replace($old);
1463
1464   if ( $error ) {
1465     $dbh->rollback if $oldAutoCommit;
1466     return $error;
1467   }
1468
1469   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1470     my $invoicing_list = shift @param;
1471     $error = $self->check_invoicing_list( $invoicing_list );
1472     if ( $error ) {
1473       $dbh->rollback if $oldAutoCommit;
1474       return $error;
1475     }
1476     $self->invoicing_list( $invoicing_list );
1477   }
1478
1479   my %options = @param;
1480
1481   my $tax_exemption = delete $options{'tax_exemption'};
1482   if ( $tax_exemption ) {
1483
1484     my %cust_main_exemption =
1485       map { $_->taxname => $_ }
1486           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1487
1488     foreach my $taxname ( @$tax_exemption ) {
1489
1490       next if delete $cust_main_exemption{$taxname};
1491
1492       my $cust_main_exemption = new FS::cust_main_exemption {
1493         'custnum' => $self->custnum,
1494         'taxname' => $taxname,
1495       };
1496       my $error = $cust_main_exemption->insert;
1497       if ( $error ) {
1498         $dbh->rollback if $oldAutoCommit;
1499         return "inserting cust_main_exemption (transaction rolled back): $error";
1500       }
1501     }
1502
1503     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1504       my $error = $cust_main_exemption->delete;
1505       if ( $error ) {
1506         $dbh->rollback if $oldAutoCommit;
1507         return "deleting cust_main_exemption (transaction rolled back): $error";
1508       }
1509     }
1510
1511   }
1512
1513   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1514        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1515               && $self->get('payinfo') !~ /^99\d{14}$/
1516             )
1517             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1518           )
1519      )
1520   {
1521
1522     # card/check/lec info has changed, want to retry realtime_ invoice events
1523     my $error = $self->retry_realtime;
1524     if ( $error ) {
1525       $dbh->rollback if $oldAutoCommit;
1526       return $error;
1527     }
1528   }
1529
1530   unless ( $import || $skip_fuzzyfiles ) {
1531     $error = $self->queue_fuzzyfiles_update;
1532     if ( $error ) {
1533       $dbh->rollback if $oldAutoCommit;
1534       return "updating fuzzy search cache: $error";
1535     }
1536   }
1537
1538   # cust_main exports!
1539
1540   my $export_args = $options{'export_args'} || [];
1541
1542   my @part_export =
1543     map qsearch( 'part_export', {exportnum=>$_} ),
1544       $conf->config('cust_main-exports'); #, $agentnum
1545
1546   foreach my $part_export ( @part_export ) {
1547     my $error = $part_export->export_replace( $self, $old, @$export_args);
1548     if ( $error ) {
1549       $dbh->rollback if $oldAutoCommit;
1550       return "exporting to ". $part_export->exporttype.
1551              " (transaction rolled back): $error";
1552     }
1553   }
1554
1555   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1556   '';
1557
1558 }
1559
1560 =item queue_fuzzyfiles_update
1561
1562 Used by insert & replace to update the fuzzy search cache
1563
1564 =cut
1565
1566 sub queue_fuzzyfiles_update {
1567   my $self = shift;
1568
1569   local $SIG{HUP} = 'IGNORE';
1570   local $SIG{INT} = 'IGNORE';
1571   local $SIG{QUIT} = 'IGNORE';
1572   local $SIG{TERM} = 'IGNORE';
1573   local $SIG{TSTP} = 'IGNORE';
1574   local $SIG{PIPE} = 'IGNORE';
1575
1576   my $oldAutoCommit = $FS::UID::AutoCommit;
1577   local $FS::UID::AutoCommit = 0;
1578   my $dbh = dbh;
1579
1580   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1581   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1582   if ( $error ) {
1583     $dbh->rollback if $oldAutoCommit;
1584     return "queueing job (transaction rolled back): $error";
1585   }
1586
1587   if ( $self->ship_last ) {
1588     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1589     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1590     if ( $error ) {
1591       $dbh->rollback if $oldAutoCommit;
1592       return "queueing job (transaction rolled back): $error";
1593     }
1594   }
1595
1596   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1597   '';
1598
1599 }
1600
1601 =item check
1602
1603 Checks all fields to make sure this is a valid customer record.  If there is
1604 an error, returns the error, otherwise returns false.  Called by the insert
1605 and replace methods.
1606
1607 =cut
1608
1609 sub check {
1610   my $self = shift;
1611
1612   warn "$me check BEFORE: \n". $self->_dump
1613     if $DEBUG > 2;
1614
1615   my $error =
1616     $self->ut_numbern('custnum')
1617     || $self->ut_number('agentnum')
1618     || $self->ut_textn('agent_custid')
1619     || $self->ut_number('refnum')
1620     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1621     || $self->ut_textn('custbatch')
1622     || $self->ut_name('last')
1623     || $self->ut_name('first')
1624     || $self->ut_snumbern('birthdate')
1625     || $self->ut_snumbern('signupdate')
1626     || $self->ut_textn('company')
1627     || $self->ut_text('address1')
1628     || $self->ut_textn('address2')
1629     || $self->ut_text('city')
1630     || $self->ut_textn('county')
1631     || $self->ut_textn('state')
1632     || $self->ut_country('country')
1633     || $self->ut_anything('comments')
1634     || $self->ut_numbern('referral_custnum')
1635     || $self->ut_textn('stateid')
1636     || $self->ut_textn('stateid_state')
1637     || $self->ut_textn('invoice_terms')
1638     || $self->ut_alphan('geocode')
1639     || $self->ut_floatn('cdr_termination_percentage')
1640   ;
1641
1642   #barf.  need message catalogs.  i18n.  etc.
1643   $error .= "Please select an advertising source."
1644     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1645   return $error if $error;
1646
1647   return "Unknown agent"
1648     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1649
1650   return "Unknown refnum"
1651     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1652
1653   return "Unknown referring custnum: ". $self->referral_custnum
1654     unless ! $self->referral_custnum
1655            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1656
1657   if ( $self->censustract ne '' ) {
1658     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1659       or return "Illegal census tract: ". $self->censustract;
1660
1661     $self->censustract("$1.$2");
1662   }
1663
1664   if ( $self->ss eq '' ) {
1665     $self->ss('');
1666   } else {
1667     my $ss = $self->ss;
1668     $ss =~ s/\D//g;
1669     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1670       or return "Illegal social security number: ". $self->ss;
1671     $self->ss("$1-$2-$3");
1672   }
1673
1674
1675 # bad idea to disable, causes billing to fail because of no tax rates later
1676 #  unless ( $import ) {
1677     unless ( qsearch('cust_main_county', {
1678       'country' => $self->country,
1679       'state'   => '',
1680      } ) ) {
1681       return "Unknown state/county/country: ".
1682         $self->state. "/". $self->county. "/". $self->country
1683         unless qsearch('cust_main_county',{
1684           'state'   => $self->state,
1685           'county'  => $self->county,
1686           'country' => $self->country,
1687         } );
1688     }
1689 #  }
1690
1691   $error =
1692     $self->ut_phonen('daytime', $self->country)
1693     || $self->ut_phonen('night', $self->country)
1694     || $self->ut_phonen('fax', $self->country)
1695     || $self->ut_zip('zip', $self->country)
1696   ;
1697   return $error if $error;
1698
1699   if ( $conf->exists('cust_main-require_phone')
1700        && ! length($self->daytime) && ! length($self->night)
1701      ) {
1702
1703     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1704                           ? 'Day Phone'
1705                           : FS::Msgcat::_gettext('daytime');
1706     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1707                         ? 'Night Phone'
1708                         : FS::Msgcat::_gettext('night');
1709
1710     return "$daytime_label or $night_label is required"
1711
1712   }
1713
1714   if ( $self->has_ship_address
1715        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1716                         $self->addr_fields )
1717      )
1718   {
1719     my $error =
1720       $self->ut_name('ship_last')
1721       || $self->ut_name('ship_first')
1722       || $self->ut_textn('ship_company')
1723       || $self->ut_text('ship_address1')
1724       || $self->ut_textn('ship_address2')
1725       || $self->ut_text('ship_city')
1726       || $self->ut_textn('ship_county')
1727       || $self->ut_textn('ship_state')
1728       || $self->ut_country('ship_country')
1729     ;
1730     return $error if $error;
1731
1732     #false laziness with above
1733     unless ( qsearchs('cust_main_county', {
1734       'country' => $self->ship_country,
1735       'state'   => '',
1736      } ) ) {
1737       return "Unknown ship_state/ship_county/ship_country: ".
1738         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1739         unless qsearch('cust_main_county',{
1740           'state'   => $self->ship_state,
1741           'county'  => $self->ship_county,
1742           'country' => $self->ship_country,
1743         } );
1744     }
1745     #eofalse
1746
1747     $error =
1748       $self->ut_phonen('ship_daytime', $self->ship_country)
1749       || $self->ut_phonen('ship_night', $self->ship_country)
1750       || $self->ut_phonen('ship_fax', $self->ship_country)
1751       || $self->ut_zip('ship_zip', $self->ship_country)
1752     ;
1753     return $error if $error;
1754
1755     return "Unit # is required."
1756       if $self->ship_address2 =~ /^\s*$/
1757       && $conf->exists('cust_main-require_address2');
1758
1759   } else { # ship_ info eq billing info, so don't store dup info in database
1760
1761     $self->setfield("ship_$_", '')
1762       foreach $self->addr_fields;
1763
1764     return "Unit # is required."
1765       if $self->address2 =~ /^\s*$/
1766       && $conf->exists('cust_main-require_address2');
1767
1768   }
1769
1770   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1771   #  or return "Illegal payby: ". $self->payby;
1772   #$self->payby($1);
1773   FS::payby->can_payby($self->table, $self->payby)
1774     or return "Illegal payby: ". $self->payby;
1775
1776   $error =    $self->ut_numbern('paystart_month')
1777            || $self->ut_numbern('paystart_year')
1778            || $self->ut_numbern('payissue')
1779            || $self->ut_textn('paytype')
1780   ;
1781   return $error if $error;
1782
1783   if ( $self->payip eq '' ) {
1784     $self->payip('');
1785   } else {
1786     $error = $self->ut_ip('payip');
1787     return $error if $error;
1788   }
1789
1790   # If it is encrypted and the private key is not availaible then we can't
1791   # check the credit card.
1792   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1793
1794   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1795
1796     my $payinfo = $self->payinfo;
1797     $payinfo =~ s/\D//g;
1798     $payinfo =~ /^(\d{13,16})$/
1799       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1800     $payinfo = $1;
1801     $self->payinfo($payinfo);
1802     validate($payinfo)
1803       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1804
1805     return gettext('unknown_card_type')
1806       if $self->payinfo !~ /^99\d{14}$/ #token
1807       && cardtype($self->payinfo) eq "Unknown";
1808
1809     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1810     if ( $ban ) {
1811       return 'Banned credit card: banned on '.
1812              time2str('%a %h %o at %r', $ban->_date).
1813              ' by '. $ban->otaker.
1814              ' (ban# '. $ban->bannum. ')';
1815     }
1816
1817     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1818       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1819         $self->paycvv =~ /^(\d{4})$/
1820           or return "CVV2 (CID) for American Express cards is four digits.";
1821         $self->paycvv($1);
1822       } else {
1823         $self->paycvv =~ /^(\d{3})$/
1824           or return "CVV2 (CVC2/CID) is three digits.";
1825         $self->paycvv($1);
1826       }
1827     } else {
1828       $self->paycvv('');
1829     }
1830
1831     my $cardtype = cardtype($payinfo);
1832     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1833
1834       return "Start date or issue number is required for $cardtype cards"
1835         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1836
1837       return "Start month must be between 1 and 12"
1838         if $self->paystart_month
1839            and $self->paystart_month < 1 || $self->paystart_month > 12;
1840
1841       return "Start year must be 1990 or later"
1842         if $self->paystart_year
1843            and $self->paystart_year < 1990;
1844
1845       return "Issue number must be beween 1 and 99"
1846         if $self->payissue
1847           and $self->payissue < 1 || $self->payissue > 99;
1848
1849     } else {
1850       $self->paystart_month('');
1851       $self->paystart_year('');
1852       $self->payissue('');
1853     }
1854
1855   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1856
1857     my $payinfo = $self->payinfo;
1858     $payinfo =~ s/[^\d\@]//g;
1859     if ( $conf->exists('echeck-nonus') ) {
1860       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1861       $payinfo = "$1\@$2";
1862     } else {
1863       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1864       $payinfo = "$1\@$2";
1865     }
1866     $self->payinfo($payinfo);
1867     $self->paycvv('');
1868
1869     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1870     if ( $ban ) {
1871       return 'Banned ACH account: banned on '.
1872              time2str('%a %h %o at %r', $ban->_date).
1873              ' by '. $ban->otaker.
1874              ' (ban# '. $ban->bannum. ')';
1875     }
1876
1877   } elsif ( $self->payby eq 'LECB' ) {
1878
1879     my $payinfo = $self->payinfo;
1880     $payinfo =~ s/\D//g;
1881     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1882     $payinfo = $1;
1883     $self->payinfo($payinfo);
1884     $self->paycvv('');
1885
1886   } elsif ( $self->payby eq 'BILL' ) {
1887
1888     $error = $self->ut_textn('payinfo');
1889     return "Illegal P.O. number: ". $self->payinfo if $error;
1890     $self->paycvv('');
1891
1892   } elsif ( $self->payby eq 'COMP' ) {
1893
1894     my $curuser = $FS::CurrentUser::CurrentUser;
1895     if (    ! $self->custnum
1896          && ! $curuser->access_right('Complimentary customer')
1897        )
1898     {
1899       return "You are not permitted to create complimentary accounts."
1900     }
1901
1902     $error = $self->ut_textn('payinfo');
1903     return "Illegal comp account issuer: ". $self->payinfo if $error;
1904     $self->paycvv('');
1905
1906   } elsif ( $self->payby eq 'PREPAY' ) {
1907
1908     my $payinfo = $self->payinfo;
1909     $payinfo =~ s/\W//g; #anything else would just confuse things
1910     $self->payinfo($payinfo);
1911     $error = $self->ut_alpha('payinfo');
1912     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1913     return "Unknown prepayment identifier"
1914       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1915     $self->paycvv('');
1916
1917   }
1918
1919   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1920     return "Expiration date required"
1921       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1922     $self->paydate('');
1923   } else {
1924     my( $m, $y );
1925     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1926       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1927     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1928       ( $m, $y ) = ( $2, "19$1" );
1929     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1930       ( $m, $y ) = ( $3, "20$2" );
1931     } else {
1932       return "Illegal expiration date: ". $self->paydate;
1933     }
1934     $self->paydate("$y-$m-01");
1935     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1936     return gettext('expired_card')
1937       if !$import
1938       && !$ignore_expired_card
1939       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1940   }
1941
1942   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1943        ( ! $conf->exists('require_cardname')
1944          || $self->payby !~ /^(CARD|DCRD)$/  )
1945   ) {
1946     $self->payname( $self->first. " ". $self->getfield('last') );
1947   } else {
1948     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1949       or return gettext('illegal_name'). " payname: ". $self->payname;
1950     $self->payname($1);
1951   }
1952
1953   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1954     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1955     $self->$flag($1);
1956   }
1957
1958   $self->otaker(getotaker) unless $self->otaker;
1959
1960   warn "$me check AFTER: \n". $self->_dump
1961     if $DEBUG > 2;
1962
1963   $self->SUPER::check;
1964 }
1965
1966 =item addr_fields
1967
1968 Returns a list of fields which have ship_ duplicates.
1969
1970 =cut
1971
1972 sub addr_fields {
1973   qw( last first company
1974       address1 address2 city county state zip country
1975       daytime night fax
1976     );
1977 }
1978
1979 =item has_ship_address
1980
1981 Returns true if this customer record has a separate shipping address.
1982
1983 =cut
1984
1985 sub has_ship_address {
1986   my $self = shift;
1987   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1988 }
1989
1990 =item location_hash
1991
1992 Returns a list of key/value pairs, with the following keys: address1, adddress2,
1993 city, county, state, zip, country.  The shipping address is used if present.
1994
1995 =cut
1996
1997 #geocode?  dependent on tax-ship_address config, not available in cust_location
1998 #mostly.  not yet then.
1999
2000 sub location_hash {
2001   my $self = shift;
2002   my $prefix = $self->has_ship_address ? 'ship_' : '';
2003
2004   map { $_ => $self->get($prefix.$_) }
2005       qw( address1 address2 city county state zip country geocode );
2006       #fields that cust_location has
2007 }
2008
2009 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2010
2011 Returns all packages (see L<FS::cust_pkg>) for this customer.
2012
2013 =cut
2014
2015 sub all_pkgs {
2016   my $self = shift;
2017   my $extra_qsearch = ref($_[0]) ? shift : {};
2018
2019   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2020
2021   my @cust_pkg = ();
2022   if ( $self->{'_pkgnum'} ) {
2023     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2024   } else {
2025     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2026   }
2027
2028   sort sort_packages @cust_pkg;
2029 }
2030
2031 =item cust_pkg
2032
2033 Synonym for B<all_pkgs>.
2034
2035 =cut
2036
2037 sub cust_pkg {
2038   shift->all_pkgs(@_);
2039 }
2040
2041 =item cust_location
2042
2043 Returns all locations (see L<FS::cust_location>) for this customer.
2044
2045 =cut
2046
2047 sub cust_location {
2048   my $self = shift;
2049   qsearch('cust_location', { 'custnum' => $self->custnum } );
2050 }
2051
2052 =item location_label [ OPTION => VALUE ... ]
2053
2054 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2055
2056 Options are
2057
2058 =over 4
2059
2060 =item join_string
2061
2062 used to separate the address elements (defaults to ', ')
2063
2064 =item escape_function
2065
2066 a callback used for escaping the text of the address elements
2067
2068 =back
2069
2070 =cut
2071
2072 # false laziness with FS::cust_location::line
2073
2074 sub location_label {
2075   my $self = shift;
2076   my %opt = @_;
2077
2078   my $separator = $opt{join_string} || ', ';
2079   my $escape = $opt{escape_function} || sub{ shift };
2080   my $line = '';
2081   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2082   my $prefix = length($self->ship_last) ? 'ship_' : '';
2083
2084   my $notfirst = 0;
2085   foreach (qw ( address1 address2 ) ) {
2086     my $method = "$prefix$_";
2087     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2088       if $self->$method;
2089     $notfirst++;
2090   }
2091   $notfirst = 0;
2092   foreach (qw ( city county state zip ) ) {
2093     my $method = "$prefix$_";
2094     if ( $self->$method ) {
2095       $line .= ' (' if $method eq 'county';
2096       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2097       $line .= ' )' if $method eq 'county';
2098       $notfirst++;
2099     }
2100   }
2101   $line .= $separator. &$escape(code2country($self->country))
2102     if $self->country ne $cydefault;
2103
2104   $line;
2105 }
2106
2107 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2108
2109 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2110
2111 =cut
2112
2113 sub ncancelled_pkgs {
2114   my $self = shift;
2115   my $extra_qsearch = ref($_[0]) ? shift : {};
2116
2117   return $self->num_ncancelled_pkgs unless wantarray;
2118
2119   my @cust_pkg = ();
2120   if ( $self->{'_pkgnum'} ) {
2121
2122     warn "$me ncancelled_pkgs: returning cached objects"
2123       if $DEBUG > 1;
2124
2125     @cust_pkg = grep { ! $_->getfield('cancel') }
2126                 values %{ $self->{'_pkgnum'}->cache };
2127
2128   } else {
2129
2130     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2131          $self->custnum. "\n"
2132       if $DEBUG > 1;
2133
2134     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2135
2136     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2137
2138   }
2139
2140   sort sort_packages @cust_pkg;
2141
2142 }
2143
2144 sub _cust_pkg {
2145   my $self = shift;
2146   my $extra_qsearch = ref($_[0]) ? shift : {};
2147
2148   $extra_qsearch->{'select'} ||= '*';
2149   $extra_qsearch->{'select'} .=
2150    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2151      AS _num_cust_svc';
2152
2153   map {
2154         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2155         $_;
2156       }
2157   qsearch({
2158     %$extra_qsearch,
2159     'table'   => 'cust_pkg',
2160     'hashref' => { 'custnum' => $self->custnum },
2161   });
2162
2163 }
2164
2165 # This should be generalized to use config options to determine order.
2166 sub sort_packages {
2167
2168   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2169   return $locationsort if $locationsort;
2170
2171   if ( $a->get('cancel') xor $b->get('cancel') ) {
2172     return -1 if $b->get('cancel');
2173     return  1 if $a->get('cancel');
2174     #shouldn't get here...
2175     return 0;
2176   } else {
2177     my $a_num_cust_svc = $a->num_cust_svc;
2178     my $b_num_cust_svc = $b->num_cust_svc;
2179     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2180     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2181     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2182     my @a_cust_svc = $a->cust_svc;
2183     my @b_cust_svc = $b->cust_svc;
2184     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2185     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2186     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2187     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2188   }
2189
2190 }
2191
2192 =item suspended_pkgs
2193
2194 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2195
2196 =cut
2197
2198 sub suspended_pkgs {
2199   my $self = shift;
2200   grep { $_->susp } $self->ncancelled_pkgs;
2201 }
2202
2203 =item unflagged_suspended_pkgs
2204
2205 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2206 customer (thouse packages without the `manual_flag' set).
2207
2208 =cut
2209
2210 sub unflagged_suspended_pkgs {
2211   my $self = shift;
2212   return $self->suspended_pkgs
2213     unless dbdef->table('cust_pkg')->column('manual_flag');
2214   grep { ! $_->manual_flag } $self->suspended_pkgs;
2215 }
2216
2217 =item unsuspended_pkgs
2218
2219 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2220 this customer.
2221
2222 =cut
2223
2224 sub unsuspended_pkgs {
2225   my $self = shift;
2226   grep { ! $_->susp } $self->ncancelled_pkgs;
2227 }
2228
2229 =item next_bill_date
2230
2231 Returns the next date this customer will be billed, as a UNIX timestamp, or
2232 undef if no active package has a next bill date.
2233
2234 =cut
2235
2236 sub next_bill_date {
2237   my $self = shift;
2238   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2239 }
2240
2241 =item num_cancelled_pkgs
2242
2243 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2244 customer.
2245
2246 =cut
2247
2248 sub num_cancelled_pkgs {
2249   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2250 }
2251
2252 sub num_ncancelled_pkgs {
2253   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2254 }
2255
2256 sub num_pkgs {
2257   my( $self ) = shift;
2258   my $sql = scalar(@_) ? shift : '';
2259   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2260   my $sth = dbh->prepare(
2261     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2262   ) or die dbh->errstr;
2263   $sth->execute($self->custnum) or die $sth->errstr;
2264   $sth->fetchrow_arrayref->[0];
2265 }
2266
2267 =item unsuspend
2268
2269 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2270 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2271 on success or a list of errors.
2272
2273 =cut
2274
2275 sub unsuspend {
2276   my $self = shift;
2277   grep { $_->unsuspend } $self->suspended_pkgs;
2278 }
2279
2280 =item suspend
2281
2282 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2283
2284 Returns a list: an empty list on success or a list of errors.
2285
2286 =cut
2287
2288 sub suspend {
2289   my $self = shift;
2290   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2291 }
2292
2293 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2294
2295 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2296 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2297 of a list of pkgparts; the hashref has the following keys:
2298
2299 =over 4
2300
2301 =item pkgparts - listref of pkgparts
2302
2303 =item (other options are passed to the suspend method)
2304
2305 =back
2306
2307
2308 Returns a list: an empty list on success or a list of errors.
2309
2310 =cut
2311
2312 sub suspend_if_pkgpart {
2313   my $self = shift;
2314   my (@pkgparts, %opt);
2315   if (ref($_[0]) eq 'HASH'){
2316     @pkgparts = @{$_[0]{pkgparts}};
2317     %opt      = %{$_[0]};
2318   }else{
2319     @pkgparts = @_;
2320   }
2321   grep { $_->suspend(%opt) }
2322     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2323       $self->unsuspended_pkgs;
2324 }
2325
2326 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2327
2328 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2329 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2330 instead of a list of pkgparts; the hashref has the following keys:
2331
2332 =over 4
2333
2334 =item pkgparts - listref of pkgparts
2335
2336 =item (other options are passed to the suspend method)
2337
2338 =back
2339
2340 Returns a list: an empty list on success or a list of errors.
2341
2342 =cut
2343
2344 sub suspend_unless_pkgpart {
2345   my $self = shift;
2346   my (@pkgparts, %opt);
2347   if (ref($_[0]) eq 'HASH'){
2348     @pkgparts = @{$_[0]{pkgparts}};
2349     %opt      = %{$_[0]};
2350   }else{
2351     @pkgparts = @_;
2352   }
2353   grep { $_->suspend(%opt) }
2354     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2355       $self->unsuspended_pkgs;
2356 }
2357
2358 =item cancel [ OPTION => VALUE ... ]
2359
2360 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2361
2362 Available options are:
2363
2364 =over 4
2365
2366 =item quiet - can be set true to supress email cancellation notices.
2367
2368 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2369
2370 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2371
2372 =item nobill - can be set true to skip billing if it might otherwise be done.
2373
2374 =back
2375
2376 Always returns a list: an empty list on success or a list of errors.
2377
2378 =cut
2379
2380 # nb that dates are not specified as valid options to this method
2381
2382 sub cancel {
2383   my( $self, %opt ) = @_;
2384
2385   warn "$me cancel called on customer ". $self->custnum. " with options ".
2386        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2387     if $DEBUG;
2388
2389   return ( 'access denied' )
2390     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2391
2392   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2393
2394     #should try decryption (we might have the private key)
2395     # and if not maybe queue a job for the server that does?
2396     return ( "Can't (yet) ban encrypted credit cards" )
2397       if $self->is_encrypted($self->payinfo);
2398
2399     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2400     my $error = $ban->insert;
2401     return ( $error ) if $error;
2402
2403   }
2404
2405   my @pkgs = $self->ncancelled_pkgs;
2406
2407   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2408     $opt{nobill} = 1;
2409     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2410     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2411       if $error;
2412   }
2413
2414   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2415        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2416     if $DEBUG;
2417
2418   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2419 }
2420
2421 sub _banned_pay_hashref {
2422   my $self = shift;
2423
2424   my %payby2ban = (
2425     'CARD' => 'CARD',
2426     'DCRD' => 'CARD',
2427     'CHEK' => 'CHEK',
2428     'DCHK' => 'CHEK'
2429   );
2430
2431   {
2432     'payby'   => $payby2ban{$self->payby},
2433     'payinfo' => md5_base64($self->payinfo),
2434     #don't ever *search* on reason! #'reason'  =>
2435   };
2436 }
2437
2438 =item notes
2439
2440 Returns all notes (see L<FS::cust_main_note>) for this customer.
2441
2442 =cut
2443
2444 sub notes {
2445   my $self = shift;
2446   #order by?
2447   qsearch( 'cust_main_note',
2448            { 'custnum' => $self->custnum },
2449            '',
2450            'ORDER BY _DATE DESC'
2451          );
2452 }
2453
2454 =item agent
2455
2456 Returns the agent (see L<FS::agent>) for this customer.
2457
2458 =cut
2459
2460 sub agent {
2461   my $self = shift;
2462   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2463 }
2464
2465 =item cust_class
2466
2467 Returns the customer class, as an FS::cust_class object, or the empty string
2468 if there is no customer class.
2469
2470 =cut
2471
2472 sub cust_class {
2473   my $self = shift;
2474   if ( $self->classnum ) {
2475     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2476   } else {
2477     return '';
2478   }
2479 }
2480
2481 =item categoryname
2482
2483 Returns the customer category name, or the empty string if there is no customer
2484 category.
2485
2486 =cut
2487
2488 sub categoryname {
2489   my $self = shift;
2490   my $cust_class = $self->cust_class;
2491   $cust_class
2492     ? $cust_class->categoryname
2493     : '';
2494 }
2495
2496 =item classname
2497
2498 Returns the customer class name, or the empty string if there is no customer
2499 class.
2500
2501 =cut
2502
2503 sub classname {
2504   my $self = shift;
2505   my $cust_class = $self->cust_class;
2506   $cust_class
2507     ? $cust_class->classname
2508     : '';
2509 }
2510
2511
2512 =item bill_and_collect
2513
2514 Cancels and suspends any packages due, generates bills, applies payments and
2515 credits, and applies collection events to run cards, send bills and notices,
2516 etc.
2517
2518 By default, warns on errors and continues with the next operation (but see the
2519 "fatal" flag below).
2520
2521 Options are passed as name-value pairs.  Currently available options are:
2522
2523 =over 4
2524
2525 =item time
2526
2527 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2528
2529  use Date::Parse;
2530  ...
2531  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2532
2533 =item invoice_time
2534
2535 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2536
2537 =item check_freq
2538
2539 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2540
2541 =item resetup
2542
2543 If set true, re-charges setup fees.
2544
2545 =item fatal
2546
2547 If set any errors prevent subsequent operations from continusing.  If set
2548 specifically to "return", returns the error (or false, if there is no error).
2549 Any other true value causes errors to die.
2550
2551 =item debug
2552
2553 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2554
2555 =back
2556
2557 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2558 options of those methods are also available.
2559
2560 =cut
2561
2562 sub bill_and_collect {
2563   my( $self, %options ) = @_;
2564
2565   my $error;
2566
2567   #$options{actual_time} not $options{time} because freeside-daily -d is for
2568   #pre-printing invoices
2569
2570   $options{'actual_time'} ||= time;
2571
2572   $error = $self->cancel_expired_pkgs( $options{actual_time} );
2573   if ( $error ) {
2574     $error = "Error expiring custnum ". $self->custnum. ": $error";
2575     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2576     elsif ( $options{fatal}                                ) { die    $error; }
2577     else                                                     { warn   $error; }
2578   }
2579
2580   $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
2581   if ( $error ) {
2582     $error = "Error adjourning custnum ". $self->custnum. ": $error";
2583     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2584     elsif ( $options{fatal}                                ) { die    $error; }
2585     else                                                     { warn   $error; }
2586   }
2587
2588   $error = $self->bill( %options );
2589   if ( $error ) {
2590     $error = "Error billing custnum ". $self->custnum. ": $error";
2591     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2592     elsif ( $options{fatal}                                ) { die    $error; }
2593     else                                                     { warn   $error; }
2594   }
2595
2596   $error = $self->apply_payments_and_credits;
2597   if ( $error ) {
2598     $error = "Error applying custnum ". $self->custnum. ": $error";
2599     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2600     elsif ( $options{fatal}                                ) { die    $error; }
2601     else                                                     { warn   $error; }
2602   }
2603
2604   unless ( $conf->exists('cancelled_cust-noevents')
2605            && ! $self->num_ncancelled_pkgs
2606   ) {
2607     $error = $self->collect( %options );
2608     if ( $error ) {
2609       $error = "Error collecting custnum ". $self->custnum. ": $error";
2610       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
2611       elsif ($options{fatal}                               ) { die    $error; }
2612       else                                                   { warn   $error; }
2613     }
2614   }
2615
2616   '';
2617
2618 }
2619
2620 sub cancel_expired_pkgs {
2621   my ( $self, $time, %options ) = @_;
2622
2623   my @cancel_pkgs = $self->ncancelled_pkgs( {
2624     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2625   } );
2626
2627   my @errors = ();
2628
2629   foreach my $cust_pkg ( @cancel_pkgs ) {
2630     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2631     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
2632                                            'reason_otaker' => $cpr->otaker
2633                                          )
2634                                        : ()
2635                                  );
2636     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2637   }
2638
2639   scalar(@errors) ? join(' / ', @errors) : '';
2640
2641 }
2642
2643 sub suspend_adjourned_pkgs {
2644   my ( $self, $time, %options ) = @_;
2645
2646   my @susp_pkgs = $self->ncancelled_pkgs( {
2647     'extra_sql' =>
2648       " AND ( susp IS NULL OR susp = 0 )
2649         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
2650               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2651             )
2652       ",
2653   } );
2654
2655   #only because there's no SQL test for is_prepaid :/
2656   @susp_pkgs =
2657     grep {     (    $_->part_pkg->is_prepaid
2658                  && $_->bill
2659                  && $_->bill < $time
2660                )
2661             || (    $_->adjourn
2662                  && $_->adjourn <= $time
2663                )
2664
2665          }
2666          @susp_pkgs;
2667
2668   my @errors = ();
2669
2670   foreach my $cust_pkg ( @susp_pkgs ) {
2671     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2672       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2673     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2674                                             'reason_otaker' => $cpr->otaker
2675                                           )
2676                                         : ()
2677                                   );
2678     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2679   }
2680
2681   scalar(@errors) ? join(' / ', @errors) : '';
2682
2683 }
2684
2685 =item bill OPTIONS
2686
2687 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2688 conjunction with the collect method by calling B<bill_and_collect>.
2689
2690 If there is an error, returns the error, otherwise returns false.
2691
2692 Options are passed as name-value pairs.  Currently available options are:
2693
2694 =over 4
2695
2696 =item resetup
2697
2698 If set true, re-charges setup fees.
2699
2700 =item time
2701
2702 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2703
2704  use Date::Parse;
2705  ...
2706  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2707
2708 =item pkg_list
2709
2710 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2711
2712  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2713
2714 =item not_pkgpart
2715
2716 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2717
2718 =item invoice_time
2719
2720 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2721
2722 =item cancel
2723
2724 This boolean value informs the us that the package is being cancelled.  This
2725 typically might mean not charging the normal recurring fee but only usage
2726 fees since the last billing. Setup charges may be charged.  Not all package
2727 plans support this feature (they tend to charge 0).
2728
2729 =item invoice_terms
2730
2731 Optional terms to be printed on this invoice.  Otherwise, customer-specific
2732 terms or the default terms are used.
2733
2734 =back
2735
2736 =cut
2737
2738 sub bill {
2739   my( $self, %options ) = @_;
2740   return '' if $self->payby eq 'COMP';
2741   warn "$me bill customer ". $self->custnum. "\n"
2742     if $DEBUG;
2743
2744   my $time = $options{'time'} || time;
2745   my $invoice_time = $options{'invoice_time'} || $time;
2746
2747   $options{'not_pkgpart'} ||= {};
2748   $options{'not_pkgpart'} = { map { $_ => 1 }
2749                                   split(/\s*,\s*/, $options{'not_pkgpart'})
2750                             }
2751     unless ref($options{'not_pkgpart'});
2752
2753   local $SIG{HUP} = 'IGNORE';
2754   local $SIG{INT} = 'IGNORE';
2755   local $SIG{QUIT} = 'IGNORE';
2756   local $SIG{TERM} = 'IGNORE';
2757   local $SIG{TSTP} = 'IGNORE';
2758   local $SIG{PIPE} = 'IGNORE';
2759
2760   my $oldAutoCommit = $FS::UID::AutoCommit;
2761   local $FS::UID::AutoCommit = 0;
2762   my $dbh = dbh;
2763
2764   warn "$me acquiring lock on customer ". $self->custnum. "\n"
2765     if $DEBUG;
2766
2767   $self->select_for_update; #mutex
2768
2769   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
2770     if $DEBUG;
2771
2772   my $error = $self->do_cust_event(
2773     'debug'      => ( $options{'debug'} || 0 ),
2774     'time'       => $invoice_time,
2775     'check_freq' => $options{'check_freq'},
2776     'stage'      => 'pre-bill',
2777   );
2778   if ( $error ) {
2779     $dbh->rollback if $oldAutoCommit;
2780     return $error;
2781   }
2782
2783   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
2784     if $DEBUG;
2785
2786   #keep auto-charge and non-auto-charge line items separate
2787   my @passes = ( '', 'no_auto' );
2788
2789   my %cust_bill_pkg = map { $_ => [] } @passes;
2790
2791   ###
2792   # find the packages which are due for billing, find out how much they are
2793   # & generate invoice database.
2794   ###
2795
2796   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
2797   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
2798
2799   my %taxlisthash = map { $_ => {} } @passes;
2800
2801   my @precommit_hooks = ();
2802
2803   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
2804   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2805
2806     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2807
2808     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2809
2810     #? to avoid use of uninitialized value errors... ?
2811     $cust_pkg->setfield('bill', '')
2812       unless defined($cust_pkg->bill);
2813
2814     #my $part_pkg = $cust_pkg->part_pkg;
2815
2816     my $real_pkgpart = $cust_pkg->pkgpart;
2817     my %hash = $cust_pkg->hash;
2818
2819     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2820
2821       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2822
2823       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
2824
2825       my $error =
2826         $self->_make_lines( 'part_pkg'            => $part_pkg,
2827                             'cust_pkg'            => $cust_pkg,
2828                             'precommit_hooks'     => \@precommit_hooks,
2829                             'line_items'          => $cust_bill_pkg{$pass},
2830                             'setup'               => $total_setup{$pass},
2831                             'recur'               => $total_recur{$pass},
2832                             'tax_matrix'          => $taxlisthash{$pass},
2833                             'time'                => $time,
2834                             'real_pkgpart'        => $real_pkgpart,
2835                             'options'             => \%options,
2836                           );
2837       if ($error) {
2838         $dbh->rollback if $oldAutoCommit;
2839         return $error;
2840       }
2841
2842     } #foreach my $part_pkg
2843
2844   } #foreach my $cust_pkg
2845
2846   #if the customer isn't on an automatic payby, everything can go on a single
2847   #invoice anyway?
2848   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
2849     #merge everything into one list
2850   #}
2851
2852   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
2853
2854     my @cust_bill_pkg = @{ $cust_bill_pkg{$pass} };
2855
2856     next unless @cust_bill_pkg; #don't create an invoice w/o line items
2857
2858     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2859            !$conf->exists('postal_invoice-recurring_only')
2860        )
2861     {
2862
2863       my $postal_pkg = $self->charge_postal_fee();
2864       if ( $postal_pkg && !ref( $postal_pkg ) ) {
2865
2866         $dbh->rollback if $oldAutoCommit;
2867         return "can't charge postal invoice fee for customer ".
2868           $self->custnum. ": $postal_pkg";
2869
2870       } elsif ( $postal_pkg ) {
2871
2872         my $real_pkgpart = $postal_pkg->pkgpart;
2873         foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2874           my %postal_options = %options;
2875           delete $postal_options{cancel};
2876           my $error =
2877             $self->_make_lines( 'part_pkg'            => $part_pkg,
2878                                 'cust_pkg'            => $postal_pkg,
2879                                 'precommit_hooks'     => \@precommit_hooks,
2880                                 'line_items'          => \@cust_bill_pkg,
2881                                 'setup'               => $total_setup{$pass},
2882                                 'recur'               => $total_recur{$pass},
2883                                 'tax_matrix'          => $taxlisthash{$pass},
2884                                 'time'                => $time,
2885                                 'real_pkgpart'        => $real_pkgpart,
2886                                 'options'             => \%postal_options,
2887                               );
2888           if ($error) {
2889             $dbh->rollback if $oldAutoCommit;
2890             return $error;
2891           }
2892         }
2893
2894       }
2895
2896     }
2897
2898     my $listref_or_error =
2899       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
2900
2901     unless ( ref( $listref_or_error ) ) {
2902       $dbh->rollback if $oldAutoCommit;
2903       return $listref_or_error;
2904     }
2905
2906     foreach my $taxline ( @$listref_or_error ) {
2907       ${ $total_setup{$pass} } =
2908         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
2909       push @cust_bill_pkg, $taxline;
2910     }
2911
2912     #add tax adjustments
2913     warn "adding tax adjustments...\n" if $DEBUG > 2;
2914     foreach my $cust_tax_adjustment (
2915       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
2916                                        'billpkgnum' => '',
2917                                      }
2918              )
2919     ) {
2920
2921       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2922
2923       my $itemdesc = $cust_tax_adjustment->taxname;
2924       $itemdesc = '' if $itemdesc eq 'Tax';
2925
2926       push @cust_bill_pkg, new FS::cust_bill_pkg {
2927         'pkgnum'      => 0,
2928         'setup'       => $tax,
2929         'recur'       => 0,
2930         'sdate'       => '',
2931         'edate'       => '',
2932         'itemdesc'    => $itemdesc,
2933         'itemcomment' => $cust_tax_adjustment->comment,
2934         'cust_tax_adjustment' => $cust_tax_adjustment,
2935         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2936       };
2937
2938     }
2939
2940     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
2941
2942     my @cust_bill = $self->cust_bill;
2943     my $balance = $self->balance;
2944     my $previous_balance = scalar(@cust_bill)
2945                              ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
2946                              : 0;
2947
2948     $previous_balance += $cust_bill[$#cust_bill]->charged
2949       if scalar(@cust_bill);
2950     #my $balance_adjustments =
2951     #  sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
2952
2953     #create the new invoice
2954     my $cust_bill = new FS::cust_bill ( {
2955       'custnum'             => $self->custnum,
2956       '_date'               => ( $invoice_time ),
2957       'charged'             => $charged,
2958       'billing_balance'     => $balance,
2959       'previous_balance'    => $previous_balance,
2960       'invoice_terms'       => $options{'invoice_terms'},
2961     } );
2962     $error = $cust_bill->insert;
2963     if ( $error ) {
2964       $dbh->rollback if $oldAutoCommit;
2965       return "can't create invoice for customer #". $self->custnum. ": $error";
2966     }
2967
2968     foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2969       $cust_bill_pkg->invnum($cust_bill->invnum);
2970       my $error = $cust_bill_pkg->insert;
2971       if ( $error ) {
2972         $dbh->rollback if $oldAutoCommit;
2973         return "can't create invoice line item: $error";
2974       }
2975     }
2976
2977   } #foreach my $pass ( keys %cust_bill_pkg )
2978
2979   foreach my $hook ( @precommit_hooks ) {
2980     eval {
2981       &{$hook}; #($self) ?
2982     };
2983     if ( $@ ) {
2984       $dbh->rollback if $oldAutoCommit;
2985       return "$@ running precommit hook $hook\n";
2986     }
2987   }
2988
2989   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2990   ''; #no error
2991 }
2992
2993 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
2994
2995 This is a weird one.  Perhaps it should not even be exposed.
2996
2997 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
2998 Usually used internally by bill method B<bill>.
2999
3000 If there is an error, returns the error, otherwise returns reference to a
3001 list of line items suitable for insertion.
3002
3003 =over 4
3004
3005 =item LINEITEMREF
3006
3007 An array ref of the line items being billed.
3008
3009 =item TAXHASHREF
3010
3011 A strange beast.  The keys to this hash are internal identifiers consisting
3012 of the name of the tax object type, a space, and its unique identifier ( e.g.
3013  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
3014 item in the list is the tax object.  The remaining items are either line
3015 items or floating point values (currency amounts).
3016
3017 The taxes are calculated on this entity.  Calculated exemption records are
3018 transferred to the LINEITEMREF items on the assumption that they are related.
3019
3020 Read the source.
3021
3022 =item INVOICE_TIME
3023
3024 This specifies the date appearing on the associated invoice.  Some
3025 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
3026
3027 =back
3028
3029 =cut
3030 sub calculate_taxes {
3031   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
3032
3033   my @tax_line_items = ();
3034
3035   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
3036
3037   # keys are tax names (as printed on invoices / itemdesc )
3038   # values are listrefs of taxlisthash keys (internal identifiers)
3039   my %taxname = ();
3040
3041   # keys are taxlisthash keys (internal identifiers)
3042   # values are (cumulative) amounts
3043   my %tax = ();
3044
3045   # keys are taxlisthash keys (internal identifiers)
3046   # values are listrefs of cust_bill_pkg_tax_location hashrefs
3047   my %tax_location = ();
3048
3049   # keys are taxlisthash keys (internal identifiers)
3050   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
3051   my %tax_rate_location = ();
3052
3053   foreach my $tax ( keys %$taxlisthash ) {
3054     my $tax_object = shift @{ $taxlisthash->{$tax} };
3055     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
3056     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
3057     my $hashref_or_error =
3058       $tax_object->taxline( $taxlisthash->{$tax},
3059                             'custnum'      => $self->custnum,
3060                             'invoice_time' => $invoice_time
3061                           );
3062     return $hashref_or_error unless ref($hashref_or_error);
3063
3064     unshift @{ $taxlisthash->{$tax} }, $tax_object;
3065
3066     my $name   = $hashref_or_error->{'name'};
3067     my $amount = $hashref_or_error->{'amount'};
3068
3069     #warn "adding $amount as $name\n";
3070     $taxname{ $name } ||= [];
3071     push @{ $taxname{ $name } }, $tax;
3072
3073     $tax{ $tax } += $amount;
3074
3075     $tax_location{ $tax } ||= [];
3076     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
3077       push @{ $tax_location{ $tax }  },
3078         {
3079           'taxnum'      => $tax_object->taxnum,
3080           'taxtype'     => ref($tax_object),
3081           'pkgnum'      => $tax_object->get('pkgnum'),
3082           'locationnum' => $tax_object->get('locationnum'),
3083           'amount'      => sprintf('%.2f', $amount ),
3084         };
3085     }
3086
3087     $tax_rate_location{ $tax } ||= [];
3088     if ( ref($tax_object) eq 'FS::tax_rate' ) {
3089       my $taxratelocationnum =
3090         $tax_object->tax_rate_location->taxratelocationnum;
3091       push @{ $tax_rate_location{ $tax }  },
3092         {
3093           'taxnum'             => $tax_object->taxnum,
3094           'taxtype'            => ref($tax_object),
3095           'amount'             => sprintf('%.2f', $amount ),
3096           'locationtaxid'      => $tax_object->location,
3097           'taxratelocationnum' => $taxratelocationnum,
3098         };
3099     }
3100
3101   }
3102
3103   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
3104   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
3105   foreach my $tax ( keys %$taxlisthash ) {
3106     foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
3107       next unless ref($_) eq 'FS::cust_bill_pkg';
3108
3109       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
3110         splice( @{ $_->_cust_tax_exempt_pkg } );
3111     }
3112   }
3113
3114   #consolidate and create tax line items
3115   warn "consolidating and generating...\n" if $DEBUG > 2;
3116   foreach my $taxname ( keys %taxname ) {
3117     my $tax = 0;
3118     my %seen = ();
3119     my @cust_bill_pkg_tax_location = ();
3120     my @cust_bill_pkg_tax_rate_location = ();
3121     warn "adding $taxname\n" if $DEBUG > 1;
3122     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
3123       next if $seen{$taxitem}++;
3124       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
3125       $tax += $tax{$taxitem};
3126       push @cust_bill_pkg_tax_location,
3127         map { new FS::cust_bill_pkg_tax_location $_ }
3128             @{ $tax_location{ $taxitem } };
3129       push @cust_bill_pkg_tax_rate_location,
3130         map { new FS::cust_bill_pkg_tax_rate_location $_ }
3131             @{ $tax_rate_location{ $taxitem } };
3132     }
3133     next unless $tax;
3134
3135     $tax = sprintf('%.2f', $tax );
3136
3137     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
3138                                                    'disabled'     => '',
3139                                                  },
3140                                );
3141
3142     my @display = ();
3143     if ( $pkg_category and
3144          $conf->config('invoice_latexsummary') ||
3145          $conf->config('invoice_htmlsummary')
3146        )
3147     {
3148
3149       my %hash = (  'section' => $pkg_category->categoryname );
3150       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3151
3152     }
3153
3154     push @tax_line_items, new FS::cust_bill_pkg {
3155       'pkgnum'   => 0,
3156       'setup'    => $tax,
3157       'recur'    => 0,
3158       'sdate'    => '',
3159       'edate'    => '',
3160       'itemdesc' => $taxname,
3161       'display'  => \@display,
3162       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
3163       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
3164     };
3165
3166   }
3167
3168   \@tax_line_items;
3169 }
3170
3171 sub _make_lines {
3172   my ($self, %params) = @_;
3173
3174   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
3175   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
3176   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
3177   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
3178   my $total_setup = $params{setup} or die "no setup accumulator specified";
3179   my $total_recur = $params{recur} or die "no recur accumulator specified";
3180   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
3181   my $time = $params{'time'} or die "no time specified";
3182   my (%options) = %{$params{options}};
3183
3184   my $dbh = dbh;
3185   my $real_pkgpart = $params{real_pkgpart};
3186   my %hash = $cust_pkg->hash;
3187   my $old_cust_pkg = new FS::cust_pkg \%hash;
3188
3189   my @details = ();
3190   my @discounts = ();
3191   my $lineitems = 0;
3192
3193   $cust_pkg->pkgpart($part_pkg->pkgpart);
3194
3195   ###
3196   # bill setup
3197   ###
3198
3199   my $setup = 0;
3200   my $unitsetup = 0;
3201   if ( $options{'resetup'}
3202        || ( ! $cust_pkg->setup
3203             && ( ! $cust_pkg->start_date
3204                  || $cust_pkg->start_date <= $time
3205                )
3206             && ( ! $conf->exists('disable_setup_suspended_pkgs')
3207                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
3208                       ! $cust_pkg->getfield('susp')
3209                     )
3210                )
3211           )
3212     )
3213   {
3214
3215     warn "    bill setup\n" if $DEBUG > 1;
3216     $lineitems++;
3217
3218     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
3219     return "$@ running calc_setup for $cust_pkg\n"
3220       if $@;
3221
3222     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
3223
3224     $cust_pkg->setfield('setup', $time)
3225       unless $cust_pkg->setup;
3226           #do need it, but it won't get written to the db
3227           #|| $cust_pkg->pkgpart != $real_pkgpart;
3228
3229     $cust_pkg->setfield('start_date', '')
3230       if $cust_pkg->start_date;
3231
3232   }
3233
3234   ###
3235   # bill recurring fee
3236   ###
3237
3238   #XXX unit stuff here too
3239   my $recur = 0;
3240   my $unitrecur = 0;
3241   my $sdate;
3242   if (     ! $cust_pkg->get('susp')
3243        and ! $cust_pkg->get('start_date')
3244        and ( $part_pkg->getfield('freq') ne '0'
3245              && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3246            )
3247         || ( $part_pkg->plan eq 'voip_cdr'
3248               && $part_pkg->option('bill_every_call')
3249            )
3250         || ( $options{cancel} )
3251   ) {
3252
3253     # XXX should this be a package event?  probably.  events are called
3254     # at collection time at the moment, though...
3255     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
3256       if $part_pkg->can('reset_usage');
3257       #don't want to reset usage just cause we want a line item??
3258       #&& $part_pkg->pkgpart == $real_pkgpart;
3259
3260     warn "    bill recur\n" if $DEBUG > 1;
3261     $lineitems++;
3262
3263     # XXX shared with $recur_prog
3264     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
3265              || $cust_pkg->setup
3266              || $time;
3267
3268     #over two params!  lets at least switch to a hashref for the rest...
3269     my $increment_next_bill = ( $part_pkg->freq ne '0'
3270                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3271                                 && !$options{cancel}
3272                               );
3273     my %param = ( 'precommit_hooks'     => $precommit_hooks,
3274                   'increment_next_bill' => $increment_next_bill,
3275                   'discounts'           => \@discounts,
3276                 );
3277
3278     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
3279     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
3280     return "$@ running $method for $cust_pkg\n"
3281       if ( $@ );
3282
3283     if ( $increment_next_bill ) {
3284
3285       my $next_bill = $part_pkg->add_freq($sdate);
3286       return "unparsable frequency: ". $part_pkg->freq
3287         if $next_bill == -1;
3288
3289       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
3290       # only for figuring next bill date, nothing else, so, reset $sdate again
3291       # here
3292       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
3293       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
3294       $cust_pkg->last_bill($sdate);
3295
3296       $cust_pkg->setfield('bill', $next_bill );
3297
3298     }
3299
3300   }
3301
3302   warn "\$setup is undefined" unless defined($setup);
3303   warn "\$recur is undefined" unless defined($recur);
3304   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
3305
3306   ###
3307   # If there's line items, create em cust_bill_pkg records
3308   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
3309   ###
3310
3311   if ( $lineitems ) {
3312
3313     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
3314       # hmm.. and if just the options are modified in some weird price plan?
3315
3316       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
3317         if $DEBUG >1;
3318
3319       my $error = $cust_pkg->replace( $old_cust_pkg,
3320                                       'options' => { $cust_pkg->options },
3321                                     );
3322       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
3323         if $error; #just in case
3324     }
3325
3326     $setup = sprintf( "%.2f", $setup );
3327     $recur = sprintf( "%.2f", $recur );
3328     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3329       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3330     }
3331     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3332       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3333     }
3334
3335     if ( $setup != 0 || $recur != 0 ) {
3336
3337       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
3338         if $DEBUG > 1;
3339
3340       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3341       if ( $DEBUG > 1 ) {
3342         warn "      adding customer package invoice detail: $_\n"
3343           foreach @cust_pkg_detail;
3344       }
3345       push @details, @cust_pkg_detail;
3346
3347       my $cust_bill_pkg = new FS::cust_bill_pkg {
3348         'pkgnum'    => $cust_pkg->pkgnum,
3349         'setup'     => $setup,
3350         'unitsetup' => $unitsetup,
3351         'recur'     => $recur,
3352         'unitrecur' => $unitrecur,
3353         'quantity'  => $cust_pkg->quantity,
3354         'details'   => \@details,
3355         'discounts' => \@discounts,
3356         'hidden'    => $part_pkg->hidden,
3357       };
3358
3359       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3360         $cust_bill_pkg->sdate( $hash{last_bill} );
3361         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
3362         $cust_bill_pkg->edate( $time ) if $options{cancel};
3363       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3364         $cust_bill_pkg->sdate( $sdate );
3365         $cust_bill_pkg->edate( $cust_pkg->bill );
3366         #$cust_bill_pkg->edate( $time ) if $options{cancel};
3367       }
3368
3369       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3370         unless $part_pkg->pkgpart == $real_pkgpart;
3371
3372       $$total_setup += $setup;
3373       $$total_recur += $recur;
3374
3375       ###
3376       # handle taxes
3377       ###
3378
3379       my $error =
3380         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3381       return $error if $error;
3382
3383       push @$cust_bill_pkgs, $cust_bill_pkg;
3384
3385     } #if $setup != 0 || $recur != 0
3386
3387   } #if $line_items
3388
3389   '';
3390
3391 }
3392
3393 sub _handle_taxes {
3394   my $self = shift;
3395   my $part_pkg = shift;
3396   my $taxlisthash = shift;
3397   my $cust_bill_pkg = shift;
3398   my $cust_pkg = shift;
3399   my $invoice_time = shift;
3400   my $real_pkgpart = shift;
3401   my $options = shift;
3402
3403   my %cust_bill_pkg = ();
3404   my %taxes = ();
3405
3406   my @classes;
3407   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3408   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3409   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3410   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3411
3412   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3413
3414     if ( $conf->exists('enable_taxproducts')
3415          && ( scalar($part_pkg->part_pkg_taxoverride)
3416               || $part_pkg->has_taxproduct
3417             )
3418        )
3419     {
3420
3421       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3422         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3423       }
3424
3425       foreach my $class (@classes) {
3426         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3427         return $err_or_ref unless ref($err_or_ref);
3428         $taxes{$class} = $err_or_ref;
3429       }
3430
3431       unless (exists $taxes{''}) {
3432         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3433         return $err_or_ref unless ref($err_or_ref);
3434         $taxes{''} = $err_or_ref;
3435       }
3436
3437     } else {
3438
3439       my @loc_keys = qw( city county state country );
3440       my %taxhash;
3441       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3442         my $cust_location = $cust_pkg->cust_location;
3443         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
3444       } else {
3445         my $prefix =
3446           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3447           ? 'ship_'
3448           : '';
3449         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3450       }
3451
3452       $taxhash{'taxclass'} = $part_pkg->taxclass;
3453
3454       my @taxes = ();
3455       my %taxhash_elim = %taxhash;
3456       my @elim = qw( city county state );
3457       do {
3458
3459         #first try a match with taxclass
3460         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3461
3462         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
3463           #then try a match without taxclass
3464           my %no_taxclass = %taxhash_elim;
3465           $no_taxclass{ 'taxclass' } = '';
3466           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
3467         }
3468
3469         $taxhash_elim{ shift(@elim) } = '';
3470
3471       } while ( !scalar(@taxes) && scalar(@elim) );
3472
3473       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3474                     @taxes
3475         if $self->cust_main_exemption; #just to be safe
3476
3477       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3478         foreach (@taxes) {
3479           $_->set('pkgnum',      $cust_pkg->pkgnum );
3480           $_->set('locationnum', $cust_pkg->locationnum );
3481         }
3482       }
3483
3484       $taxes{''} = [ @taxes ];
3485       $taxes{'setup'} = [ @taxes ];
3486       $taxes{'recur'} = [ @taxes ];
3487       $taxes{$_} = [ @taxes ] foreach (@classes);
3488
3489       # # maybe eliminate this entirely, along with all the 0% records
3490       # unless ( @taxes ) {
3491       #   return
3492       #     "fatal: can't find tax rate for state/county/country/taxclass ".
3493       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
3494       # }
3495
3496     } #if $conf->exists('enable_taxproducts') ...
3497
3498   }
3499
3500   my @display = ();
3501   my $separate = $conf->exists('separate_usage');
3502   my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!');
3503   if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) {
3504
3505     my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3506     my %hash = $cust_bill_pkg->hidden  # maybe for all bill linked?
3507                ? (  'section' => $temp_pkg->part_pkg->categoryname )
3508                : ();
3509
3510     my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3511     my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3512     if ( $separate ) {
3513       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3514       push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3515     } else {
3516       push @display, new FS::cust_bill_pkg_display
3517                        { type => '',
3518                          %hash,
3519                          ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3520                        };
3521     }
3522
3523     if ($separate && $section && $summary) {
3524       push @display, new FS::cust_bill_pkg_display { type    => 'U',
3525                                                      summary => 'Y',
3526                                                      %hash,
3527                                                    };
3528     }
3529     if ($usage_mandate || $section && $summary) {
3530       $hash{post_total} = 'Y';
3531     }
3532
3533     $hash{section} = $section if ($separate || $usage_mandate);
3534     push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3535
3536   }
3537   $cust_bill_pkg->set('display', \@display);
3538
3539   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3540   foreach my $key (keys %tax_cust_bill_pkg) {
3541     my @taxes = @{ $taxes{$key} || [] };
3542     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3543
3544     my %localtaxlisthash = ();
3545     foreach my $tax ( @taxes ) {
3546
3547       my $taxname = ref( $tax ). ' '. $tax->taxnum;
3548 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3549 #                  ' locationnum'. $cust_pkg->locationnum
3550 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3551
3552       $taxlisthash->{ $taxname } ||= [ $tax ];
3553       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
3554
3555       $localtaxlisthash{ $taxname } ||= [ $tax ];
3556       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
3557
3558     }
3559
3560     warn "finding taxed taxes...\n" if $DEBUG > 2;
3561     foreach my $tax ( keys %localtaxlisthash ) {
3562       my $tax_object = shift @{ $localtaxlisthash{$tax} };
3563       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3564         if $DEBUG > 2;
3565       next unless $tax_object->can('tax_on_tax');
3566
3567       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3568         my $totname = ref( $tot ). ' '. $tot->taxnum;
3569
3570         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3571           if $DEBUG > 2;
3572         next unless exists( $localtaxlisthash{ $totname } ); # only increase
3573                                                              # existing taxes
3574         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3575         my $hashref_or_error =
3576           $tax_object->taxline( $localtaxlisthash{$tax},
3577                                 'custnum'      => $self->custnum,
3578                                 'invoice_time' => $invoice_time,
3579                               );
3580         return $hashref_or_error
3581           unless ref($hashref_or_error);
3582
3583         $taxlisthash->{ $totname } ||= [ $tot ];
3584         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
3585
3586       }
3587     }
3588
3589   }
3590
3591   '';
3592 }
3593
3594 sub _gather_taxes {
3595   my $self = shift;
3596   my $part_pkg = shift;
3597   my $class = shift;
3598
3599   my @taxes = ();
3600   my $geocode = $self->geocode('cch');
3601
3602   my @taxclassnums = map { $_->taxclassnum }
3603                      $part_pkg->part_pkg_taxoverride($class);
3604
3605   unless (@taxclassnums) {
3606     @taxclassnums = map { $_->taxclassnum }
3607                     grep { $_->taxable eq 'Y' }
3608                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3609   }
3610   warn "Found taxclassnum values of ". join(',', @taxclassnums)
3611     if $DEBUG;
3612
3613   my $extra_sql =
3614     "AND (".
3615     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3616
3617   @taxes = qsearch({ 'table' => 'tax_rate',
3618                      'hashref' => { 'geocode' => $geocode, },
3619                      'extra_sql' => $extra_sql,
3620                   })
3621     if scalar(@taxclassnums);
3622
3623   warn "Found taxes ".
3624        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3625    if $DEBUG;
3626
3627   [ @taxes ];
3628
3629 }
3630
3631 =item collect [ HASHREF | OPTION => VALUE ... ]
3632
3633 (Attempt to) collect money for this customer's outstanding invoices (see
3634 L<FS::cust_bill>).  Usually used after the bill method.
3635
3636 Actions are now triggered by billing events; see L<FS::part_event> and the
3637 billing events web interface.  Old-style invoice events (see
3638 L<FS::part_bill_event>) have been deprecated.
3639
3640 If there is an error, returns the error, otherwise returns false.
3641
3642 Options are passed as name-value pairs.
3643
3644 Currently available options are:
3645
3646 =over 4
3647
3648 =item invoice_time
3649
3650 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
3651
3652 =item retry
3653
3654 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3655
3656 =item check_freq
3657
3658 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3659
3660 =item quiet
3661
3662 set true to surpress email card/ACH decline notices.
3663
3664 =item debug
3665
3666 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3667
3668 =back
3669
3670 # =item payby
3671 #
3672 # allows for one time override of normal customer billing method
3673
3674 =cut
3675
3676 sub collect {
3677   my( $self, %options ) = @_;
3678   my $invoice_time = $options{'invoice_time'} || time;
3679
3680   #put below somehow?
3681   local $SIG{HUP} = 'IGNORE';
3682   local $SIG{INT} = 'IGNORE';
3683   local $SIG{QUIT} = 'IGNORE';
3684   local $SIG{TERM} = 'IGNORE';
3685   local $SIG{TSTP} = 'IGNORE';
3686   local $SIG{PIPE} = 'IGNORE';
3687
3688   my $oldAutoCommit = $FS::UID::AutoCommit;
3689   local $FS::UID::AutoCommit = 0;
3690   my $dbh = dbh;
3691
3692   $self->select_for_update; #mutex
3693
3694   if ( $DEBUG ) {
3695     my $balance = $self->balance;
3696     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3697   }
3698
3699   if ( exists($options{'retry_card'}) ) {
3700     carp 'retry_card option passed to collect is deprecated; use retry';
3701     $options{'retry'} ||= $options{'retry_card'};
3702   }
3703   if ( exists($options{'retry'}) && $options{'retry'} ) {
3704     my $error = $self->retry_realtime;
3705     if ( $error ) {
3706       $dbh->rollback if $oldAutoCommit;
3707       return $error;
3708     }
3709   }
3710
3711   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3712
3713   #never want to roll back an event just because it returned an error
3714   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
3715
3716   $self->do_cust_event(
3717     'debug'      => ( $options{'debug'} || 0 ),
3718     'time'       => $invoice_time,
3719     'check_freq' => $options{'check_freq'},
3720     'stage'      => 'collect',
3721   );
3722
3723 }
3724
3725 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3726
3727 Runs billing events; see L<FS::part_event> and the billing events web
3728 interface.
3729
3730 If there is an error, returns the error, otherwise returns false.
3731
3732 Options are passed as name-value pairs.
3733
3734 Currently available options are:
3735
3736 =over 4
3737
3738 =item time
3739
3740 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
3741
3742 =item check_freq
3743
3744 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3745
3746 =item stage
3747
3748 "collect" (the default) or "pre-bill"
3749
3750 =item quiet
3751
3752 set true to surpress email card/ACH decline notices.
3753
3754 =item debug
3755
3756 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3757
3758 =cut
3759
3760 # =item payby
3761 #
3762 # allows for one time override of normal customer billing method
3763
3764 # =item retry
3765 #
3766 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3767
3768 sub do_cust_event {
3769   my( $self, %options ) = @_;
3770   my $time = $options{'time'} || time;
3771
3772   #put below somehow?
3773   local $SIG{HUP} = 'IGNORE';
3774   local $SIG{INT} = 'IGNORE';
3775   local $SIG{QUIT} = 'IGNORE';
3776   local $SIG{TERM} = 'IGNORE';
3777   local $SIG{TSTP} = 'IGNORE';
3778   local $SIG{PIPE} = 'IGNORE';
3779
3780   my $oldAutoCommit = $FS::UID::AutoCommit;
3781   local $FS::UID::AutoCommit = 0;
3782   my $dbh = dbh;
3783
3784   $self->select_for_update; #mutex
3785
3786   if ( $DEBUG ) {
3787     my $balance = $self->balance;
3788     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
3789   }
3790
3791 #  if ( exists($options{'retry_card'}) ) {
3792 #    carp 'retry_card option passed to collect is deprecated; use retry';
3793 #    $options{'retry'} ||= $options{'retry_card'};
3794 #  }
3795 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
3796 #    my $error = $self->retry_realtime;
3797 #    if ( $error ) {
3798 #      $dbh->rollback if $oldAutoCommit;
3799 #      return $error;
3800 #    }
3801 #  }
3802
3803   # false laziness w/pay_batch::import_results
3804
3805   my $due_cust_event = $self->due_cust_event(
3806     'debug'      => ( $options{'debug'} || 0 ),
3807     'time'       => $time,
3808     'check_freq' => $options{'check_freq'},
3809     'stage'      => ( $options{'stage'} || 'collect' ),
3810   );
3811   unless( ref($due_cust_event) ) {
3812     $dbh->rollback if $oldAutoCommit;
3813     return $due_cust_event;
3814   }
3815
3816   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3817   #never want to roll back an event just because it or a different one
3818   # returned an error
3819   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
3820
3821   foreach my $cust_event ( @$due_cust_event ) {
3822
3823     #XXX lock event
3824
3825     #re-eval event conditions (a previous event could have changed things)
3826     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
3827       #don't leave stray "new/locked" records around
3828       my $error = $cust_event->delete;
3829       return $error if $error;
3830       next;
3831     }
3832
3833     {
3834       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3835       warn "  running cust_event ". $cust_event->eventnum. "\n"
3836         if $DEBUG > 1;
3837
3838       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3839       if ( my $error = $cust_event->do_event() ) {
3840         #XXX wtf is this?  figure out a proper dealio with return value
3841         #from do_event
3842         return $error;
3843       }
3844     }
3845
3846   }
3847
3848   '';
3849
3850 }
3851
3852 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3853
3854 Inserts database records for and returns an ordered listref of new events due
3855 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
3856 events are due, an empty listref is returned.  If there is an error, returns a
3857 scalar error message.
3858
3859 To actually run the events, call each event's test_condition method, and if
3860 still true, call the event's do_event method.
3861
3862 Options are passed as a hashref or as a list of name-value pairs.  Available
3863 options are:
3864
3865 =over 4
3866
3867 =item check_freq
3868
3869 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
3870
3871 =item stage
3872
3873 "collect" (the default) or "pre-bill"
3874
3875 =item time
3876
3877 "Current time" for the events.
3878
3879 =item debug
3880
3881 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3882
3883 =item eventtable
3884
3885 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3886
3887 =item objects
3888
3889 Explicitly pass the objects to be tested (typically used with eventtable).
3890
3891 =item testonly
3892
3893 Set to true to return the objects, but not actually insert them into the
3894 database.
3895
3896 =back
3897
3898 =cut
3899
3900 sub due_cust_event {
3901   my $self = shift;
3902   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3903
3904   #???
3905   #my $DEBUG = $opt{'debug'}
3906   local($DEBUG) = $opt{'debug'}
3907     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3908
3909   warn "$me due_cust_event called with options ".
3910        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3911     if $DEBUG;
3912
3913   $opt{'time'} ||= time;
3914
3915   local $SIG{HUP} = 'IGNORE';
3916   local $SIG{INT} = 'IGNORE';
3917   local $SIG{QUIT} = 'IGNORE';
3918   local $SIG{TERM} = 'IGNORE';
3919   local $SIG{TSTP} = 'IGNORE';
3920   local $SIG{PIPE} = 'IGNORE';
3921
3922   my $oldAutoCommit = $FS::UID::AutoCommit;
3923   local $FS::UID::AutoCommit = 0;
3924   my $dbh = dbh;
3925
3926   $self->select_for_update #mutex
3927     unless $opt{testonly};
3928
3929   ###
3930   # find possible events (initial search)
3931   ###
3932
3933   my @cust_event = ();
3934
3935   my @eventtable = $opt{'eventtable'}
3936                      ? ( $opt{'eventtable'} )
3937                      : FS::part_event->eventtables_runorder;
3938
3939   foreach my $eventtable ( @eventtable ) {
3940
3941     my @objects;
3942     if ( $opt{'objects'} ) {
3943
3944       @objects = @{ $opt{'objects'} };
3945
3946     } else {
3947
3948       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3949       @objects = ( $eventtable eq 'cust_main' )
3950                    ? ( $self )
3951                    : ( $self->$eventtable() );
3952
3953     }
3954
3955     my @e_cust_event = ();
3956
3957     my $cross = "CROSS JOIN $eventtable";
3958     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3959       unless $eventtable eq 'cust_main';
3960
3961     foreach my $object ( @objects ) {
3962
3963       #this first search uses the condition_sql magic for optimization.
3964       #the more possible events we can eliminate in this step the better
3965
3966       my $cross_where = '';
3967       my $pkey = $object->primary_key;
3968       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3969
3970       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3971       my $extra_sql =
3972         FS::part_event_condition->where_conditions_sql( $eventtable,
3973                                                         'time'=>$opt{'time'}
3974                                                       );
3975       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3976
3977       $extra_sql = "AND $extra_sql" if $extra_sql;
3978
3979       #here is the agent virtualization
3980       $extra_sql .= " AND (    part_event.agentnum IS NULL
3981                             OR part_event.agentnum = ". $self->agentnum. ' )';
3982
3983       $extra_sql .= " $order";
3984
3985       warn "searching for events for $eventtable ". $object->$pkey. "\n"
3986         if $opt{'debug'} > 2;
3987       my @part_event = qsearch( {
3988         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
3989         'select'    => 'part_event.*',
3990         'table'     => 'part_event',
3991         'addl_from' => "$cross $join",
3992         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3993                          'eventtable' => $eventtable,
3994                          'disabled'   => '',
3995                        },
3996         'extra_sql' => "AND $cross_where $extra_sql",
3997       } );
3998
3999       if ( $DEBUG > 2 ) {
4000         my $pkey = $object->primary_key;
4001         warn "      ". scalar(@part_event).
4002              " possible events found for $eventtable ". $object->$pkey(). "\n";
4003       }
4004
4005       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
4006
4007     }
4008
4009     warn "    ". scalar(@e_cust_event).
4010          " subtotal possible cust events found for $eventtable\n"
4011       if $DEBUG > 1;
4012
4013     push @cust_event, @e_cust_event;
4014
4015   }
4016
4017   warn "  ". scalar(@cust_event).
4018        " total possible cust events found in initial search\n"
4019     if $DEBUG; # > 1;
4020
4021
4022   ##
4023   # test stage
4024   ##
4025
4026   $opt{stage} ||= 'collect';
4027   @cust_event =
4028     grep { my $stage = $_->part_event->event_stage;
4029            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
4030          }
4031          @cust_event;
4032
4033   ##
4034   # test conditions
4035   ##
4036
4037   my %unsat = ();
4038
4039   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
4040                                           'stats_hashref' => \%unsat ),
4041                      @cust_event;
4042
4043   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
4044     if $DEBUG; # > 1;
4045
4046   warn "    invalid conditions not eliminated with condition_sql:\n".
4047        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
4048     if keys %unsat && $DEBUG; # > 1;
4049
4050   ##
4051   # insert
4052   ##
4053
4054   unless( $opt{testonly} ) {
4055     foreach my $cust_event ( @cust_event ) {
4056
4057       my $error = $cust_event->insert();
4058       if ( $error ) {
4059         $dbh->rollback if $oldAutoCommit;
4060         return $error;
4061       }
4062
4063     }
4064   }
4065
4066   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4067
4068   ##
4069   # return
4070   ##
4071
4072   warn "  returning events: ". Dumper(@cust_event). "\n"
4073     if $DEBUG > 2;
4074
4075   \@cust_event;
4076
4077 }
4078
4079 =item retry_realtime
4080
4081 Schedules realtime / batch  credit card / electronic check / LEC billing
4082 events for for retry.  Useful if card information has changed or manual
4083 retry is desired.  The 'collect' method must be called to actually retry
4084 the transaction.
4085
4086 Implementation details: For either this customer, or for each of this
4087 customer's open invoices, changes the status of the first "done" (with
4088 statustext error) realtime processing event to "failed".
4089
4090 =cut
4091
4092 sub retry_realtime {
4093   my $self = shift;
4094
4095   local $SIG{HUP} = 'IGNORE';
4096   local $SIG{INT} = 'IGNORE';
4097   local $SIG{QUIT} = 'IGNORE';
4098   local $SIG{TERM} = 'IGNORE';
4099   local $SIG{TSTP} = 'IGNORE';
4100   local $SIG{PIPE} = 'IGNORE';
4101
4102   my $oldAutoCommit = $FS::UID::AutoCommit;
4103   local $FS::UID::AutoCommit = 0;
4104   my $dbh = dbh;
4105
4106   #a little false laziness w/due_cust_event (not too bad, really)
4107
4108   my $join = FS::part_event_condition->join_conditions_sql;
4109   my $order = FS::part_event_condition->order_conditions_sql;
4110   my $mine =
4111   '( '
4112    . join ( ' OR ' , map {
4113     "( part_event.eventtable = " . dbh->quote($_)
4114     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
4115    } FS::part_event->eventtables)
4116    . ') ';
4117
4118   #here is the agent virtualization
4119   my $agent_virt = " (    part_event.agentnum IS NULL
4120                        OR part_event.agentnum = ". $self->agentnum. ' )';
4121
4122   #XXX this shouldn't be hardcoded, actions should declare it...
4123   my @realtime_events = qw(
4124     cust_bill_realtime_card
4125     cust_bill_realtime_check
4126     cust_bill_realtime_lec
4127     cust_bill_batch
4128   );
4129
4130   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
4131                                                   @realtime_events
4132                                      ).
4133                           ' ) ';
4134
4135   my @cust_event = qsearchs({
4136     'table'     => 'cust_event',
4137     'select'    => 'cust_event.*',
4138     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
4139     'hashref'   => { 'status' => 'done' },
4140     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
4141                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
4142   });
4143
4144   my %seen_invnum = ();
4145   foreach my $cust_event (@cust_event) {
4146
4147     #max one for the customer, one for each open invoice
4148     my $cust_X = $cust_event->cust_X;
4149     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
4150                           ? $cust_X->invnum
4151                           : 0
4152                         }++
4153          or $cust_event->part_event->eventtable eq 'cust_bill'
4154             && ! $cust_X->owed;
4155
4156     my $error = $cust_event->retry;
4157     if ( $error ) {
4158       $dbh->rollback if $oldAutoCommit;
4159       return "error scheduling event for retry: $error";
4160     }
4161
4162   }
4163
4164   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4165   '';
4166
4167 }
4168
4169
4170 =cut
4171
4172 =item realtime_collect [ OPTION => VALUE ... ]
4173
4174 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4175 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4176 gateway.  See L<http://420.am/business-onlinepayment> and
4177 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4178
4179 On failure returns an error message.
4180
4181 Returns false or a hashref upon success.  The hashref contains keys popup_url reference, and collectitems.  The first is a URL to which a browser should be redirected for completion of collection.  The second is a reference id for the transaction suitable for the end user.  The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
4182
4183 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4184
4185 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4186 then it is deduced from the customer record.
4187
4188 If no I<amount> is specified, then the customer balance is used.
4189
4190 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4191 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4192 if set, will override the value from the customer record.
4193
4194 I<description> is a free-text field passed to the gateway.  It defaults to
4195 the value defined by the business-onlinepayment-description configuration
4196 option, or "Internet services" if that is unset.
4197
4198 If an I<invnum> is specified, this payment (if successful) is applied to the
4199 specified invoice.  If you don't specify an I<invnum> you might want to
4200 call the B<apply_payments> method or set the I<apply> option.
4201
4202 I<apply> can be set to true to apply a resulting payment.
4203
4204 I<quiet> can be set true to surpress email decline notices.
4205
4206 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4207 resulting paynum, if any.
4208
4209 I<payunique> is a unique identifier for this payment.
4210
4211 I<session_id> is a session identifier associated with this payment.
4212
4213 I<depend_jobnum> allows payment capture to unlock export jobs
4214
4215 =cut
4216
4217 sub realtime_collect {
4218   my( $self, %options ) = @_;
4219
4220   if ( $DEBUG ) {
4221     warn "$me realtime_collect:\n";
4222     warn "  $_ => $options{$_}\n" foreach keys %options;
4223   }
4224
4225   $options{amount} = $self->balance unless exists( $options{amount} );
4226   $options{method} = FS::payby->payby2bop($self->payby)
4227     unless exists( $options{method} );
4228
4229   return $self->realtime_bop({%options});
4230
4231 }
4232
4233 =item realtime_bop { [ ARG => VALUE ... ] }
4234
4235 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4236 via a Business::OnlinePayment realtime gateway.  See
4237 L<http://420.am/business-onlinepayment> for supported gateways.
4238
4239 Required arguments in the hashref are I<method>, and I<amount>
4240
4241 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4242
4243 Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4244
4245 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4246 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4247 if set, will override the value from the customer record.
4248
4249 I<description> is a free-text field passed to the gateway.  It defaults to
4250 the value defined by the business-onlinepayment-description configuration
4251 option, or "Internet services" if that is unset.
4252
4253 If an I<invnum> is specified, this payment (if successful) is applied to the
4254 specified invoice.  If you don't specify an I<invnum> you might want to
4255 call the B<apply_payments> method or set the I<apply> option.
4256
4257 I<apply> can be set to true to apply a resulting payment.
4258
4259 I<quiet> can be set true to surpress email decline notices.
4260
4261 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4262 resulting paynum, if any.
4263
4264 I<payunique> is a unique identifier for this payment.
4265
4266 I<session_id> is a session identifier associated with this payment.
4267
4268 I<depend_jobnum> allows payment capture to unlock export jobs
4269
4270 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4271
4272 =cut
4273
4274 # some helper routines
4275 sub _bop_recurring_billing {
4276   my( $self, %opt ) = @_;
4277
4278   my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4279
4280   if ( defined($method) && $method eq 'transaction_is_recur' ) {
4281
4282     return 1 if $opt{'trans_is_recur'};
4283
4284   } else {
4285
4286     my %hash = ( 'custnum' => $self->custnum,
4287                  'payby'   => 'CARD',
4288                );
4289
4290     return 1
4291       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4292       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4293                                                                $opt{'payinfo'} )
4294                              } );
4295
4296   }
4297
4298   return 0;
4299
4300 }
4301
4302 sub _payment_gateway {
4303   my ($self, $options) = @_;
4304
4305   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4306     unless exists($options->{payment_gateway});
4307
4308   $options->{payment_gateway};
4309 }
4310
4311 sub _bop_auth {
4312   my ($self, $options) = @_;
4313
4314   (
4315     'login'    => $options->{payment_gateway}->gateway_username,
4316     'password' => $options->{payment_gateway}->gateway_password,
4317   );
4318 }
4319
4320 sub _bop_options {
4321   my ($self, $options) = @_;
4322
4323   $options->{payment_gateway}->gatewaynum
4324     ? $options->{payment_gateway}->options
4325     : @{ $options->{payment_gateway}->get('options') };
4326
4327 }
4328
4329 sub _bop_defaults {
4330   my ($self, $options) = @_;
4331
4332   unless ( $options->{'description'} ) {
4333     if ( $conf->exists('business-onlinepayment-description') ) {
4334       my $dtempl = $conf->config('business-onlinepayment-description');
4335
4336       my $agent = $self->agent->agent;
4337       #$pkgs... not here
4338       $options->{'description'} = eval qq("$dtempl");
4339     } else {
4340       $options->{'description'} = 'Internet services';
4341     }
4342   }
4343
4344   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4345   $options->{invnum} ||= '';
4346   $options->{payname} = $self->payname unless exists( $options->{payname} );
4347 }
4348
4349 sub _bop_content {
4350   my ($self, $options) = @_;
4351   my %content = ();
4352
4353   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4354   $content{customer_ip} = $payip if length($payip);
4355
4356   $content{invoice_number} = $options->{'invnum'}
4357     if exists($options->{'invnum'}) && length($options->{'invnum'});
4358
4359   $content{email_customer} =
4360     (    $conf->exists('business-onlinepayment-email_customer')
4361       || $conf->exists('business-onlinepayment-email-override') );
4362
4363   my ($payname, $payfirst, $paylast);
4364   if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
4365     ($payname = $options->{payname}) =~
4366       /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4367       or return "Illegal payname $payname";
4368     ($payfirst, $paylast) = ($1, $2);
4369   } else {
4370     $payfirst = $self->getfield('first');
4371     $paylast = $self->getfield('last');
4372     $payname = "$payfirst $paylast";
4373   }
4374
4375   $content{last_name} = $paylast;
4376   $content{first_name} = $payfirst;
4377
4378   $content{name} = $payname;
4379
4380   $content{address} = exists($options->{'address1'})
4381                         ? $options->{'address1'}
4382                         : $self->address1;
4383   my $address2 = exists($options->{'address2'})
4384                    ? $options->{'address2'}
4385                    : $self->address2;
4386   $content{address} .= ", ". $address2 if length($address2);
4387
4388   $content{city} = exists($options->{city})
4389                      ? $options->{city}
4390                      : $self->city;
4391   $content{state} = exists($options->{state})
4392                       ? $options->{state}
4393                       : $self->state;
4394   $content{zip} = exists($options->{zip})
4395                     ? $options->{'zip'}
4396                     : $self->zip;
4397   $content{country} = exists($options->{country})
4398                         ? $options->{country}
4399                         : $self->country;
4400
4401   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4402   $content{phone} = $self->daytime || $self->night;
4403
4404   \%content;
4405 }
4406
4407 my %bop_method2payby = (
4408   'CC'     => 'CARD',
4409   'ECHECK' => 'CHEK',
4410   'LEC'    => 'LECB',
4411 );
4412
4413 sub realtime_bop {
4414   my $self = shift;
4415
4416   my %options = ();
4417   if (ref($_[0]) eq 'HASH') {
4418     %options = %{$_[0]};
4419   } else {
4420     my ( $method, $amount ) = ( shift, shift );
4421     %options = @_;
4422     $options{method} = $method;
4423     $options{amount} = $amount;
4424   }
4425
4426   if ( $DEBUG ) {
4427     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4428     warn "  $_ => $options{$_}\n" foreach keys %options;
4429   }
4430
4431   return $self->fake_bop(%options) if $options{'fake'};
4432
4433   $self->_bop_defaults(\%options);
4434
4435   ###
4436   # set trans_is_recur based on invnum if there is one
4437   ###
4438
4439   my $trans_is_recur = 0;
4440   if ( $options{'invnum'} ) {
4441
4442     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4443     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4444
4445     my @part_pkg =
4446       map  { $_->part_pkg }
4447       grep { $_ }
4448       map  { $_->cust_pkg }
4449       $cust_bill->cust_bill_pkg;
4450
4451     $trans_is_recur = 1
4452       if grep { $_->freq ne '0' } @part_pkg;
4453
4454   }
4455
4456   ###
4457   # select a gateway
4458   ###
4459
4460   my $payment_gateway =  $self->_payment_gateway( \%options );
4461   my $namespace = $payment_gateway->gateway_namespace;
4462
4463   eval "use $namespace";
4464   die $@ if $@;
4465
4466   ###
4467   # check for banned credit card/ACH
4468   ###
4469
4470   my $ban = qsearchs('banned_pay', {
4471     'payby'   => $bop_method2payby{$options{method}},
4472     'payinfo' => md5_base64($options{payinfo}),
4473   } );
4474   return "Banned credit card" if $ban;
4475
4476   ###
4477   # massage data
4478   ###
4479
4480   my $bop_content = $self->_bop_content(\%options);
4481   return $bop_content unless ref($bop_content);
4482
4483   my @invoicing_list = $self->invoicing_list_emailonly;
4484   if ( $conf->exists('emailinvoiceautoalways')
4485        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4486        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4487     push @invoicing_list, $self->all_emails;
4488   }
4489
4490   my $email = ($conf->exists('business-onlinepayment-email-override'))
4491               ? $conf->config('business-onlinepayment-email-override')
4492               : $invoicing_list[0];
4493
4494   my $paydate = '';
4495   my %content = ();
4496   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4497
4498     $content{card_number} = $options{payinfo};
4499     $paydate = exists($options{'paydate'})
4500                     ? $options{'paydate'}
4501                     : $self->paydate;
4502     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4503     $content{expiration} = "$2/$1";
4504
4505     my $paycvv = exists($options{'paycvv'})
4506                    ? $options{'paycvv'}
4507                    : $self->paycvv;
4508     $content{cvv2} = $paycvv
4509       if length($paycvv);
4510
4511     my $paystart_month = exists($options{'paystart_month'})
4512                            ? $options{'paystart_month'}
4513                            : $self->paystart_month;
4514
4515     my $paystart_year  = exists($options{'paystart_year'})
4516                            ? $options{'paystart_year'}
4517                            : $self->paystart_year;
4518
4519     $content{card_start} = "$paystart_month/$paystart_year"
4520       if $paystart_month && $paystart_year;
4521
4522     my $payissue       = exists($options{'payissue'})
4523                            ? $options{'payissue'}
4524                            : $self->payissue;
4525     $content{issue_number} = $payissue if $payissue;
4526
4527     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
4528                                         'trans_is_recur' => $trans_is_recur,
4529                                       )
4530        )
4531     {
4532       $content{recurring_billing} = 'YES';
4533       $content{acct_code} = 'rebill'
4534         if $conf->exists('credit_card-recurring_billing_acct_code');
4535     }
4536
4537   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4538     ( $content{account_number}, $content{routing_code} ) =
4539       split('@', $options{payinfo});
4540     $content{bank_name} = $options{payname};
4541     $content{bank_state} = exists($options{'paystate'})
4542                              ? $options{'paystate'}
4543                              : $self->getfield('paystate');
4544     $content{account_type} = exists($options{'paytype'})
4545                                ? uc($options{'paytype'}) || 'CHECKING'
4546                                : uc($self->getfield('paytype')) || 'CHECKING';
4547     $content{account_name} = $self->getfield('first'). ' '.
4548                              $self->getfield('last');
4549
4550     $content{customer_org} = $self->company ? 'B' : 'I';
4551     $content{state_id}       = exists($options{'stateid'})
4552                                  ? $options{'stateid'}
4553                                  : $self->getfield('stateid');
4554     $content{state_id_state} = exists($options{'stateid_state'})
4555                                  ? $options{'stateid_state'}
4556                                  : $self->getfield('stateid_state');
4557     $content{customer_ssn} = exists($options{'ss'})
4558                                ? $options{'ss'}
4559                                : $self->ss;
4560   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4561     $content{phone} = $options{payinfo};
4562   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4563     #move along
4564   } else {
4565     #die an evil death
4566   }
4567
4568   ###
4569   # run transaction(s)
4570   ###
4571
4572   my $balance = exists( $options{'balance'} )
4573                   ? $options{'balance'}
4574                   : $self->balance;
4575
4576   $self->select_for_update; #mutex ... just until we get our pending record in
4577
4578   #the checks here are intended to catch concurrent payments
4579   #double-form-submission prevention is taken care of in cust_pay_pending::check
4580
4581   #check the balance
4582   return "The customer's balance has changed; $options{method} transaction aborted."
4583     if $self->balance < $balance;
4584     #&& $self->balance < $options{amount}; #might as well anyway?
4585
4586   #also check and make sure there aren't *other* pending payments for this cust
4587
4588   my @pending = qsearch('cust_pay_pending', {
4589     'custnum' => $self->custnum,
4590     'status'  => { op=>'!=', value=>'done' }
4591   });
4592   return "A payment is already being processed for this customer (".
4593          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4594          "); $options{method} transaction aborted."
4595     if scalar(@pending);
4596
4597   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4598
4599   my $cust_pay_pending = new FS::cust_pay_pending {
4600     'custnum'           => $self->custnum,
4601     #'invnum'            => $options{'invnum'},
4602     'paid'              => $options{amount},
4603     '_date'             => '',
4604     'payby'             => $bop_method2payby{$options{method}},
4605     'payinfo'           => $options{payinfo},
4606     'paydate'           => $paydate,
4607     'recurring_billing' => $content{recurring_billing},
4608     'pkgnum'            => $options{'pkgnum'},
4609     'status'            => 'new',
4610     'gatewaynum'        => $payment_gateway->gatewaynum || '',
4611     'session_id'        => $options{session_id} || '',
4612     'jobnum'            => $options{depend_jobnum} || '',
4613   };
4614   $cust_pay_pending->payunique( $options{payunique} )
4615     if defined($options{payunique}) && length($options{payunique});
4616   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4617   return $cpp_new_err if $cpp_new_err;
4618
4619   my( $action1, $action2 ) =
4620     split( /\s*\,\s*/, $payment_gateway->gateway_action );
4621
4622   my $transaction = new $namespace( $payment_gateway->gateway_module,
4623                                     $self->_bop_options(\%options),
4624                                   );
4625
4626   $transaction->content(
4627     'type'           => $options{method},
4628     $self->_bop_auth(\%options),
4629     'action'         => $action1,
4630     'description'    => $options{'description'},
4631     'amount'         => $options{amount},
4632     #'invoice_number' => $options{'invnum'},
4633     'customer_id'    => $self->custnum,
4634     %$bop_content,
4635     'reference'      => $cust_pay_pending->paypendingnum, #for now
4636     'email'          => $email,
4637     %content, #after
4638   );
4639
4640   $cust_pay_pending->status('pending');
4641   my $cpp_pending_err = $cust_pay_pending->replace;
4642   return $cpp_pending_err if $cpp_pending_err;
4643
4644   #config?
4645   my $BOP_TESTING = 0;
4646   my $BOP_TESTING_SUCCESS = 1;
4647
4648   unless ( $BOP_TESTING ) {
4649     $transaction->test_transaction(1)
4650       if $conf->exists('business-onlinepayment-test_transaction');
4651     $transaction->submit();
4652   } else {
4653     if ( $BOP_TESTING_SUCCESS ) {
4654       $transaction->is_success(1);
4655       $transaction->authorization('fake auth');
4656     } else {
4657       $transaction->is_success(0);
4658       $transaction->error_message('fake failure');
4659     }
4660   }
4661
4662   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4663
4664     return { reference => $cust_pay_pending->paypendingnum,
4665              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4666
4667   } elsif ( $transaction->is_success() && $action2 ) {
4668
4669     $cust_pay_pending->status('authorized');
4670     my $cpp_authorized_err = $cust_pay_pending->replace;
4671     return $cpp_authorized_err if $cpp_authorized_err;
4672
4673     my $auth = $transaction->authorization;
4674     my $ordernum = $transaction->can('order_number')
4675                    ? $transaction->order_number
4676                    : '';
4677
4678     my $capture =
4679       new Business::OnlinePayment( $payment_gateway->gateway_module,
4680                                    $self->_bop_options(\%options),
4681                                  );
4682
4683     my %capture = (
4684       %content,
4685       type           => $options{method},
4686       action         => $action2,
4687       $self->_bop_auth(\%options),
4688       order_number   => $ordernum,
4689       amount         => $options{amount},
4690       authorization  => $auth,
4691       description    => $options{'description'},
4692     );
4693
4694     foreach my $field (qw( authorization_source_code returned_ACI
4695                            transaction_identifier validation_code
4696                            transaction_sequence_num local_transaction_date
4697                            local_transaction_time AVS_result_code          )) {
4698       $capture{$field} = $transaction->$field() if $transaction->can($field);
4699     }
4700
4701     $capture->content( %capture );
4702
4703     $capture->test_transaction(1)
4704       if $conf->exists('business-onlinepayment-test_transaction');
4705     $capture->submit();
4706
4707     unless ( $capture->is_success ) {
4708       my $e = "Authorization successful but capture failed, custnum #".
4709               $self->custnum. ': '.  $capture->result_code.
4710               ": ". $capture->error_message;
4711       warn $e;
4712       return $e;
4713     }
4714
4715   }
4716
4717   ###
4718   # remove paycvv after initial transaction
4719   ###
4720
4721   #false laziness w/misc/process/payment.cgi - check both to make sure working
4722   # correctly
4723   if ( defined $self->dbdef_table->column('paycvv')
4724        && length($self->paycvv)
4725        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4726   ) {
4727     my $error = $self->remove_cvv;
4728     if ( $error ) {
4729       warn "WARNING: error removing cvv: $error\n";
4730     }
4731   }
4732
4733   ###
4734   # Tokenize
4735   ###
4736
4737
4738   if ( $transaction->can('card_token') && $transaction->card_token ) {
4739
4740     $self->card_token($transaction->card_token);
4741
4742     if ( $options{'payinfo'} eq $self->payinfo ) {
4743       $self->payinfo($transaction->card_token);
4744       my $error = $self->replace;
4745       if ( $error ) {
4746         warn "WARNING: error storing token: $error, but proceeding anyway\n";
4747       }
4748     }
4749
4750   }
4751
4752   ###
4753   # result handling
4754   ###
4755
4756   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4757
4758 }
4759
4760 =item fake_bop
4761
4762 =cut
4763
4764 sub fake_bop {
4765   my $self = shift;
4766
4767   my %options = ();
4768   if (ref($_[0]) eq 'HASH') {
4769     %options = %{$_[0]};
4770   } else {
4771     my ( $method, $amount ) = ( shift, shift );
4772     %options = @_;
4773     $options{method} = $method;
4774     $options{amount} = $amount;
4775   }
4776
4777   if ( $options{'fake_failure'} ) {
4778      return "Error: No error; test failure requested with fake_failure";
4779   }
4780
4781   #my $paybatch = '';
4782   #if ( $payment_gateway->gatewaynum ) { # agent override
4783   #  $paybatch = $payment_gateway->gatewaynum. '-';
4784   #}
4785   #
4786   #$paybatch .= "$processor:". $transaction->authorization;
4787   #
4788   #$paybatch .= ':'. $transaction->order_number
4789   #  if $transaction->can('order_number')
4790   #  && length($transaction->order_number);
4791
4792   my $paybatch = 'FakeProcessor:54:32';
4793
4794   my $cust_pay = new FS::cust_pay ( {
4795      'custnum'  => $self->custnum,
4796      'invnum'   => $options{'invnum'},
4797      'paid'     => $options{amount},
4798      '_date'    => '',
4799      'payby'    => $bop_method2payby{$options{method}},
4800      #'payinfo'  => $payinfo,
4801      'payinfo'  => '4111111111111111',
4802      'paybatch' => $paybatch,
4803      #'paydate'  => $paydate,
4804      'paydate'  => '2012-05-01',
4805   } );
4806   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4807
4808   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4809
4810   if ( $error ) {
4811     $cust_pay->invnum(''); #try again with no specific invnum
4812     my $error2 = $cust_pay->insert( $options{'manual'} ?
4813                                     ( 'manual' => 1 ) : ()
4814                                   );
4815     if ( $error2 ) {
4816       # gah, even with transactions.
4817       my $e = 'WARNING: Card/ACH debited but database not updated - '.
4818               "error inserting (fake!) payment: $error2".
4819               " (previously tried insert with invnum #$options{'invnum'}" .
4820               ": $error )";
4821       warn $e;
4822       return $e;
4823     }
4824   }
4825
4826   if ( $options{'paynum_ref'} ) {
4827     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4828   }
4829
4830   return ''; #no error
4831
4832 }
4833
4834
4835 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
4836 #
4837 # Wraps up processing of a realtime credit card, ACH (electronic check) or
4838 # phone bill transaction.
4839
4840 sub _realtime_bop_result {
4841   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
4842   if ( $DEBUG ) {
4843     warn "$me _realtime_bop_result: pending transaction ".
4844       $cust_pay_pending->paypendingnum. "\n";
4845     warn "  $_ => $options{$_}\n" foreach keys %options;
4846   }
4847
4848   my $payment_gateway = $options{payment_gateway}
4849     or return "no payment gateway in arguments to _realtime_bop_result";
4850
4851   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4852   my $cpp_captured_err = $cust_pay_pending->replace;
4853   return $cpp_captured_err if $cpp_captured_err;
4854
4855   if ( $transaction->is_success() ) {
4856
4857     my $paybatch = '';
4858     if ( $payment_gateway->gatewaynum ) { # agent override
4859       $paybatch = $payment_gateway->gatewaynum. '-';
4860     }
4861
4862     $paybatch .= $payment_gateway->gateway_module. ":".
4863       $transaction->authorization;
4864
4865     $paybatch .= ':'. $transaction->order_number
4866       if $transaction->can('order_number')
4867       && length($transaction->order_number);
4868
4869     my $cust_pay = new FS::cust_pay ( {
4870        'custnum'  => $self->custnum,
4871        'invnum'   => $options{'invnum'},
4872        'paid'     => $cust_pay_pending->paid,
4873        '_date'    => '',
4874        'payby'    => $cust_pay_pending->payby,
4875        'payinfo'  => $options{'payinfo'},
4876        'paybatch' => $paybatch,
4877        'paydate'  => $cust_pay_pending->paydate,
4878        'pkgnum'   => $cust_pay_pending->pkgnum,
4879     } );
4880     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4881     $cust_pay->payunique( $options{payunique} )
4882       if defined($options{payunique}) && length($options{payunique});
4883
4884     my $oldAutoCommit = $FS::UID::AutoCommit;
4885     local $FS::UID::AutoCommit = 0;
4886     my $dbh = dbh;
4887
4888     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4889
4890     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4891
4892     if ( $error ) {
4893       $cust_pay->invnum(''); #try again with no specific invnum
4894       my $error2 = $cust_pay->insert( $options{'manual'} ?
4895                                       ( 'manual' => 1 ) : ()
4896                                     );
4897       if ( $error2 ) {
4898         # gah.  but at least we have a record of the state we had to abort in
4899         # from cust_pay_pending now.
4900         my $e = "WARNING: $options{method} captured but payment not recorded -".
4901                 " error inserting payment (". $payment_gateway->gateway_module.
4902                 "): $error2".
4903                 " (previously tried insert with invnum #$options{'invnum'}" .
4904                 ": $error ) - pending payment saved as paypendingnum ".
4905                 $cust_pay_pending->paypendingnum. "\n";
4906         warn $e;
4907         return $e;
4908       }
4909     }
4910
4911     my $jobnum = $cust_pay_pending->jobnum;
4912     if ( $jobnum ) {
4913        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
4914
4915        unless ( $placeholder ) {
4916          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4917          my $e = "WARNING: $options{method} captured but job $jobnum not ".
4918              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
4919          warn $e;
4920          return $e;
4921        }
4922
4923        $error = $placeholder->delete;
4924
4925        if ( $error ) {
4926          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4927          my $e = "WARNING: $options{method} captured but could not delete ".
4928               "job $jobnum for paypendingnum ".
4929               $cust_pay_pending->paypendingnum. ": $error\n";
4930          warn $e;
4931          return $e;
4932        }
4933
4934     }
4935
4936     if ( $options{'paynum_ref'} ) {
4937       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4938     }
4939
4940     $cust_pay_pending->status('done');
4941     $cust_pay_pending->statustext('captured');
4942     $cust_pay_pending->paynum($cust_pay->paynum);
4943     my $cpp_done_err = $cust_pay_pending->replace;
4944
4945     if ( $cpp_done_err ) {
4946
4947       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4948       my $e = "WARNING: $options{method} captured but payment not recorded - ".
4949               "error updating status for paypendingnum ".
4950               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4951       warn $e;
4952       return $e;
4953
4954     } else {
4955
4956       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4957
4958       if ( $options{'apply'} ) {
4959         my $apply_error = $self->apply_payments_and_credits;
4960         if ( $apply_error ) {
4961           warn "WARNING: error applying payment: $apply_error\n";
4962           #but we still should return no error cause the payment otherwise went
4963           #through...
4964         }
4965       }
4966
4967       return ''; #no error
4968
4969     }
4970
4971   } else {
4972
4973     my $perror = $payment_gateway->gateway_module. " error: ".
4974       $transaction->error_message;
4975
4976     my $jobnum = $cust_pay_pending->jobnum;
4977     if ( $jobnum ) {
4978        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
4979
4980        if ( $placeholder ) {
4981          my $error = $placeholder->depended_delete;
4982          $error ||= $placeholder->delete;
4983          warn "error removing provisioning jobs after declined paypendingnum ".
4984            $cust_pay_pending->paypendingnum. "\n";
4985        } else {
4986          my $e = "error finding job $jobnum for declined paypendingnum ".
4987               $cust_pay_pending->paypendingnum. "\n";
4988          warn $e;
4989        }
4990
4991     }
4992
4993     unless ( $transaction->error_message ) {
4994
4995       my $t_response;
4996       if ( $transaction->can('response_page') ) {
4997         $t_response = {
4998                         'page'    => ( $transaction->can('response_page')
4999                                          ? $transaction->response_page
5000                                          : ''
5001                                      ),
5002                         'code'    => ( $transaction->can('response_code')
5003                                          ? $transaction->response_code
5004                                          : ''
5005                                      ),
5006                         'headers' => ( $transaction->can('response_headers')
5007                                          ? $transaction->response_headers
5008                                          : ''
5009                                      ),
5010                       };
5011       } else {
5012         $t_response .=
5013           "No additional debugging information available for ".
5014             $payment_gateway->gateway_module;
5015       }
5016
5017       $perror .= "No error_message returned from ".
5018                    $payment_gateway->gateway_module. " -- ".
5019                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5020
5021     }
5022
5023     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5024          && $conf->exists('emaildecline')
5025          && grep { $_ ne 'POST' } $self->invoicing_list
5026          && ! grep { $transaction->error_message =~ /$_/ }
5027                    $conf->config('emaildecline-exclude')
5028     ) {
5029       my @templ = $conf->config('declinetemplate');
5030       my $template = new Text::Template (
5031         TYPE   => 'ARRAY',
5032         SOURCE => [ map "$_\n", @templ ],
5033       ) or return "($perror) can't create template: $Text::Template::ERROR";
5034       $template->compile()
5035         or return "($perror) can't compile template: $Text::Template::ERROR";
5036
5037       my $templ_hash = {
5038         'company_name'    =>
5039           scalar( $conf->config('company_name', $self->agentnum ) ),
5040         'company_address' =>
5041           join("\n", $conf->config('company_address', $self->agentnum ) ),
5042         'error'           => $transaction->error_message,
5043       };
5044
5045       my $error = send_email(
5046         'from'    => $conf->config('invoice_from', $self->agentnum ),
5047         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5048         'subject' => 'Your payment could not be processed',
5049         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5050       );
5051
5052       $perror .= " (also received error sending decline notification: $error)"
5053         if $error;
5054
5055     }
5056
5057     $cust_pay_pending->status('done');
5058     $cust_pay_pending->statustext("declined: $perror");
5059     my $cpp_done_err = $cust_pay_pending->replace;
5060     if ( $cpp_done_err ) {
5061       my $e = "WARNING: $options{method} declined but pending payment not ".
5062               "resolved - error updating status for paypendingnum ".
5063               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5064       warn $e;
5065       $perror = "$e ($perror)";
5066     }
5067
5068     return $perror;
5069   }
5070
5071 }
5072
5073 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5074
5075 Verifies successful third party processing of a realtime credit card,
5076 ACH (electronic check) or phone bill transaction via a
5077 Business::OnlineThirdPartyPayment realtime gateway.  See
5078 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5079
5080 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5081
5082 The additional options I<payname>, I<city>, I<state>,
5083 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5084 if set, will override the value from the customer record.
5085
5086 I<description> is a free-text field passed to the gateway.  It defaults to
5087 "Internet services".
5088
5089 If an I<invnum> is specified, this payment (if successful) is applied to the
5090 specified invoice.  If you don't specify an I<invnum> you might want to
5091 call the B<apply_payments> method.
5092
5093 I<quiet> can be set true to surpress email decline notices.
5094
5095 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5096 resulting paynum, if any.
5097
5098 I<payunique> is a unique identifier for this payment.
5099
5100 Returns a hashref containing elements bill_error (which will be undefined
5101 upon success) and session_id of any associated session.
5102
5103 =cut
5104
5105 sub realtime_botpp_capture {
5106   my( $self, $cust_pay_pending, %options ) = @_;
5107   if ( $DEBUG ) {
5108     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5109     warn "  $_ => $options{$_}\n" foreach keys %options;
5110   }
5111
5112   eval "use Business::OnlineThirdPartyPayment";
5113   die $@ if $@;
5114
5115   ###
5116   # select the gateway
5117   ###
5118
5119   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5120
5121   my $payment_gateway = $cust_pay_pending->gatewaynum
5122     ? qsearchs( 'payment_gateway',
5123                 { gatewaynum => $cust_pay_pending->gatewaynum }
5124               )
5125     : $self->agent->payment_gateway( 'method' => $method,
5126                                      # 'invnum'  => $cust_pay_pending->invnum,
5127                                      # 'payinfo' => $cust_pay_pending->payinfo,
5128                                    );
5129
5130   $options{payment_gateway} = $payment_gateway; # for the helper subs
5131
5132   ###
5133   # massage data
5134   ###
5135
5136   my @invoicing_list = $self->invoicing_list_emailonly;
5137   if ( $conf->exists('emailinvoiceautoalways')
5138        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5139        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5140     push @invoicing_list, $self->all_emails;
5141   }
5142
5143   my $email = ($conf->exists('business-onlinepayment-email-override'))
5144               ? $conf->config('business-onlinepayment-email-override')
5145               : $invoicing_list[0];
5146
5147   my %content = ();
5148
5149   $content{email_customer} =
5150     (    $conf->exists('business-onlinepayment-email_customer')
5151       || $conf->exists('business-onlinepayment-email-override') );
5152
5153   ###
5154   # run transaction(s)
5155   ###
5156
5157   my $transaction =
5158     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5159                                            $self->_bop_options(\%options),
5160                                          );
5161
5162   $transaction->reference({ %options });
5163
5164   $transaction->content(
5165     'type'           => $method,
5166     $self->_bop_auth(\%options),
5167     'action'         => 'Post Authorization',
5168     'description'    => $options{'description'},
5169     'amount'         => $cust_pay_pending->paid,
5170     #'invoice_number' => $options{'invnum'},
5171     'customer_id'    => $self->custnum,
5172     'referer'        => 'http://cleanwhisker.420.am/',
5173     'reference'      => $cust_pay_pending->paypendingnum,
5174     'email'          => $email,
5175     'phone'          => $self->daytime || $self->night,
5176     %content, #after
5177     # plus whatever is required for bogus capture avoidance
5178   );
5179
5180   $transaction->submit();
5181
5182   my $error =
5183     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5184
5185   {
5186     bill_error => $error,
5187     session_id => $cust_pay_pending->session_id,
5188   }
5189
5190 }
5191
5192 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5193
5194 =cut
5195
5196 sub default_payment_gateway {
5197   my( $self, $method ) = @_;
5198
5199   die "Real-time processing not enabled\n"
5200     unless $conf->exists('business-onlinepayment');
5201
5202   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5203
5204   #load up config
5205   my $bop_config = 'business-onlinepayment';
5206   $bop_config .= '-ach'
5207     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5208   my ( $processor, $login, $password, $action, @bop_options ) =
5209     $conf->config($bop_config);
5210   $action ||= 'normal authorization';
5211   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5212   die "No real-time processor is enabled - ".
5213       "did you set the business-onlinepayment configuration value?\n"
5214     unless $processor;
5215
5216   ( $processor, $login, $password, $action, @bop_options )
5217 }
5218
5219 =item remove_cvv
5220
5221 Removes the I<paycvv> field from the database directly.
5222
5223 If there is an error, returns the error, otherwise returns false.
5224
5225 =cut
5226
5227 sub remove_cvv {
5228   my $self = shift;
5229   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5230     or return dbh->errstr;
5231   $sth->execute($self->custnum)
5232     or return $sth->errstr;
5233   $self->paycvv('');
5234   '';
5235 }
5236
5237 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5238
5239 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5240 via a Business::OnlinePayment realtime gateway.  See
5241 L<http://420.am/business-onlinepayment> for supported gateways.
5242
5243 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5244
5245 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5246
5247 Most gateways require a reference to an original payment transaction to refund,
5248 so you probably need to specify a I<paynum>.
5249
5250 I<amount> defaults to the original amount of the payment if not specified.
5251
5252 I<reason> specifies a reason for the refund.
5253
5254 I<paydate> specifies the expiration date for a credit card overriding the
5255 value from the customer record or the payment record. Specified as yyyy-mm-dd
5256
5257 Implementation note: If I<amount> is unspecified or equal to the amount of the
5258 orignal payment, first an attempt is made to "void" the transaction via
5259 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5260 the normal attempt is made to "refund" ("credit") the transaction via the
5261 gateway is attempted.
5262
5263 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5264 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5265 #if set, will override the value from the customer record.
5266
5267 #If an I<invnum> is specified, this payment (if successful) is applied to the
5268 #specified invoice.  If you don't specify an I<invnum> you might want to
5269 #call the B<apply_payments> method.
5270
5271 =cut
5272
5273 #some false laziness w/realtime_bop, not enough to make it worth merging
5274 #but some useful small subs should be pulled out
5275 sub realtime_refund_bop {
5276   my $self = shift;
5277
5278   my %options = ();
5279   if (ref($_[0]) eq 'HASH') {
5280     %options = %{$_[0]};
5281   } else {
5282     my $method = shift;
5283     %options = @_;
5284     $options{method} = $method;
5285   }
5286
5287   if ( $DEBUG ) {
5288     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5289     warn "  $_ => $options{$_}\n" foreach keys %options;
5290   }
5291
5292   ###
5293   # look up the original payment and optionally a gateway for that payment
5294   ###
5295
5296   my $cust_pay = '';
5297   my $amount = $options{'amount'};
5298
5299   my( $processor, $login, $password, @bop_options, $namespace ) ;
5300   my( $auth, $order_number ) = ( '', '', '' );
5301
5302   if ( $options{'paynum'} ) {
5303
5304     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5305     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5306       or return "Unknown paynum $options{'paynum'}";
5307     $amount ||= $cust_pay->paid;
5308
5309     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5310       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5311                 $cust_pay->paybatch;
5312     my $gatewaynum = '';
5313     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5314
5315     if ( $gatewaynum ) { #gateway for the payment to be refunded
5316
5317       my $payment_gateway =
5318         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5319       die "payment gateway $gatewaynum not found"
5320         unless $payment_gateway;
5321
5322       $processor   = $payment_gateway->gateway_module;
5323       $login       = $payment_gateway->gateway_username;
5324       $password    = $payment_gateway->gateway_password;
5325       $namespace   = $payment_gateway->gateway_namespace;
5326       @bop_options = $payment_gateway->options;
5327
5328     } else { #try the default gateway
5329
5330       my $conf_processor;
5331       my $payment_gateway =
5332         $self->agent->payment_gateway('method' => $options{method});
5333
5334       ( $conf_processor, $login, $password, $namespace ) =
5335         map { my $method = "gateway_$_"; $payment_gateway->$method }
5336           qw( module username password namespace );
5337
5338       @bop_options = $payment_gateway->gatewaynum
5339                        ? $payment_gateway->options
5340                        : @{ $payment_gateway->get('options') };
5341
5342       return "processor of payment $options{'paynum'} $processor does not".
5343              " match default processor $conf_processor"
5344         unless $processor eq $conf_processor;
5345
5346     }
5347
5348
5349   } else { # didn't specify a paynum, so look for agent gateway overrides
5350            # like a normal transaction
5351
5352     my $payment_gateway =
5353       $self->agent->payment_gateway( 'method'  => $options{method},
5354                                      #'payinfo' => $payinfo,
5355                                    );
5356     my( $processor, $login, $password, $namespace ) =
5357       map { my $method = "gateway_$_"; $payment_gateway->$method }
5358         qw( module username password namespace );
5359
5360     my @bop_options = $payment_gateway->gatewaynum
5361                         ? $payment_gateway->options
5362                         : @{ $payment_gateway->get('options') };
5363
5364   }
5365   return "neither amount nor paynum specified" unless $amount;
5366
5367   eval "use $namespace";
5368   die $@ if $@;
5369
5370   my %content = (
5371     'type'           => $options{method},
5372     'login'          => $login,
5373     'password'       => $password,
5374     'order_number'   => $order_number,
5375     'amount'         => $amount,
5376     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5377   );
5378   $content{authorization} = $auth
5379     if length($auth); #echeck/ACH transactions have an order # but no auth
5380                       #(at least with authorize.net)
5381
5382   my $disable_void_after;
5383   if ($conf->exists('disable_void_after')
5384       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5385     $disable_void_after = $1;
5386   }
5387
5388   #first try void if applicable
5389   if ( $cust_pay && $cust_pay->paid == $amount
5390     && (
5391       ( not defined($disable_void_after) )
5392       || ( time < ($cust_pay->_date + $disable_void_after ) )
5393     )
5394   ) {
5395     warn "  attempting void\n" if $DEBUG > 1;
5396     my $void = new Business::OnlinePayment( $processor, @bop_options );
5397     if ( $void->can('info') ) {
5398       if ( $cust_pay->payby eq 'CARD'
5399            && $void->info('CC_void_requires_card') )
5400       {
5401         $content{'card_number'} = $cust_pay->payinfo;
5402       } elsif ( $cust_pay->payby eq 'CHEK'
5403                 && $void->info('ECHECK_void_requires_account') )
5404       {
5405         ( $content{'account_number'}, $content{'routing_code'} ) =
5406           split('@', $cust_pay->payinfo);
5407         $content{'name'} = $self->get('first'). ' '. $self->get('last');
5408       }
5409     }
5410     $void->content( 'action' => 'void', %content );
5411     $void->test_transaction(1)
5412       if $conf->exists('business-onlinepayment-test_transaction');
5413     $void->submit();
5414     if ( $void->is_success ) {
5415       my $error = $cust_pay->void($options{'reason'});
5416       if ( $error ) {
5417         # gah, even with transactions.
5418         my $e = 'WARNING: Card/ACH voided but database not updated - '.
5419                 "error voiding payment: $error";
5420         warn $e;
5421         return $e;
5422       }
5423       warn "  void successful\n" if $DEBUG > 1;
5424       return '';
5425     }
5426   }
5427
5428   warn "  void unsuccessful, trying refund\n"
5429     if $DEBUG > 1;
5430
5431   #massage data
5432   my $address = $self->address1;
5433   $address .= ", ". $self->address2 if $self->address2;
5434
5435   my($payname, $payfirst, $paylast);
5436   if ( $self->payname && $options{method} ne 'ECHECK' ) {
5437     $payname = $self->payname;
5438     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5439       or return "Illegal payname $payname";
5440     ($payfirst, $paylast) = ($1, $2);
5441   } else {
5442     $payfirst = $self->getfield('first');
5443     $paylast = $self->getfield('last');
5444     $payname =  "$payfirst $paylast";
5445   }
5446
5447   my @invoicing_list = $self->invoicing_list_emailonly;
5448   if ( $conf->exists('emailinvoiceautoalways')
5449        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5450        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5451     push @invoicing_list, $self->all_emails;
5452   }
5453
5454   my $email = ($conf->exists('business-onlinepayment-email-override'))
5455               ? $conf->config('business-onlinepayment-email-override')
5456               : $invoicing_list[0];
5457
5458   my $payip = exists($options{'payip'})
5459                 ? $options{'payip'}
5460                 : $self->payip;
5461   $content{customer_ip} = $payip
5462     if length($payip);
5463
5464   my $payinfo = '';
5465   if ( $options{method} eq 'CC' ) {
5466
5467     if ( $cust_pay ) {
5468       $content{card_number} = $payinfo = $cust_pay->payinfo;
5469       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5470         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5471         ($content{expiration} = "$2/$1");  # where available
5472     } else {
5473       $content{card_number} = $payinfo = $self->payinfo;
5474       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5475         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5476       $content{expiration} = "$2/$1";
5477     }
5478
5479   } elsif ( $options{method} eq 'ECHECK' ) {
5480
5481     if ( $cust_pay ) {
5482       $payinfo = $cust_pay->payinfo;
5483     } else {
5484       $payinfo = $self->payinfo;
5485     }
5486     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5487     $content{bank_name} = $self->payname;
5488     $content{account_type} = 'CHECKING';
5489     $content{account_name} = $payname;
5490     $content{customer_org} = $self->company ? 'B' : 'I';
5491     $content{customer_ssn} = $self->ss;
5492   } elsif ( $options{method} eq 'LEC' ) {
5493     $content{phone} = $payinfo = $self->payinfo;
5494   }
5495
5496   #then try refund
5497   my $refund = new Business::OnlinePayment( $processor, @bop_options );
5498   my %sub_content = $refund->content(
5499     'action'         => 'credit',
5500     'customer_id'    => $self->custnum,
5501     'last_name'      => $paylast,
5502     'first_name'     => $payfirst,
5503     'name'           => $payname,
5504     'address'        => $address,
5505     'city'           => $self->city,
5506     'state'          => $self->state,
5507     'zip'            => $self->zip,
5508     'country'        => $self->country,
5509     'email'          => $email,
5510     'phone'          => $self->daytime || $self->night,
5511     %content, #after
5512   );
5513   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
5514     if $DEBUG > 1;
5515   $refund->test_transaction(1)
5516     if $conf->exists('business-onlinepayment-test_transaction');
5517   $refund->submit();
5518
5519   return "$processor error: ". $refund->error_message
5520     unless $refund->is_success();
5521
5522   my $paybatch = "$processor:". $refund->authorization;
5523   $paybatch .= ':'. $refund->order_number
5524     if $refund->can('order_number') && $refund->order_number;
5525
5526   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5527     my @cust_bill_pay = $cust_pay->cust_bill_pay;
5528     last unless @cust_bill_pay;
5529     my $cust_bill_pay = pop @cust_bill_pay;
5530     my $error = $cust_bill_pay->delete;
5531     last if $error;
5532   }
5533
5534   my $cust_refund = new FS::cust_refund ( {
5535     'custnum'  => $self->custnum,
5536     'paynum'   => $options{'paynum'},
5537     'refund'   => $amount,
5538     '_date'    => '',
5539     'payby'    => $bop_method2payby{$options{method}},
5540     'payinfo'  => $payinfo,
5541     'paybatch' => $paybatch,
5542     'reason'   => $options{'reason'} || 'card or ACH refund',
5543   } );
5544   my $error = $cust_refund->insert;
5545   if ( $error ) {
5546     $cust_refund->paynum(''); #try again with no specific paynum
5547     my $error2 = $cust_refund->insert;
5548     if ( $error2 ) {
5549       # gah, even with transactions.
5550       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5551               "error inserting refund ($processor): $error2".
5552               " (previously tried insert with paynum #$options{'paynum'}" .
5553               ": $error )";
5554       warn $e;
5555       return $e;
5556     }
5557   }
5558
5559   ''; #no error
5560
5561 }
5562
5563 =item batch_card OPTION => VALUE...
5564
5565 Adds a payment for this invoice to the pending credit card batch (see
5566 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5567 runs the payment using a realtime gateway.
5568
5569 =cut
5570
5571 sub batch_card {
5572   my ($self, %options) = @_;
5573
5574   my $amount;
5575   if (exists($options{amount})) {
5576     $amount = $options{amount};
5577   }else{
5578     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5579   }
5580   return '' unless $amount > 0;
5581
5582   my $invnum = delete $options{invnum};
5583   my $payby = $options{invnum} || $self->payby;  #dubious
5584
5585   if ($options{'realtime'}) {
5586     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5587                                 $amount,
5588                                 %options,
5589                               );
5590   }
5591
5592   my $oldAutoCommit = $FS::UID::AutoCommit;
5593   local $FS::UID::AutoCommit = 0;
5594   my $dbh = dbh;
5595
5596   #this needs to handle mysql as well as Pg, like svc_acct.pm
5597   #(make it into a common function if folks need to do batching with mysql)
5598   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5599     or return "Cannot lock pay_batch: " . $dbh->errstr;
5600
5601   my %pay_batch = (
5602     'status' => 'O',
5603     'payby'  => FS::payby->payby2payment($payby),
5604   );
5605
5606   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5607
5608   unless ( $pay_batch ) {
5609     $pay_batch = new FS::pay_batch \%pay_batch;
5610     my $error = $pay_batch->insert;
5611     if ( $error ) {
5612       $dbh->rollback if $oldAutoCommit;
5613       die "error creating new batch: $error\n";
5614     }
5615   }
5616
5617   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5618       'batchnum' => $pay_batch->batchnum,
5619       'custnum'  => $self->custnum,
5620   } );
5621
5622   foreach (qw( address1 address2 city state zip country payby payinfo paydate
5623                payname )) {
5624     $options{$_} = '' unless exists($options{$_});
5625   }
5626
5627   my $cust_pay_batch = new FS::cust_pay_batch ( {
5628     'batchnum' => $pay_batch->batchnum,
5629     'invnum'   => $invnum || 0,                    # is there a better value?
5630                                                    # this field should be
5631                                                    # removed...
5632                                                    # cust_bill_pay_batch now
5633     'custnum'  => $self->custnum,
5634     'last'     => $self->getfield('last'),
5635     'first'    => $self->getfield('first'),
5636     'address1' => $options{address1} || $self->address1,
5637     'address2' => $options{address2} || $self->address2,
5638     'city'     => $options{city}     || $self->city,
5639     'state'    => $options{state}    || $self->state,
5640     'zip'      => $options{zip}      || $self->zip,
5641     'country'  => $options{country}  || $self->country,
5642     'payby'    => $options{payby}    || $self->payby,
5643     'payinfo'  => $options{payinfo}  || $self->payinfo,
5644     'exp'      => $options{paydate}  || $self->paydate,
5645     'payname'  => $options{payname}  || $self->payname,
5646     'amount'   => $amount,                         # consolidating
5647   } );
5648
5649   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5650     if $old_cust_pay_batch;
5651
5652   my $error;
5653   if ($old_cust_pay_batch) {
5654     $error = $cust_pay_batch->replace($old_cust_pay_batch)
5655   } else {
5656     $error = $cust_pay_batch->insert;
5657   }
5658
5659   if ( $error ) {
5660     $dbh->rollback if $oldAutoCommit;
5661     die $error;
5662   }
5663
5664   my $unapplied =   $self->total_unapplied_credits
5665                   + $self->total_unapplied_payments
5666                   + $self->in_transit_payments;
5667   foreach my $cust_bill ($self->open_cust_bill) {
5668     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5669     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5670       'invnum' => $cust_bill->invnum,
5671       'paybatchnum' => $cust_pay_batch->paybatchnum,
5672       'amount' => $cust_bill->owed,
5673       '_date' => time,
5674     };
5675     if ($unapplied >= $cust_bill_pay_batch->amount){
5676       $unapplied -= $cust_bill_pay_batch->amount;
5677       next;
5678     }else{
5679       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5680                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
5681     }
5682     $error = $cust_bill_pay_batch->insert;
5683     if ( $error ) {
5684       $dbh->rollback if $oldAutoCommit;
5685       die $error;
5686     }
5687   }
5688
5689   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5690   '';
5691 }
5692
5693 =item apply_payments_and_credits [ OPTION => VALUE ... ]
5694
5695 Applies unapplied payments and credits.
5696
5697 In most cases, this new method should be used in place of sequential
5698 apply_payments and apply_credits methods.
5699
5700 A hash of optional arguments may be passed.  Currently "manual" is supported.
5701 If true, a payment receipt is sent instead of a statement when
5702 'payment_receipt_email' configuration option is set.
5703
5704 If there is an error, returns the error, otherwise returns false.
5705
5706 =cut
5707
5708 sub apply_payments_and_credits {
5709   my( $self, %options ) = @_;
5710
5711   local $SIG{HUP} = 'IGNORE';
5712   local $SIG{INT} = 'IGNORE';
5713   local $SIG{QUIT} = 'IGNORE';
5714   local $SIG{TERM} = 'IGNORE';
5715   local $SIG{TSTP} = 'IGNORE';
5716   local $SIG{PIPE} = 'IGNORE';
5717
5718   my $oldAutoCommit = $FS::UID::AutoCommit;
5719   local $FS::UID::AutoCommit = 0;
5720   my $dbh = dbh;
5721
5722   $self->select_for_update; #mutex
5723
5724   foreach my $cust_bill ( $self->open_cust_bill ) {
5725     my $error = $cust_bill->apply_payments_and_credits(%options);
5726     if ( $error ) {
5727       $dbh->rollback if $oldAutoCommit;
5728       return "Error applying: $error";
5729     }
5730   }
5731
5732   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5733   ''; #no error
5734
5735 }
5736
5737 =item apply_credits OPTION => VALUE ...
5738
5739 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5740 to outstanding invoice balances in chronological order (or reverse
5741 chronological order if the I<order> option is set to B<newest>) and returns the
5742 value of any remaining unapplied credits available for refund (see
5743 L<FS::cust_refund>).
5744
5745 Dies if there is an error.
5746
5747 =cut
5748
5749 sub apply_credits {
5750   my $self = shift;
5751   my %opt = @_;
5752
5753   local $SIG{HUP} = 'IGNORE';
5754   local $SIG{INT} = 'IGNORE';
5755   local $SIG{QUIT} = 'IGNORE';
5756   local $SIG{TERM} = 'IGNORE';
5757   local $SIG{TSTP} = 'IGNORE';
5758   local $SIG{PIPE} = 'IGNORE';
5759
5760   my $oldAutoCommit = $FS::UID::AutoCommit;
5761   local $FS::UID::AutoCommit = 0;
5762   my $dbh = dbh;
5763
5764   $self->select_for_update; #mutex
5765
5766   unless ( $self->total_unapplied_credits ) {
5767     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5768     return 0;
5769   }
5770
5771   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5772       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5773
5774   my @invoices = $self->open_cust_bill;
5775   @invoices = sort { $b->_date <=> $a->_date } @invoices
5776     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5777
5778   if ( $conf->exists('pkg-balances') ) {
5779     # limit @credits to those w/ a pkgnum grepped from $self
5780     my %pkgnums = ();
5781     foreach my $i (@invoices) {
5782       foreach my $li ( $i->cust_bill_pkg ) {
5783         $pkgnums{$li->pkgnum} = 1;
5784       }
5785     }
5786     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
5787   }
5788
5789   my $credit;
5790
5791   foreach my $cust_bill ( @invoices ) {
5792
5793     if ( !defined($credit) || $credit->credited == 0) {
5794       $credit = pop @credits or last;
5795     }
5796
5797     my $owed;
5798     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
5799       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
5800     } else {
5801       $owed = $cust_bill->owed;
5802     }
5803     unless ( $owed > 0 ) {
5804       push @credits, $credit;
5805       next;
5806     }
5807
5808     my $amount = min( $credit->credited, $owed );
5809
5810     my $cust_credit_bill = new FS::cust_credit_bill ( {
5811       'crednum' => $credit->crednum,
5812       'invnum'  => $cust_bill->invnum,
5813       'amount'  => $amount,
5814     } );
5815     $cust_credit_bill->pkgnum( $credit->pkgnum )
5816       if $conf->exists('pkg-balances') && $credit->pkgnum;
5817     my $error = $cust_credit_bill->insert;
5818     if ( $error ) {
5819       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5820       die $error;
5821     }
5822
5823     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
5824
5825   }
5826
5827   my $total_unapplied_credits = $self->total_unapplied_credits;
5828
5829   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5830
5831   return $total_unapplied_credits;
5832 }
5833
5834 =item apply_payments  [ OPTION => VALUE ... ]
5835
5836 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5837 to outstanding invoice balances in chronological order.
5838
5839  #and returns the value of any remaining unapplied payments.
5840
5841 A hash of optional arguments may be passed.  Currently "manual" is supported.
5842 If true, a payment receipt is sent instead of a statement when
5843 'payment_receipt_email' configuration option is set.
5844
5845 Dies if there is an error.
5846
5847 =cut
5848
5849 sub apply_payments {
5850   my( $self, %options ) = @_;
5851
5852   local $SIG{HUP} = 'IGNORE';
5853   local $SIG{INT} = 'IGNORE';
5854   local $SIG{QUIT} = 'IGNORE';
5855   local $SIG{TERM} = 'IGNORE';
5856   local $SIG{TSTP} = 'IGNORE';
5857   local $SIG{PIPE} = 'IGNORE';
5858
5859   my $oldAutoCommit = $FS::UID::AutoCommit;
5860   local $FS::UID::AutoCommit = 0;
5861   my $dbh = dbh;
5862
5863   $self->select_for_update; #mutex
5864
5865   #return 0 unless
5866
5867   my @payments = sort { $b->_date <=> $a->_date }
5868                  grep { $_->unapplied > 0 }
5869                  $self->cust_pay;
5870
5871   my @invoices = sort { $a->_date <=> $b->_date}
5872                  grep { $_->owed > 0 }
5873                  $self->cust_bill;
5874
5875   if ( $conf->exists('pkg-balances') ) {
5876     # limit @payments to those w/ a pkgnum grepped from $self
5877     my %pkgnums = ();
5878     foreach my $i (@invoices) {
5879       foreach my $li ( $i->cust_bill_pkg ) {
5880         $pkgnums{$li->pkgnum} = 1;
5881       }
5882     }
5883     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
5884   }
5885
5886   my $payment;
5887
5888   foreach my $cust_bill ( @invoices ) {
5889
5890     if ( !defined($payment) || $payment->unapplied == 0 ) {
5891       $payment = pop @payments or last;
5892     }
5893
5894     my $owed;
5895     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
5896       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
5897     } else {
5898       $owed = $cust_bill->owed;
5899     }
5900     unless ( $owed > 0 ) {
5901       push @payments, $payment;
5902       next;
5903     }
5904
5905     my $amount = min( $payment->unapplied, $owed );
5906
5907     my $cust_bill_pay = new FS::cust_bill_pay ( {
5908       'paynum' => $payment->paynum,
5909       'invnum' => $cust_bill->invnum,
5910       'amount' => $amount,
5911     } );
5912     $cust_bill_pay->pkgnum( $payment->pkgnum )
5913       if $conf->exists('pkg-balances') && $payment->pkgnum;
5914     my $error = $cust_bill_pay->insert(%options);
5915     if ( $error ) {
5916       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5917       die $error;
5918     }
5919
5920     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
5921
5922   }
5923
5924   my $total_unapplied_payments = $self->total_unapplied_payments;
5925
5926   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5927
5928   return $total_unapplied_payments;
5929 }
5930
5931 =item total_owed
5932
5933 Returns the total owed for this customer on all invoices
5934 (see L<FS::cust_bill/owed>).
5935
5936 =cut
5937
5938 sub total_owed {
5939   my $self = shift;
5940   $self->total_owed_date(2145859200); #12/31/2037
5941 }
5942
5943 =item total_owed_date TIME
5944
5945 Returns the total owed for this customer on all invoices with date earlier than
5946 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
5947 see L<Time::Local> and L<Date::Parse> for conversion functions.
5948
5949 =cut
5950
5951 sub total_owed_date {
5952   my $self = shift;
5953   my $time = shift;
5954
5955   my $custnum = $self->custnum;
5956
5957   my $owed_sql = FS::cust_bill->owed_sql;
5958
5959   my $sql = "
5960     SELECT SUM($owed_sql) FROM cust_bill
5961       WHERE custnum = $custnum
5962         AND _date <= $time
5963   ";
5964
5965   sprintf( "%.2f", $self->scalar_sql($sql) );
5966
5967 }
5968
5969 =item total_owed_pkgnum PKGNUM
5970
5971 Returns the total owed on all invoices for this customer's specific package
5972 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
5973
5974 =cut
5975
5976 sub total_owed_pkgnum {
5977   my( $self, $pkgnum ) = @_;
5978   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
5979 }
5980
5981 =item total_owed_date_pkgnum TIME PKGNUM
5982
5983 Returns the total owed for this customer's specific package when using
5984 experimental package balances on all invoices with date earlier than
5985 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
5986 see L<Time::Local> and L<Date::Parse> for conversion functions.
5987
5988 =cut
5989
5990 sub total_owed_date_pkgnum {
5991   my( $self, $time, $pkgnum ) = @_;
5992
5993   my $total_bill = 0;
5994   foreach my $cust_bill (
5995     grep { $_->_date <= $time }
5996       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5997   ) {
5998     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
5999   }
6000   sprintf( "%.2f", $total_bill );
6001
6002 }
6003
6004 =item total_paid
6005
6006 Returns the total amount of all payments.
6007
6008 =cut
6009
6010 sub total_paid {
6011   my $self = shift;
6012   my $total = 0;
6013   $total += $_->paid foreach $self->cust_pay;
6014   sprintf( "%.2f", $total );
6015 }
6016
6017 =item total_unapplied_credits
6018
6019 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6020 customer.  See L<FS::cust_credit/credited>.
6021
6022 =item total_credited
6023
6024 Old name for total_unapplied_credits.  Don't use.
6025
6026 =cut
6027
6028 sub total_credited {
6029   #carp "total_credited deprecated, use total_unapplied_credits";
6030   shift->total_unapplied_credits(@_);
6031 }
6032
6033 sub total_unapplied_credits {
6034   my $self = shift;
6035
6036   my $custnum = $self->custnum;
6037
6038   my $unapplied_sql = FS::cust_credit->unapplied_sql;
6039
6040   my $sql = "
6041     SELECT SUM($unapplied_sql) FROM cust_credit
6042       WHERE custnum = $custnum
6043   ";
6044
6045   sprintf( "%.2f", $self->scalar_sql($sql) );
6046
6047 }
6048
6049 =item total_unapplied_credits_pkgnum PKGNUM
6050
6051 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6052 customer.  See L<FS::cust_credit/credited>.
6053
6054 =cut
6055
6056 sub total_unapplied_credits_pkgnum {
6057   my( $self, $pkgnum ) = @_;
6058   my $total_credit = 0;
6059   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6060   sprintf( "%.2f", $total_credit );
6061 }
6062
6063
6064 =item total_unapplied_payments
6065
6066 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6067 See L<FS::cust_pay/unapplied>.
6068
6069 =cut
6070
6071 sub total_unapplied_payments {
6072   my $self = shift;
6073
6074   my $custnum = $self->custnum;
6075
6076   my $unapplied_sql = FS::cust_pay->unapplied_sql;
6077
6078   my $sql = "
6079     SELECT SUM($unapplied_sql) FROM cust_pay
6080       WHERE custnum = $custnum
6081   ";
6082
6083   sprintf( "%.2f", $self->scalar_sql($sql) );
6084
6085 }
6086
6087 =item total_unapplied_payments_pkgnum PKGNUM
6088
6089 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6090 specific package when using experimental package balances.  See
6091 L<FS::cust_pay/unapplied>.
6092
6093 =cut
6094
6095 sub total_unapplied_payments_pkgnum {
6096   my( $self, $pkgnum ) = @_;
6097   my $total_unapplied = 0;
6098   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6099   sprintf( "%.2f", $total_unapplied );
6100 }
6101
6102
6103 =item total_unapplied_refunds
6104
6105 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6106 customer.  See L<FS::cust_refund/unapplied>.
6107
6108 =cut
6109
6110 sub total_unapplied_refunds {
6111   my $self = shift;
6112   my $custnum = $self->custnum;
6113
6114   my $unapplied_sql = FS::cust_refund->unapplied_sql;
6115
6116   my $sql = "
6117     SELECT SUM($unapplied_sql) FROM cust_refund
6118       WHERE custnum = $custnum
6119   ";
6120
6121   sprintf( "%.2f", $self->scalar_sql($sql) );
6122
6123 }
6124
6125 =item balance
6126
6127 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6128 total_unapplied_credits minus total_unapplied_payments).
6129
6130 =cut
6131
6132 sub balance {
6133   my $self = shift;
6134   $self->balance_date_range;
6135 }
6136
6137 =item balance_date TIME
6138
6139 Returns the balance for this customer, only considering invoices with date
6140 earlier than TIME (total_owed_date minus total_credited minus
6141 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6142 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6143 functions.
6144
6145 =cut
6146
6147 sub balance_date {
6148   my $self = shift;
6149   $self->balance_date_range(shift);
6150 }
6151
6152 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
6153
6154 Returns the balance for this customer, optionally considering invoices with
6155 date earlier than START_TIME, and not later than END_TIME
6156 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6157
6158 Times are specified as SQL fragments or numeric
6159 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
6160 L<Date::Parse> for conversion functions.  The empty string can be passed
6161 to disable that time constraint completely.
6162
6163 Available options are:
6164
6165 =over 4
6166
6167 =item unapplied_date
6168
6169 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
6170
6171 =back
6172
6173 =cut
6174
6175 sub balance_date_range {
6176   my $self = shift;
6177   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6178             ') FROM cust_main WHERE custnum='. $self->custnum;
6179   sprintf( "%.2f", $self->scalar_sql($sql) );
6180 }
6181
6182 =item balance_pkgnum PKGNUM
6183
6184 Returns the balance for this customer's specific package when using
6185 experimental package balances (total_owed plus total_unrefunded, minus
6186 total_unapplied_credits minus total_unapplied_payments)
6187
6188 =cut
6189
6190 sub balance_pkgnum {
6191   my( $self, $pkgnum ) = @_;
6192
6193   sprintf( "%.2f",
6194       $self->total_owed_pkgnum($pkgnum)
6195 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6196 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6197     - $self->total_unapplied_credits_pkgnum($pkgnum)
6198     - $self->total_unapplied_payments_pkgnum($pkgnum)
6199   );
6200 }
6201
6202 =item in_transit_payments
6203
6204 Returns the total of requests for payments for this customer pending in
6205 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6206
6207 =cut
6208
6209 sub in_transit_payments {
6210   my $self = shift;
6211   my $in_transit_payments = 0;
6212   foreach my $pay_batch ( qsearch('pay_batch', {
6213     'status' => 'I',
6214   } ) ) {
6215     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6216       'batchnum' => $pay_batch->batchnum,
6217       'custnum' => $self->custnum,
6218     } ) ) {
6219       $in_transit_payments += $cust_pay_batch->amount;
6220     }
6221   }
6222   sprintf( "%.2f", $in_transit_payments );
6223 }
6224
6225 =item payment_info
6226
6227 Returns a hash of useful information for making a payment.
6228
6229 =over 4
6230
6231 =item balance
6232
6233 Current balance.
6234
6235 =item payby
6236
6237 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6238 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6239 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6240
6241 =back
6242
6243 For credit card transactions:
6244
6245 =over 4
6246
6247 =item card_type 1
6248
6249 =item payname
6250
6251 Exact name on card
6252
6253 =back
6254
6255 For electronic check transactions:
6256
6257 =over 4
6258
6259 =item stateid_state
6260
6261 =back
6262
6263 =cut
6264
6265 sub payment_info {
6266   my $self = shift;
6267
6268   my %return = ();
6269
6270   $return{balance} = $self->balance;
6271
6272   $return{payname} = $self->payname
6273                      || ( $self->first. ' '. $self->get('last') );
6274
6275   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6276
6277   $return{payby} = $self->payby;
6278   $return{stateid_state} = $self->stateid_state;
6279
6280   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6281     $return{card_type} = cardtype($self->payinfo);
6282     $return{payinfo} = $self->paymask;
6283
6284     @return{'month', 'year'} = $self->paydate_monthyear;
6285
6286   }
6287
6288   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6289     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6290     $return{payinfo1} = $payinfo1;
6291     $return{payinfo2} = $payinfo2;
6292     $return{paytype}  = $self->paytype;
6293     $return{paystate} = $self->paystate;
6294
6295   }
6296
6297   #doubleclick protection
6298   my $_date = time;
6299   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6300
6301   %return;
6302
6303 }
6304
6305 =item paydate_monthyear
6306
6307 Returns a two-element list consisting of the month and year of this customer's
6308 paydate (credit card expiration date for CARD customers)
6309
6310 =cut
6311
6312 sub paydate_monthyear {
6313   my $self = shift;
6314   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6315     ( $2, $1 );
6316   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6317     ( $1, $3 );
6318   } else {
6319     ('', '');
6320   }
6321 }
6322
6323 =item tax_exemption TAXNAME
6324
6325 =cut
6326
6327 sub tax_exemption {
6328   my( $self, $taxname ) = @_;
6329
6330   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6331                                      'taxname' => $taxname,
6332                                    },
6333           );
6334 }
6335
6336 =item cust_main_exemption
6337
6338 =cut
6339
6340 sub cust_main_exemption {
6341   my $self = shift;
6342   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6343 }
6344
6345 =item invoicing_list [ ARRAYREF ]
6346
6347 If an arguement is given, sets these email addresses as invoice recipients
6348 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6349 (except as warnings), so use check_invoicing_list first.
6350
6351 Returns a list of email addresses (with svcnum entries expanded).
6352
6353 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6354 check it without disturbing anything by passing nothing.
6355
6356 This interface may change in the future.
6357
6358 =cut
6359
6360 sub invoicing_list {
6361   my( $self, $arrayref ) = @_;
6362
6363   if ( $arrayref ) {
6364     my @cust_main_invoice;
6365     if ( $self->custnum ) {
6366       @cust_main_invoice =
6367         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6368     } else {
6369       @cust_main_invoice = ();
6370     }
6371     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6372       #warn $cust_main_invoice->destnum;
6373       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6374         #warn $cust_main_invoice->destnum;
6375         my $error = $cust_main_invoice->delete;
6376         warn $error if $error;
6377       }
6378     }
6379     if ( $self->custnum ) {
6380       @cust_main_invoice =
6381         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6382     } else {
6383       @cust_main_invoice = ();
6384     }
6385     my %seen = map { $_->address => 1 } @cust_main_invoice;
6386     foreach my $address ( @{$arrayref} ) {
6387       next if exists $seen{$address} && $seen{$address};
6388       $seen{$address} = 1;
6389       my $cust_main_invoice = new FS::cust_main_invoice ( {
6390         'custnum' => $self->custnum,
6391         'dest'    => $address,
6392       } );
6393       my $error = $cust_main_invoice->insert;
6394       warn $error if $error;
6395     }
6396   }
6397
6398   if ( $self->custnum ) {
6399     map { $_->address }
6400       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6401   } else {
6402     ();
6403   }
6404
6405 }
6406
6407 =item check_invoicing_list ARRAYREF
6408
6409 Checks these arguements as valid input for the invoicing_list method.  If there
6410 is an error, returns the error, otherwise returns false.
6411
6412 =cut
6413
6414 sub check_invoicing_list {
6415   my( $self, $arrayref ) = @_;
6416
6417   foreach my $address ( @$arrayref ) {
6418
6419     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6420       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6421     }
6422
6423     my $cust_main_invoice = new FS::cust_main_invoice ( {
6424       'custnum' => $self->custnum,
6425       'dest'    => $address,
6426     } );
6427     my $error = $self->custnum
6428                 ? $cust_main_invoice->check
6429                 : $cust_main_invoice->checkdest
6430     ;
6431     return $error if $error;
6432
6433   }
6434
6435   return "Email address required"
6436     if $conf->exists('cust_main-require_invoicing_list_email')
6437     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6438
6439   '';
6440 }
6441
6442 =item set_default_invoicing_list
6443
6444 Sets the invoicing list to all accounts associated with this customer,
6445 overwriting any previous invoicing list.
6446
6447 =cut
6448
6449 sub set_default_invoicing_list {
6450   my $self = shift;
6451   $self->invoicing_list($self->all_emails);
6452 }
6453
6454 =item all_emails
6455
6456 Returns the email addresses of all accounts provisioned for this customer.
6457
6458 =cut
6459
6460 sub all_emails {
6461   my $self = shift;
6462   my %list;
6463   foreach my $cust_pkg ( $self->all_pkgs ) {
6464     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6465     my @svc_acct =
6466       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6467         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6468           @cust_svc;
6469     $list{$_}=1 foreach map { $_->email } @svc_acct;
6470   }
6471   keys %list;
6472 }
6473
6474 =item invoicing_list_addpost
6475
6476 Adds postal invoicing to this customer.  If this customer is already configured
6477 to receive postal invoices, does nothing.
6478
6479 =cut
6480
6481 sub invoicing_list_addpost {
6482   my $self = shift;
6483   return if grep { $_ eq 'POST' } $self->invoicing_list;
6484   my @invoicing_list = $self->invoicing_list;
6485   push @invoicing_list, 'POST';
6486   $self->invoicing_list(\@invoicing_list);
6487 }
6488
6489 =item invoicing_list_emailonly
6490
6491 Returns the list of email invoice recipients (invoicing_list without non-email
6492 destinations such as POST and FAX).
6493
6494 =cut
6495
6496 sub invoicing_list_emailonly {
6497   my $self = shift;
6498   warn "$me invoicing_list_emailonly called"
6499     if $DEBUG;
6500   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6501 }
6502
6503 =item invoicing_list_emailonly_scalar
6504
6505 Returns the list of email invoice recipients (invoicing_list without non-email
6506 destinations such as POST and FAX) as a comma-separated scalar.
6507
6508 =cut
6509
6510 sub invoicing_list_emailonly_scalar {
6511   my $self = shift;
6512   warn "$me invoicing_list_emailonly_scalar called"
6513     if $DEBUG;
6514   join(', ', $self->invoicing_list_emailonly);
6515 }
6516
6517 =item referral_custnum_cust_main
6518
6519 Returns the customer who referred this customer (or the empty string, if
6520 this customer was not referred).
6521
6522 Note the difference with referral_cust_main method: This method,
6523 referral_custnum_cust_main returns the single customer (if any) who referred
6524 this customer, while referral_cust_main returns an array of customers referred
6525 BY this customer.
6526
6527 =cut
6528
6529 sub referral_custnum_cust_main {
6530   my $self = shift;
6531   return '' unless $self->referral_custnum;
6532   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6533 }
6534
6535 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6536
6537 Returns an array of customers referred by this customer (referral_custnum set
6538 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6539 customers referred by customers referred by this customer and so on, inclusive.
6540 The default behavior is DEPTH 1 (no recursion).
6541
6542 Note the difference with referral_custnum_cust_main method: This method,
6543 referral_cust_main, returns an array of customers referred BY this customer,
6544 while referral_custnum_cust_main returns the single customer (if any) who
6545 referred this customer.
6546
6547 =cut
6548
6549 sub referral_cust_main {
6550   my $self = shift;
6551   my $depth = @_ ? shift : 1;
6552   my $exclude = @_ ? shift : {};
6553
6554   my @cust_main =
6555     map { $exclude->{$_->custnum}++; $_; }
6556       grep { ! $exclude->{ $_->custnum } }
6557         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6558
6559   if ( $depth > 1 ) {
6560     push @cust_main,
6561       map { $_->referral_cust_main($depth-1, $exclude) }
6562         @cust_main;
6563   }
6564
6565   @cust_main;
6566 }
6567
6568 =item referral_cust_main_ncancelled
6569
6570 Same as referral_cust_main, except only returns customers with uncancelled
6571 packages.
6572
6573 =cut
6574
6575 sub referral_cust_main_ncancelled {
6576   my $self = shift;
6577   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6578 }
6579
6580 =item referral_cust_pkg [ DEPTH ]
6581
6582 Like referral_cust_main, except returns a flat list of all unsuspended (and
6583 uncancelled) packages for each customer.  The number of items in this list may
6584 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6585
6586 =cut
6587
6588 sub referral_cust_pkg {
6589   my $self = shift;
6590   my $depth = @_ ? shift : 1;
6591
6592   map { $_->unsuspended_pkgs }
6593     grep { $_->unsuspended_pkgs }
6594       $self->referral_cust_main($depth);
6595 }
6596
6597 =item referring_cust_main
6598
6599 Returns the single cust_main record for the customer who referred this customer
6600 (referral_custnum), or false.
6601
6602 =cut
6603
6604 sub referring_cust_main {
6605   my $self = shift;
6606   return '' unless $self->referral_custnum;
6607   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6608 }
6609
6610 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6611
6612 Applies a credit to this customer.  If there is an error, returns the error,
6613 otherwise returns false.
6614
6615 REASON can be a text string, an FS::reason object, or a scalar reference to
6616 a reasonnum.  If a text string, it will be automatically inserted as a new
6617 reason, and a 'reason_type' option must be passed to indicate the
6618 FS::reason_type for the new reason.
6619
6620 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6621
6622 Any other options are passed to FS::cust_credit::insert.
6623
6624 =cut
6625
6626 sub credit {
6627   my( $self, $amount, $reason, %options ) = @_;
6628
6629   my $cust_credit = new FS::cust_credit {
6630     'custnum' => $self->custnum,
6631     'amount'  => $amount,
6632   };
6633
6634   if ( ref($reason) ) {
6635
6636     if ( ref($reason) eq 'SCALAR' ) {
6637       $cust_credit->reasonnum( $$reason );
6638     } else {
6639       $cust_credit->reasonnum( $reason->reasonnum );
6640     }
6641
6642   } else {
6643     $cust_credit->set('reason', $reason)
6644   }
6645
6646   for (qw( addlinfo eventnum )) {
6647     $cust_credit->$_( delete $options{$_} )
6648       if exists($options{$_});
6649   }
6650
6651   $cust_credit->insert(%options);
6652
6653 }
6654
6655 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6656
6657 Creates a one-time charge for this customer.  If there is an error, returns
6658 the error, otherwise returns false.
6659
6660 New-style, with a hashref of options:
6661
6662   my $error = $cust_main->charge(
6663                                   {
6664                                     'amount'     => 54.32,
6665                                     'quantity'   => 1,
6666                                     'start_date' => str2time('7/4/2009'),
6667                                     'pkg'        => 'Description',
6668                                     'comment'    => 'Comment',
6669                                     'additional' => [], #extra invoice detail
6670                                     'classnum'   => 1,  #pkg_class
6671
6672                                     'setuptax'   => '', # or 'Y' for tax exempt
6673
6674                                     #internal taxation
6675                                     'taxclass'   => 'Tax class',
6676
6677                                     #vendor taxation
6678                                     'taxproduct' => 2,  #part_pkg_taxproduct
6679                                     'override'   => {}, #XXX describe
6680
6681                                     #will be filled in with the new object
6682                                     'cust_pkg_ref' => \$cust_pkg,
6683
6684                                     #generate an invoice immediately
6685                                     'bill_now' => 0,
6686                                     'invoice_terms' => '', #with these terms
6687                                   }
6688                                 );
6689
6690 Old-style:
6691
6692   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6693
6694 =cut
6695
6696 sub charge {
6697   my $self = shift;
6698   my ( $amount, $quantity, $start_date, $classnum );
6699   my ( $pkg, $comment, $additional );
6700   my ( $setuptax, $taxclass );   #internal taxes
6701   my ( $taxproduct, $override ); #vendor (CCH) taxes
6702   my $no_auto = '';
6703   my $cust_pkg_ref = '';
6704   my ( $bill_now, $invoice_terms ) = ( 0, '' );
6705   if ( ref( $_[0] ) ) {
6706     $amount     = $_[0]->{amount};
6707     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6708     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6709     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
6710     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6711     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6712                                            : '$'. sprintf("%.2f",$amount);
6713     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6714     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6715     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6716     $additional = $_[0]->{additional} || [];
6717     $taxproduct = $_[0]->{taxproductnum};
6718     $override   = { '' => $_[0]->{tax_override} };
6719     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
6720     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
6721     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
6722   } else {
6723     $amount     = shift;
6724     $quantity   = 1;
6725     $start_date = '';
6726     $pkg        = @_ ? shift : 'One-time charge';
6727     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6728     $setuptax   = '';
6729     $taxclass   = @_ ? shift : '';
6730     $additional = [];
6731   }
6732
6733   local $SIG{HUP} = 'IGNORE';
6734   local $SIG{INT} = 'IGNORE';
6735   local $SIG{QUIT} = 'IGNORE';
6736   local $SIG{TERM} = 'IGNORE';
6737   local $SIG{TSTP} = 'IGNORE';
6738   local $SIG{PIPE} = 'IGNORE';
6739
6740   my $oldAutoCommit = $FS::UID::AutoCommit;
6741   local $FS::UID::AutoCommit = 0;
6742   my $dbh = dbh;
6743
6744   my $part_pkg = new FS::part_pkg ( {
6745     'pkg'           => $pkg,
6746     'comment'       => $comment,
6747     'plan'          => 'flat',
6748     'freq'          => 0,
6749     'disabled'      => 'Y',
6750     'classnum'      => ( $classnum ? $classnum : '' ),
6751     'setuptax'      => $setuptax,
6752     'taxclass'      => $taxclass,
6753     'taxproductnum' => $taxproduct,
6754   } );
6755
6756   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6757                         ( 0 .. @$additional - 1 )
6758                   ),
6759                   'additional_count' => scalar(@$additional),
6760                   'setup_fee' => $amount,
6761                 );
6762
6763   my $error = $part_pkg->insert( options       => \%options,
6764                                  tax_overrides => $override,
6765                                );
6766   if ( $error ) {
6767     $dbh->rollback if $oldAutoCommit;
6768     return $error;
6769   }
6770
6771   my $pkgpart = $part_pkg->pkgpart;
6772   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6773   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6774     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6775     $error = $type_pkgs->insert;
6776     if ( $error ) {
6777       $dbh->rollback if $oldAutoCommit;
6778       return $error;
6779     }
6780   }
6781
6782   my $cust_pkg = new FS::cust_pkg ( {
6783     'custnum'    => $self->custnum,
6784     'pkgpart'    => $pkgpart,
6785     'quantity'   => $quantity,
6786     'start_date' => $start_date,
6787     'no_auto'    => $no_auto,
6788   } );
6789
6790   $error = $cust_pkg->insert;
6791   if ( $error ) {
6792     $dbh->rollback if $oldAutoCommit;
6793     return $error;
6794   } elsif ( $cust_pkg_ref ) {
6795     ${$cust_pkg_ref} = $cust_pkg;
6796   }
6797
6798   if ( $bill_now ) {
6799     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
6800                              'pkg_list'      => [ $cust_pkg ],
6801                            );
6802     if ( $error ) {
6803       $dbh->rollback if $oldAutoCommit;
6804       return $error;
6805     }
6806   }
6807
6808   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6809   return '';
6810
6811 }
6812
6813 #=item charge_postal_fee
6814 #
6815 #Applies a one time charge this customer.  If there is an error,
6816 #returns the error, returns the cust_pkg charge object or false
6817 #if there was no charge.
6818 #
6819 #=cut
6820 #
6821 # This should be a customer event.  For that to work requires that bill
6822 # also be a customer event.
6823
6824 sub charge_postal_fee {
6825   my $self = shift;
6826
6827   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6828   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6829
6830   my $cust_pkg = new FS::cust_pkg ( {
6831     'custnum'  => $self->custnum,
6832     'pkgpart'  => $pkgpart,
6833     'quantity' => 1,
6834   } );
6835
6836   my $error = $cust_pkg->insert;
6837   $error ? $error : $cust_pkg;
6838 }
6839
6840 =item cust_bill
6841
6842 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6843
6844 =cut
6845
6846 sub cust_bill {
6847   my $self = shift;
6848   map { $_ } #return $self->num_cust_bill unless wantarray;
6849   sort { $a->_date <=> $b->_date }
6850     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6851 }
6852
6853 =item open_cust_bill
6854
6855 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6856 customer.
6857
6858 =cut
6859
6860 sub open_cust_bill {
6861   my $self = shift;
6862
6863   qsearch({
6864     'table'     => 'cust_bill',
6865     'hashref'   => { 'custnum' => $self->custnum, },
6866     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6867     'order_by'  => 'ORDER BY _date ASC',
6868   });
6869
6870 }
6871
6872 =item cust_statements
6873
6874 Returns all the statements (see L<FS::cust_statement>) for this customer.
6875
6876 =cut
6877
6878 sub cust_statement {
6879   my $self = shift;
6880   map { $_ } #return $self->num_cust_statement unless wantarray;
6881   sort { $a->_date <=> $b->_date }
6882     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
6883 }
6884
6885 =item cust_credit
6886
6887 Returns all the credits (see L<FS::cust_credit>) for this customer.
6888
6889 =cut
6890
6891 sub cust_credit {
6892   my $self = shift;
6893   map { $_ } #return $self->num_cust_credit unless wantarray;
6894   sort { $a->_date <=> $b->_date }
6895     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6896 }
6897
6898 =item cust_credit_pkgnum
6899
6900 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
6901 package when using experimental package balances.
6902
6903 =cut
6904
6905 sub cust_credit_pkgnum {
6906   my( $self, $pkgnum ) = @_;
6907   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
6908   sort { $a->_date <=> $b->_date }
6909     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
6910                               'pkgnum'  => $pkgnum,
6911                             }
6912     );
6913 }
6914
6915 =item cust_pay
6916
6917 Returns all the payments (see L<FS::cust_pay>) for this customer.
6918
6919 =cut
6920
6921 sub cust_pay {
6922   my $self = shift;
6923   return $self->num_cust_pay unless wantarray;
6924   sort { $a->_date <=> $b->_date }
6925     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6926 }
6927
6928 =item num_cust_pay
6929
6930 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
6931 called automatically when the cust_pay method is used in a scalar context.
6932
6933 =cut
6934
6935 sub num_cust_pay {
6936   my $self = shift;
6937   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
6938   my $sth = dbh->prepare($sql) or die dbh->errstr;
6939   $sth->execute($self->custnum) or die $sth->errstr;
6940   $sth->fetchrow_arrayref->[0];
6941 }
6942
6943 =item cust_pay_pkgnum
6944
6945 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
6946 package when using experimental package balances.
6947
6948 =cut
6949
6950 sub cust_pay_pkgnum {
6951   my( $self, $pkgnum ) = @_;
6952   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
6953   sort { $a->_date <=> $b->_date }
6954     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
6955                            'pkgnum'  => $pkgnum,
6956                          }
6957     );
6958 }
6959
6960 =item cust_pay_void
6961
6962 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6963
6964 =cut
6965
6966 sub cust_pay_void {
6967   my $self = shift;
6968   map { $_ } #return $self->num_cust_pay_void unless wantarray;
6969   sort { $a->_date <=> $b->_date }
6970     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6971 }
6972
6973 =item cust_pay_batch
6974
6975 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6976
6977 =cut
6978
6979 sub cust_pay_batch {
6980   my $self = shift;
6981   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
6982   sort { $a->paybatchnum <=> $b->paybatchnum }
6983     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6984 }
6985
6986 =item cust_pay_pending
6987
6988 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6989 (without status "done").
6990
6991 =cut
6992
6993 sub cust_pay_pending {
6994   my $self = shift;
6995   return $self->num_cust_pay_pending unless wantarray;
6996   sort { $a->_date <=> $b->_date }
6997     qsearch( 'cust_pay_pending', {
6998                                    'custnum' => $self->custnum,
6999                                    'status'  => { op=>'!=', value=>'done' },
7000                                  },
7001            );
7002 }
7003
7004 =item num_cust_pay_pending
7005
7006 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7007 customer (without status "done").  Also called automatically when the
7008 cust_pay_pending method is used in a scalar context.
7009
7010 =cut
7011
7012 sub num_cust_pay_pending {
7013   my $self = shift;
7014   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7015             "   WHERE custnum = ? AND status != 'done' ";
7016   my $sth = dbh->prepare($sql) or die dbh->errstr;
7017   $sth->execute($self->custnum) or die $sth->errstr;
7018   $sth->fetchrow_arrayref->[0];
7019 }
7020
7021 =item cust_refund
7022
7023 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7024
7025 =cut
7026
7027 sub cust_refund {
7028   my $self = shift;
7029   map { $_ } #return $self->num_cust_refund unless wantarray;
7030   sort { $a->_date <=> $b->_date }
7031     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7032 }
7033
7034 =item display_custnum
7035
7036 Returns the displayed customer number for this customer: agent_custid if
7037 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7038
7039 =cut
7040
7041 sub display_custnum {
7042   my $self = shift;
7043   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7044     return $self->agent_custid;
7045   } else {
7046     return $self->custnum;
7047   }
7048 }
7049
7050 =item name
7051
7052 Returns a name string for this customer, either "Company (Last, First)" or
7053 "Last, First".
7054
7055 =cut
7056
7057 sub name {
7058   my $self = shift;
7059   my $name = $self->contact;
7060   $name = $self->company. " ($name)" if $self->company;
7061   $name;
7062 }
7063
7064 =item ship_name
7065
7066 Returns a name string for this (service/shipping) contact, either
7067 "Company (Last, First)" or "Last, First".
7068
7069 =cut
7070
7071 sub ship_name {
7072   my $self = shift;
7073   if ( $self->get('ship_last') ) {
7074     my $name = $self->ship_contact;
7075     $name = $self->ship_company. " ($name)" if $self->ship_company;
7076     $name;
7077   } else {
7078     $self->name;
7079   }
7080 }
7081
7082 =item name_short
7083
7084 Returns a name string for this customer, either "Company" or "First Last".
7085
7086 =cut
7087
7088 sub name_short {
7089   my $self = shift;
7090   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7091 }
7092
7093 =item ship_name_short
7094
7095 Returns a name string for this (service/shipping) contact, either "Company"
7096 or "First Last".
7097
7098 =cut
7099
7100 sub ship_name_short {
7101   my $self = shift;
7102   if ( $self->get('ship_last') ) {
7103     $self->ship_company !~ /^\s*$/
7104       ? $self->ship_company
7105       : $self->ship_contact_firstlast;
7106   } else {
7107     $self->name_company_or_firstlast;
7108   }
7109 }
7110
7111 =item contact
7112
7113 Returns this customer's full (billing) contact name only, "Last, First"
7114
7115 =cut
7116
7117 sub contact {
7118   my $self = shift;
7119   $self->get('last'). ', '. $self->first;
7120 }
7121
7122 =item ship_contact
7123
7124 Returns this customer's full (shipping) contact name only, "Last, First"
7125
7126 =cut
7127
7128 sub ship_contact {
7129   my $self = shift;
7130   $self->get('ship_last')
7131     ? $self->get('ship_last'). ', '. $self->ship_first
7132     : $self->contact;
7133 }
7134
7135 =item contact_firstlast
7136
7137 Returns this customers full (billing) contact name only, "First Last".
7138
7139 =cut
7140
7141 sub contact_firstlast {
7142   my $self = shift;
7143   $self->first. ' '. $self->get('last');
7144 }
7145
7146 =item ship_contact_firstlast
7147
7148 Returns this customer's full (shipping) contact name only, "First Last".
7149
7150 =cut
7151
7152 sub ship_contact_firstlast {
7153   my $self = shift;
7154   $self->get('ship_last')
7155     ? $self->first. ' '. $self->get('ship_last')
7156     : $self->contact_firstlast;
7157 }
7158
7159 =item country_full
7160
7161 Returns this customer's full country name
7162
7163 =cut
7164
7165 sub country_full {
7166   my $self = shift;
7167   code2country($self->country);
7168 }
7169
7170 =item geocode DATA_VENDOR
7171
7172 Returns a value for the customer location as encoded by DATA_VENDOR.
7173 Currently this only makes sense for "CCH" as DATA_VENDOR.
7174
7175 =cut
7176
7177 sub geocode {
7178   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7179
7180   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7181   return $geocode if $geocode;
7182
7183   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7184                ? 'ship_'
7185                : '';
7186
7187   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7188     if $self->country eq 'US';
7189
7190   $zip ||= '';
7191   $plus4 ||= '';
7192   #CCH specific location stuff
7193   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7194
7195   my @cust_tax_location =
7196     qsearch( {
7197                'table'     => 'cust_tax_location',
7198                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7199                'extra_sql' => $extra_sql,
7200                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7201              }
7202            );
7203   $geocode = $cust_tax_location[0]->geocode
7204     if scalar(@cust_tax_location);
7205
7206   $geocode;
7207 }
7208
7209 =item cust_status
7210
7211 =item status
7212
7213 Returns a status string for this customer, currently:
7214
7215 =over 4
7216
7217 =item prospect - No packages have ever been ordered
7218
7219 =item ordered - Recurring packages all are new (not yet billed).
7220
7221 =item active - One or more recurring packages is active
7222
7223 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7224
7225 =item suspended - All non-cancelled recurring packages are suspended
7226
7227 =item cancelled - All recurring packages are cancelled
7228
7229 =back
7230
7231 =cut
7232
7233 sub status { shift->cust_status(@_); }
7234
7235 sub cust_status {
7236   my $self = shift;
7237   # prospect ordered active inactive suspended cancelled
7238   for my $status ( FS::cust_main->statuses() ) {
7239     my $method = $status.'_sql';
7240     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7241     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7242     $sth->execute( ($self->custnum) x $numnum )
7243       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7244     return $status if $sth->fetchrow_arrayref->[0];
7245   }
7246 }
7247
7248 =item ucfirst_cust_status
7249
7250 =item ucfirst_status
7251
7252 Returns the status with the first character capitalized.
7253
7254 =cut
7255
7256 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7257
7258 sub ucfirst_cust_status {
7259   my $self = shift;
7260   ucfirst($self->cust_status);
7261 }
7262
7263 =item statuscolor
7264
7265 Returns a hex triplet color string for this customer's status.
7266
7267 =cut
7268
7269 use vars qw(%statuscolor);
7270 tie %statuscolor, 'Tie::IxHash',
7271   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7272   'active'    => '00CC00', #green
7273   'ordered'   => '009999', #teal? cyan?
7274   'inactive'  => '0000CC', #blue
7275   'suspended' => 'FF9900', #yellow
7276   'cancelled' => 'FF0000', #red
7277 ;
7278
7279 sub statuscolor { shift->cust_statuscolor(@_); }
7280
7281 sub cust_statuscolor {
7282   my $self = shift;
7283   $statuscolor{$self->cust_status};
7284 }
7285
7286 =item tickets
7287
7288 Returns an array of hashes representing the customer's RT tickets.
7289
7290 =cut
7291
7292 sub tickets {
7293   my $self = shift;
7294
7295   my $num = $conf->config('cust_main-max_tickets') || 10;
7296   my @tickets = ();
7297
7298   if ( $conf->config('ticket_system') ) {
7299     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7300
7301       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7302
7303     } else {
7304
7305       foreach my $priority (
7306         $conf->config('ticket_system-custom_priority_field-values'), ''
7307       ) {
7308         last if scalar(@tickets) >= $num;
7309         push @tickets,
7310           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7311                                                  $num - scalar(@tickets),
7312                                                  $priority,
7313                                                )
7314            };
7315       }
7316     }
7317   }
7318   (@tickets);
7319 }
7320
7321 # Return services representing svc_accts in customer support packages
7322 sub support_services {
7323   my $self = shift;
7324   my %packages = map { $_ => 1 } $conf->config('support_packages');
7325
7326   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7327     grep { $_->part_svc->svcdb eq 'svc_acct' }
7328     map { $_->cust_svc }
7329     grep { exists $packages{ $_->pkgpart } }
7330     $self->ncancelled_pkgs;
7331
7332 }
7333
7334 # Return a list of latitude/longitude for one of the services (if any)
7335 sub service_coordinates {
7336   my $self = shift;
7337
7338   my @svc_X =
7339     grep { $_->latitude && $_->longitude }
7340     map { $_->svc_x }
7341     map { $_->cust_svc }
7342     $self->ncancelled_pkgs;
7343
7344   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7345 }
7346
7347 =back
7348
7349 =head1 CLASS METHODS
7350
7351 =over 4
7352
7353 =item statuses
7354
7355 Class method that returns the list of possible status strings for customers
7356 (see L<the status method|/status>).  For example:
7357
7358   @statuses = FS::cust_main->statuses();
7359
7360 =cut
7361
7362 sub statuses {
7363   #my $self = shift; #could be class...
7364   keys %statuscolor;
7365 }
7366
7367 =item prospect_sql
7368
7369 Returns an SQL expression identifying prospective cust_main records (customers
7370 with no packages ever ordered)
7371
7372 =cut
7373
7374 use vars qw($select_count_pkgs);
7375 $select_count_pkgs =
7376   "SELECT COUNT(*) FROM cust_pkg
7377     WHERE cust_pkg.custnum = cust_main.custnum";
7378
7379 sub select_count_pkgs_sql {
7380   $select_count_pkgs;
7381 }
7382
7383 sub prospect_sql {
7384   " 0 = ( $select_count_pkgs ) ";
7385 }
7386
7387 =item ordered_sql
7388
7389 Returns an SQL expression identifying ordered cust_main records (customers with
7390 recurring packages not yet setup).
7391
7392 =cut
7393
7394 sub ordered_sql {
7395   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
7396 }
7397
7398 =item active_sql
7399
7400 Returns an SQL expression identifying active cust_main records (customers with
7401 active recurring packages).
7402
7403 =cut
7404
7405 sub active_sql {
7406   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
7407 }
7408
7409 =item inactive_sql
7410
7411 Returns an SQL expression identifying inactive cust_main records (customers with
7412 no active recurring packages, but otherwise unsuspended/uncancelled).
7413
7414 =cut
7415
7416 sub inactive_sql { "
7417   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7418   AND
7419   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7420 "; }
7421
7422 =item susp_sql
7423 =item suspended_sql
7424
7425 Returns an SQL expression identifying suspended cust_main records.
7426
7427 =cut
7428
7429
7430 sub suspended_sql { susp_sql(@_); }
7431 sub susp_sql { "
7432     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7433     AND
7434     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7435 "; }
7436
7437 =item cancel_sql
7438 =item cancelled_sql
7439
7440 Returns an SQL expression identifying cancelled cust_main records.
7441
7442 =cut
7443
7444 sub cancelled_sql { cancel_sql(@_); }
7445 sub cancel_sql {
7446
7447   my $recurring_sql = FS::cust_pkg->recurring_sql;
7448   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7449
7450   "
7451         0 < ( $select_count_pkgs )
7452     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7453     AND 0 = ( $select_count_pkgs AND $recurring_sql
7454                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7455             )
7456     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7457   ";
7458
7459 }
7460
7461 =item uncancel_sql
7462 =item uncancelled_sql
7463
7464 Returns an SQL expression identifying un-cancelled cust_main records.
7465
7466 =cut
7467
7468 sub uncancelled_sql { uncancel_sql(@_); }
7469 sub uncancel_sql { "
7470   ( 0 < ( $select_count_pkgs
7471                    AND ( cust_pkg.cancel IS NULL
7472                          OR cust_pkg.cancel = 0
7473                        )
7474         )
7475     OR 0 = ( $select_count_pkgs )
7476   )
7477 "; }
7478
7479 =item balance_sql
7480
7481 Returns an SQL fragment to retreive the balance.
7482
7483 =cut
7484
7485 sub balance_sql { "
7486     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7487         WHERE cust_bill.custnum   = cust_main.custnum     )
7488   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7489         WHERE cust_pay.custnum    = cust_main.custnum     )
7490   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7491         WHERE cust_credit.custnum = cust_main.custnum     )
7492   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7493         WHERE cust_refund.custnum = cust_main.custnum     )
7494 "; }
7495
7496 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
7497
7498 Returns an SQL fragment to retreive the balance for this customer, optionally
7499 considering invoices with date earlier than START_TIME, and not
7500 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7501 total_unapplied_payments).
7502
7503 Times are specified as SQL fragments or numeric
7504 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7505 L<Date::Parse> for conversion functions.  The empty string can be passed
7506 to disable that time constraint completely.
7507
7508 Available options are:
7509
7510 =over 4
7511
7512 =item unapplied_date
7513
7514 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
7515
7516 =item total
7517
7518 (unused.  obsolete?)
7519 set to true to remove all customer comparison clauses, for totals
7520
7521 =item where
7522
7523 (unused.  obsolete?)
7524 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7525
7526 =item join
7527
7528 (unused.  obsolete?)
7529 JOIN clause (typically used with the total option)
7530
7531 =item cutoff
7532
7533 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
7534 time will be ignored.  Note that START_TIME and END_TIME only limit the date
7535 range for invoices and I<unapplied> payments, credits, and refunds.
7536
7537 =back
7538
7539 =cut
7540
7541 sub balance_date_sql {
7542   my( $class, $start, $end, %opt ) = @_;
7543
7544   my $cutoff = $opt{'cutoff'};
7545
7546   my $owed         = FS::cust_bill->owed_sql($cutoff);
7547   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
7548   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
7549   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7550
7551   my $j = $opt{'join'} || '';
7552
7553   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7554   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7555   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7556   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7557
7558   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7559     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7560     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7561     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7562   ";
7563
7564 }
7565
7566 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7567
7568 Returns an SQL fragment to retreive the total unapplied payments for this
7569 customer, only considering invoices with date earlier than START_TIME, and
7570 optionally not later than END_TIME.
7571
7572 Times are specified as SQL fragments or numeric
7573 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7574 L<Date::Parse> for conversion functions.  The empty string can be passed
7575 to disable that time constraint completely.
7576
7577 Available options are:
7578
7579 =cut
7580
7581 sub unapplied_payments_date_sql {
7582   my( $class, $start, $end, %opt ) = @_;
7583
7584   my $cutoff = $opt{'cutoff'};
7585
7586   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7587
7588   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7589                                                           'unapplied_date'=>1 );
7590
7591   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7592 }
7593
7594 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7595
7596 Helper method for balance_date_sql; name (and usage) subject to change
7597 (suggestions welcome).
7598
7599 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7600 cust_refund, cust_credit or cust_pay).
7601
7602 If TABLE is "cust_bill" or the unapplied_date option is true, only
7603 considers records with date earlier than START_TIME, and optionally not
7604 later than END_TIME .
7605
7606 =cut
7607
7608 sub _money_table_where {
7609   my( $class, $table, $start, $end, %opt ) = @_;
7610
7611   my @where = ();
7612   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7613   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7614     push @where, "$table._date <= $start" if defined($start) && length($start);
7615     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7616   }
7617   push @where, @{$opt{'where'}} if $opt{'where'};
7618   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7619
7620   $where;
7621
7622 }
7623
7624 =item search HASHREF
7625
7626 (Class method)
7627
7628 Returns a qsearch hash expression to search for parameters specified in
7629 HASHREF.  Valid parameters are
7630
7631 =over 4
7632
7633 =item agentnum
7634
7635 =item status
7636
7637 =item cancelled_pkgs
7638
7639 bool
7640
7641 =item signupdate
7642
7643 listref of start date, end date
7644
7645 =item payby
7646
7647 listref
7648
7649 =item paydate_year
7650
7651 =item paydate_month
7652
7653 =item current_balance
7654
7655 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7656
7657 =item cust_fields
7658
7659 =item flattened_pkgs
7660
7661 bool
7662
7663 =back
7664
7665 =cut
7666
7667 sub search {
7668   my ($class, $params) = @_;
7669
7670   my $dbh = dbh;
7671
7672   my @where = ();
7673   my $orderby;
7674
7675   ##
7676   # parse agent
7677   ##
7678
7679   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7680     push @where,
7681       "cust_main.agentnum = $1";
7682   }
7683
7684   ##
7685   # do the same for user
7686   ##
7687
7688   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
7689     push @where,
7690       "cust_main.usernum = $1";
7691   }
7692
7693   ##
7694   # parse status
7695   ##
7696
7697   #prospect ordered active inactive suspended cancelled
7698   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7699     my $method = $params->{'status'}. '_sql';
7700     #push @where, $class->$method();
7701     push @where, FS::cust_main->$method();
7702   }
7703
7704   ##
7705   # parse cancelled package checkbox
7706   ##
7707
7708   my $pkgwhere = "";
7709
7710   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7711     unless $params->{'cancelled_pkgs'};
7712
7713   ##
7714   # parse without census tract checkbox
7715   ##
7716
7717   push @where, "(censustract = '' or censustract is null)"
7718     if $params->{'no_censustract'};
7719
7720   ##
7721   # dates
7722   ##
7723
7724   foreach my $field (qw( signupdate )) {
7725
7726     next unless exists($params->{$field});
7727
7728     my($beginning, $ending, $hour) = @{$params->{$field}};
7729
7730     push @where,
7731       "cust_main.$field IS NOT NULL",
7732       "cust_main.$field >= $beginning",
7733       "cust_main.$field <= $ending";
7734
7735     # XXX: do this for mysql and/or pull it out of here
7736     if(defined $hour) {
7737       if ($dbh->{Driver}->{Name} eq 'Pg') {
7738         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
7739       }
7740       else {
7741         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
7742       }
7743     }
7744
7745     $orderby ||= "ORDER BY cust_main.$field";
7746
7747   }
7748
7749   ###
7750   # classnum
7751   ###
7752
7753   if ( $params->{'classnum'} ) {
7754
7755     my @classnum = ref( $params->{'classnum'} )
7756                      ? @{ $params->{'classnum'} }
7757                      :  ( $params->{'classnum'} );
7758
7759     @classnum = grep /^(\d*)$/, @classnum;
7760
7761     if ( @classnum ) {
7762       push @where, '( '. join(' OR ', map {
7763                                             $_ ? "cust_main.classnum = $_"
7764                                                : "cust_main.classnum IS NULL"
7765                                           }
7766                                           @classnum
7767                              ).
7768                    ' )';
7769     }
7770
7771   }
7772
7773   ###
7774   # payby
7775   ###
7776
7777   if ( $params->{'payby'} ) {
7778
7779     my @payby = ref( $params->{'payby'} )
7780                   ? @{ $params->{'payby'} }
7781                   :  ( $params->{'payby'} );
7782
7783     @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7784
7785     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
7786       if @payby;
7787
7788   }
7789
7790   ###
7791   # paydate_year / paydate_month
7792   ###
7793
7794   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
7795     my $year = $1;
7796     $params->{'paydate_month'} =~ /^(\d\d?)$/
7797       or die "paydate_year without paydate_month?";
7798     my $month = $1;
7799
7800     push @where,
7801       'paydate IS NOT NULL',
7802       "paydate != ''",
7803       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
7804 ;
7805   }
7806
7807   ###
7808   # invoice terms
7809   ###
7810
7811   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
7812     my $terms = $1;
7813     if ( $1 eq 'NULL' ) {
7814       push @where,
7815         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
7816     } else {
7817       push @where,
7818         "cust_main.invoice_terms IS NOT NULL",
7819         "cust_main.invoice_terms = '$1'";
7820     }
7821   }
7822
7823   ##
7824   # amounts
7825   ##
7826
7827   if ( $params->{'current_balance'} ) {
7828
7829     #my $balance_sql = $class->balance_sql();
7830     my $balance_sql = FS::cust_main->balance_sql();
7831
7832     my @current_balance =
7833       ref( $params->{'current_balance'} )
7834       ? @{ $params->{'current_balance'} }
7835       :  ( $params->{'current_balance'} );
7836
7837     push @where, map { s/current_balance/$balance_sql/; $_ }
7838                      @current_balance;
7839
7840   }
7841
7842   ##
7843   # custbatch
7844   ##
7845
7846   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7847     push @where,
7848       "cust_main.custbatch = '$1'";
7849   }
7850
7851   ##
7852   # setup queries, subs, etc. for the search
7853   ##
7854
7855   $orderby ||= 'ORDER BY custnum';
7856
7857   # here is the agent virtualization
7858   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7859
7860   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7861
7862   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
7863
7864   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7865
7866   my $select = join(', ',
7867                  'cust_main.custnum',
7868                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7869                );
7870
7871   my(@extra_headers) = ();
7872   my(@extra_fields)  = ();
7873
7874   if ($params->{'flattened_pkgs'}) {
7875
7876     if ($dbh->{Driver}->{Name} eq 'Pg') {
7877
7878       $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
7879
7880     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7881       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7882       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7883     }else{
7884       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7885            "omitting packing information from report.";
7886     }
7887
7888     my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
7889
7890     my $sth = dbh->prepare($header_query) or die dbh->errstr;
7891     $sth->execute() or die $sth->errstr;
7892     my $headerrow = $sth->fetchrow_arrayref;
7893     my $headercount = $headerrow ? $headerrow->[0] : 0;
7894     while($headercount) {
7895       unshift @extra_headers, "Package ". $headercount;
7896       unshift @extra_fields, eval q!sub {my $c = shift;
7897                                          my @a = split '\|', $c->magic;
7898                                          my $p = $a[!.--$headercount. q!];
7899                                          $p;
7900                                         };!;
7901     }
7902
7903   }
7904
7905   my $sql_query = {
7906     'table'         => 'cust_main',
7907     'select'        => $select,
7908     'hashref'       => {},
7909     'extra_sql'     => $extra_sql,
7910     'order_by'      => $orderby,
7911     'count_query'   => $count_query,
7912     'extra_headers' => \@extra_headers,
7913     'extra_fields'  => \@extra_fields,
7914   };
7915
7916 }
7917
7918 =item email_search_result HASHREF
7919
7920 (Class method)
7921
7922 Emails a notice to the specified customers.
7923
7924 Valid parameters are those of the L<search> method, plus the following:
7925
7926 =over 4
7927
7928 =item from
7929
7930 From: address
7931
7932 =item subject
7933
7934 Email Subject:
7935
7936 =item html_body
7937
7938 HTML body
7939
7940 =item text_body
7941
7942 Text body
7943
7944 =item job
7945
7946 Optional job queue job for status updates.
7947
7948 =back
7949
7950 Returns an error message, or false for success.
7951
7952 If an error occurs during any email, stops the enture send and returns that
7953 error.  Presumably if you're getting SMTP errors aborting is better than
7954 retrying everything.
7955
7956 =cut
7957
7958 sub email_search_result {
7959   my($class, $params) = @_;
7960
7961   my $from = delete $params->{from};
7962   my $subject = delete $params->{subject};
7963   my $html_body = delete $params->{html_body};
7964   my $text_body = delete $params->{text_body};
7965
7966   my $job = delete $params->{'job'};
7967
7968   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
7969     unless ref($params->{'payby'});
7970
7971   my $sql_query = $class->search($params);
7972
7973   my $count_query   = delete($sql_query->{'count_query'});
7974   my $count_sth = dbh->prepare($count_query)
7975     or die "Error preparing $count_query: ". dbh->errstr;
7976   $count_sth->execute
7977     or die "Error executing $count_query: ". $count_sth->errstr;
7978   my $count_arrayref = $count_sth->fetchrow_arrayref;
7979   my $num_cust = $count_arrayref->[0];
7980
7981   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7982   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
7983
7984
7985   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7986
7987   #eventually order+limit magic to reduce memory use?
7988   foreach my $cust_main ( qsearch($sql_query) ) {
7989
7990     my $to = $cust_main->invoicing_list_emailonly_scalar;
7991     next unless $to;
7992
7993     my $error = send_email(
7994       generate_email(
7995         'from'      => $from,
7996         'to'        => $to,
7997         'subject'   => $subject,
7998         'html_body' => $html_body,
7999         'text_body' => $text_body,
8000       )
8001     );
8002     return $error if $error;
8003
8004     if ( $job ) { #progressbar foo
8005       $num++;
8006       if ( time - $min_sec > $last ) {
8007         my $error = $job->update_statustext(
8008           int( 100 * $num / $num_cust )
8009         );
8010         die $error if $error;
8011         $last = time;
8012       }
8013     }
8014
8015   }
8016
8017   return '';
8018 }
8019
8020 use Storable qw(thaw);
8021 use Data::Dumper;
8022 use MIME::Base64;
8023 sub process_email_search_result {
8024   my $job = shift;
8025   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8026
8027   my $param = thaw(decode_base64(shift));
8028   warn Dumper($param) if $DEBUG;
8029
8030   $param->{'job'} = $job;
8031
8032   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8033     unless ref($param->{'payby'});
8034
8035   my $error = FS::cust_main->email_search_result( $param );
8036   die $error if $error;
8037
8038 }
8039
8040 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8041
8042 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8043 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8044 specified (the appropriate ship_ field is also searched).
8045
8046 Additional options are the same as FS::Record::qsearch
8047
8048 =cut
8049
8050 sub fuzzy_search {
8051   my( $self, $fuzzy, $hash, @opt) = @_;
8052   #$self
8053   $hash ||= {};
8054   my @cust_main = ();
8055
8056   check_and_rebuild_fuzzyfiles();
8057   foreach my $field ( keys %$fuzzy ) {
8058
8059     my $all = $self->all_X($field);
8060     next unless scalar(@$all);
8061
8062     my %match = ();
8063     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8064
8065     my @fcust = ();
8066     foreach ( keys %match ) {
8067       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8068       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8069     }
8070     my %fsaw = ();
8071     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8072   }
8073
8074   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8075   my %saw = ();
8076   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8077
8078   @cust_main;
8079
8080 }
8081
8082 =item masked FIELD
8083
8084 Returns a masked version of the named field
8085
8086 =cut
8087
8088 sub masked {
8089 my ($self,$field) = @_;
8090
8091 # Show last four
8092
8093 'x'x(length($self->getfield($field))-4).
8094   substr($self->getfield($field), (length($self->getfield($field))-4));
8095
8096 }
8097
8098 =back
8099
8100 =head1 SUBROUTINES
8101
8102 =over 4
8103
8104 =item smart_search OPTION => VALUE ...
8105
8106 Accepts the following options: I<search>, the string to search for.  The string
8107 will be searched for as a customer number, phone number, name or company name,
8108 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8109 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8110 skip fuzzy matching when an exact match is found.
8111
8112 Any additional options are treated as an additional qualifier on the search
8113 (i.e. I<agentnum>).
8114
8115 Returns a (possibly empty) array of FS::cust_main objects.
8116
8117 =cut
8118
8119 sub smart_search {
8120   my %options = @_;
8121
8122   #here is the agent virtualization
8123   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8124
8125   my @cust_main = ();
8126
8127   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8128   my $search = delete $options{'search'};
8129   ( my $alphanum_search = $search ) =~ s/\W//g;
8130
8131   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8132
8133     #false laziness w/Record::ut_phone
8134     my $phonen = "$1-$2-$3";
8135     $phonen .= " x$4" if $4;
8136
8137     push @cust_main, qsearch( {
8138       'table'   => 'cust_main',
8139       'hashref' => { %options },
8140       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8141                      ' ( '.
8142                          join(' OR ', map "$_ = '$phonen'",
8143                                           qw( daytime night fax
8144                                               ship_daytime ship_night ship_fax )
8145                              ).
8146                      ' ) '.
8147                      " AND $agentnums_sql", #agent virtualization
8148     } );
8149
8150     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8151       #try looking for matches with extensions unless one was specified
8152
8153       push @cust_main, qsearch( {
8154         'table'   => 'cust_main',
8155         'hashref' => { %options },
8156         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8157                        ' ( '.
8158                            join(' OR ', map "$_ LIKE '$phonen\%'",
8159                                             qw( daytime night
8160                                                 ship_daytime ship_night )
8161                                ).
8162                        ' ) '.
8163                        " AND $agentnums_sql", #agent virtualization
8164       } );
8165
8166     }
8167
8168   # custnum search (also try agent_custid), with some tweaking options if your
8169   # legacy cust "numbers" have letters
8170   }
8171
8172   if ( $search =~ /^\s*(\d+)\s*$/
8173          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8174               && $search =~ /^\s*(\w\w?\d+)\s*$/
8175             )
8176          || ( $conf->exists('address1-search' )
8177               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8178             )
8179      )
8180   {
8181
8182     my $num = $1;
8183
8184     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8185       push @cust_main, qsearch( {
8186         'table'     => 'cust_main',
8187         'hashref'   => { 'custnum' => $num, %options },
8188         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8189       } );
8190     }
8191
8192     push @cust_main, qsearch( {
8193       'table'     => 'cust_main',
8194       'hashref'   => { 'agent_custid' => $num, %options },
8195       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8196     } );
8197
8198     if ( $conf->exists('address1-search') ) {
8199       my $len = length($num);
8200       $num = lc($num);
8201       foreach my $prefix ( '', 'ship_' ) {
8202         push @cust_main, qsearch( {
8203           'table'     => 'cust_main',
8204           'hashref'   => { %options, },
8205           'extra_sql' =>
8206             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8207             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8208             " AND $agentnums_sql",
8209         } );
8210       }
8211     }
8212
8213   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8214
8215     my($company, $last, $first) = ( $1, $2, $3 );
8216
8217     # "Company (Last, First)"
8218     #this is probably something a browser remembered,
8219     #so just do an exact search (but case-insensitive, so USPS standardization
8220     #doesn't throw a wrench in the works)
8221
8222     foreach my $prefix ( '', 'ship_' ) {
8223       push @cust_main, qsearch( {
8224         'table'     => 'cust_main',
8225         'hashref'   => { %options },
8226         'extra_sql' =>
8227           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8228           join(' AND ',
8229             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8230             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8231             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8232             $agentnums_sql,
8233           ),
8234       } );
8235     }
8236
8237   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8238                                               # try (ship_){last,company}
8239
8240     my $value = lc($1);
8241
8242     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8243     # # full strings the browser remembers won't work
8244     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8245
8246     use Lingua::EN::NameParse;
8247     my $NameParse = new Lingua::EN::NameParse(
8248              auto_clean     => 1,
8249              allow_reversed => 1,
8250     );
8251
8252     my($last, $first) = ( '', '' );
8253     #maybe disable this too and just rely on NameParse?
8254     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8255
8256       ($last, $first) = ( $1, $2 );
8257
8258     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8259     } elsif ( ! $NameParse->parse($value) ) {
8260
8261       my %name = $NameParse->components;
8262       $first = $name{'given_name_1'};
8263       $last  = $name{'surname_1'};
8264
8265     }
8266
8267     if ( $first && $last ) {
8268
8269       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8270
8271       #exact
8272       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8273       $sql .= "
8274         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8275            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8276         )";
8277
8278       push @cust_main, qsearch( {
8279         'table'     => 'cust_main',
8280         'hashref'   => \%options,
8281         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8282       } );
8283
8284       # or it just be something that was typed in... (try that in a sec)
8285
8286     }
8287
8288     my $q_value = dbh->quote($value);
8289
8290     #exact
8291     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8292     $sql .= " (    LOWER(last)          = $q_value
8293                 OR LOWER(company)       = $q_value
8294                 OR LOWER(ship_last)     = $q_value
8295                 OR LOWER(ship_company)  = $q_value
8296             ";
8297     $sql .= "   OR LOWER(address1)      = $q_value
8298                 OR LOWER(ship_address1) = $q_value
8299             "
8300       if $conf->exists('address1-search');
8301     $sql .= " )";
8302
8303     push @cust_main, qsearch( {
8304       'table'     => 'cust_main',
8305       'hashref'   => \%options,
8306       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8307     } );
8308
8309     #no exact match, trying substring/fuzzy
8310     #always do substring & fuzzy (unless they're explicity config'ed off)
8311     #getting complaints searches are not returning enough
8312     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8313
8314       #still some false laziness w/search (was search/cust_main.cgi)
8315
8316       #substring
8317
8318       my @hashrefs = (
8319         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8320         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8321       );
8322
8323       if ( $first && $last ) {
8324
8325         push @hashrefs,
8326           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8327             'last'         => { op=>'ILIKE', value=>"%$last%" },
8328           },
8329           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8330             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8331           },
8332         ;
8333
8334       } else {
8335
8336         push @hashrefs,
8337           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8338           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8339         ;
8340       }
8341
8342       if ( $conf->exists('address1-search') ) {
8343         push @hashrefs,
8344           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8345           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8346         ;
8347       }
8348
8349       foreach my $hashref ( @hashrefs ) {
8350
8351         push @cust_main, qsearch( {
8352           'table'     => 'cust_main',
8353           'hashref'   => { %$hashref,
8354                            %options,
8355                          },
8356           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8357         } );
8358
8359       }
8360
8361       #fuzzy
8362       my @fuzopts = (
8363         \%options,                #hashref
8364         '',                       #select
8365         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8366       );
8367
8368       if ( $first && $last ) {
8369         push @cust_main, FS::cust_main->fuzzy_search(
8370           { 'last'   => $last,    #fuzzy hashref
8371             'first'  => $first }, #
8372           @fuzopts
8373         );
8374       }
8375       foreach my $field ( 'last', 'company' ) {
8376         push @cust_main,
8377           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8378       }
8379       if ( $conf->exists('address1-search') ) {
8380         push @cust_main,
8381           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8382       }
8383
8384     }
8385
8386   }
8387
8388   #eliminate duplicates
8389   my %saw = ();
8390   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8391
8392   @cust_main;
8393
8394 }
8395
8396 =item email_search
8397
8398 Accepts the following options: I<email>, the email address to search for.  The
8399 email address will be searched for as an email invoice destination and as an
8400 svc_acct account.
8401
8402 #Any additional options are treated as an additional qualifier on the search
8403 #(i.e. I<agentnum>).
8404
8405 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8406 none or one).
8407
8408 =cut
8409
8410 sub email_search {
8411   my %options = @_;
8412
8413   local($DEBUG) = 1;
8414
8415   my $email = delete $options{'email'};
8416
8417   #we're only being used by RT at the moment... no agent virtualization yet
8418   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8419
8420   my @cust_main = ();
8421
8422   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8423
8424     my ( $user, $domain ) = ( $1, $2 );
8425
8426     warn "$me smart_search: searching for $user in domain $domain"
8427       if $DEBUG;
8428
8429     push @cust_main,
8430       map $_->cust_main,
8431           qsearch( {
8432                      'table'     => 'cust_main_invoice',
8433                      'hashref'   => { 'dest' => $email },
8434                    }
8435                  );
8436
8437     push @cust_main,
8438       map  $_->cust_main,
8439       grep $_,
8440       map  $_->cust_svc->cust_pkg,
8441           qsearch( {
8442                      'table'     => 'svc_acct',
8443                      'hashref'   => { 'username' => $user, },
8444                      'extra_sql' =>
8445                        'AND ( SELECT domain FROM svc_domain
8446                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8447                             ) = '. dbh->quote($domain),
8448                    }
8449                  );
8450   }
8451
8452   my %saw = ();
8453   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8454
8455   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8456     if $DEBUG;
8457
8458   @cust_main;
8459
8460 }
8461
8462 =item check_and_rebuild_fuzzyfiles
8463
8464 =cut
8465
8466 sub check_and_rebuild_fuzzyfiles {
8467   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8468   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8469 }
8470
8471 =item rebuild_fuzzyfiles
8472
8473 =cut
8474
8475 sub rebuild_fuzzyfiles {
8476
8477   use Fcntl qw(:flock);
8478
8479   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8480   mkdir $dir, 0700 unless -d $dir;
8481
8482   foreach my $fuzzy ( @fuzzyfields ) {
8483
8484     open(LOCK,">>$dir/cust_main.$fuzzy")
8485       or die "can't open $dir/cust_main.$fuzzy: $!";
8486     flock(LOCK,LOCK_EX)
8487       or die "can't lock $dir/cust_main.$fuzzy: $!";
8488
8489     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8490       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8491
8492     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8493       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8494                              " WHERE $field != '' AND $field IS NOT NULL");
8495       $sth->execute or die $sth->errstr;
8496
8497       while ( my $row = $sth->fetchrow_arrayref ) {
8498         print CACHE $row->[0]. "\n";
8499       }
8500
8501     }
8502
8503     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8504
8505     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8506     close LOCK;
8507   }
8508
8509 }
8510
8511 =item all_X
8512
8513 =cut
8514
8515 sub all_X {
8516   my( $self, $field ) = @_;
8517   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8518   open(CACHE,"<$dir/cust_main.$field")
8519     or die "can't open $dir/cust_main.$field: $!";
8520   my @array = map { chomp; $_; } <CACHE>;
8521   close CACHE;
8522   \@array;
8523 }
8524
8525 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8526
8527 =cut
8528
8529 sub append_fuzzyfiles {
8530   #my( $first, $last, $company ) = @_;
8531
8532   &check_and_rebuild_fuzzyfiles;
8533
8534   use Fcntl qw(:flock);
8535
8536   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8537
8538   foreach my $field (@fuzzyfields) {
8539     my $value = shift;
8540
8541     if ( $value ) {
8542
8543       open(CACHE,">>$dir/cust_main.$field")
8544         or die "can't open $dir/cust_main.$field: $!";
8545       flock(CACHE,LOCK_EX)
8546         or die "can't lock $dir/cust_main.$field: $!";
8547
8548       print CACHE "$value\n";
8549
8550       flock(CACHE,LOCK_UN)
8551         or die "can't unlock $dir/cust_main.$field: $!";
8552       close CACHE;
8553     }
8554
8555   }
8556
8557   1;
8558 }
8559
8560 =item batch_charge
8561
8562 =cut
8563
8564 sub batch_charge {
8565   my $param = shift;
8566   #warn join('-',keys %$param);
8567   my $fh = $param->{filehandle};
8568   my @fields = @{$param->{fields}};
8569
8570   eval "use Text::CSV_XS;";
8571   die $@ if $@;
8572
8573   my $csv = new Text::CSV_XS;
8574   #warn $csv;
8575   #warn $fh;
8576
8577   my $imported = 0;
8578   #my $columns;
8579
8580   local $SIG{HUP} = 'IGNORE';
8581   local $SIG{INT} = 'IGNORE';
8582   local $SIG{QUIT} = 'IGNORE';
8583   local $SIG{TERM} = 'IGNORE';
8584   local $SIG{TSTP} = 'IGNORE';
8585   local $SIG{PIPE} = 'IGNORE';
8586
8587   my $oldAutoCommit = $FS::UID::AutoCommit;
8588   local $FS::UID::AutoCommit = 0;
8589   my $dbh = dbh;
8590
8591   #while ( $columns = $csv->getline($fh) ) {
8592   my $line;
8593   while ( defined($line=<$fh>) ) {
8594
8595     $csv->parse($line) or do {
8596       $dbh->rollback if $oldAutoCommit;
8597       return "can't parse: ". $csv->error_input();
8598     };
8599
8600     my @columns = $csv->fields();
8601     #warn join('-',@columns);
8602
8603     my %row = ();
8604     foreach my $field ( @fields ) {
8605       $row{$field} = shift @columns;
8606     }
8607
8608     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8609     unless ( $cust_main ) {
8610       $dbh->rollback if $oldAutoCommit;
8611       return "unknown custnum $row{'custnum'}";
8612     }
8613
8614     if ( $row{'amount'} > 0 ) {
8615       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8616       if ( $error ) {
8617         $dbh->rollback if $oldAutoCommit;
8618         return $error;
8619       }
8620       $imported++;
8621     } elsif ( $row{'amount'} < 0 ) {
8622       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8623                                       $row{'pkg'}                         );
8624       if ( $error ) {
8625         $dbh->rollback if $oldAutoCommit;
8626         return $error;
8627       }
8628       $imported++;
8629     } else {
8630       #hmm?
8631     }
8632
8633   }
8634
8635   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8636
8637   return "Empty file!" unless $imported;
8638
8639   ''; #no error
8640
8641 }
8642
8643 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8644
8645 Sends a templated email notification to the customer (see L<Text::Template>).
8646
8647 OPTIONS is a hash and may include
8648
8649 I<from> - the email sender (default is invoice_from)
8650
8651 I<to> - comma-separated scalar or arrayref of recipients
8652    (default is invoicing_list)
8653
8654 I<subject> - The subject line of the sent email notification
8655    (default is "Notice from company_name")
8656
8657 I<extra_fields> - a hashref of name/value pairs which will be substituted
8658    into the template
8659
8660 The following variables are vavailable in the template.
8661
8662 I<$first> - the customer first name
8663 I<$last> - the customer last name
8664 I<$company> - the customer company
8665 I<$payby> - a description of the method of payment for the customer
8666             # would be nice to use FS::payby::shortname
8667 I<$payinfo> - the account information used to collect for this customer
8668 I<$expdate> - the expiration of the customer payment in seconds from epoch
8669
8670 =cut
8671
8672 sub notify {
8673   my ($self, $template, %options) = @_;
8674
8675   return unless $conf->exists($template);
8676
8677   my $from = $conf->config('invoice_from', $self->agentnum)
8678     if $conf->exists('invoice_from', $self->agentnum);
8679   $from = $options{from} if exists($options{from});
8680
8681   my $to = join(',', $self->invoicing_list_emailonly);
8682   $to = $options{to} if exists($options{to});
8683
8684   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8685     if $conf->exists('company_name', $self->agentnum);
8686   $subject = $options{subject} if exists($options{subject});
8687
8688   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8689                                             SOURCE => [ map "$_\n",
8690                                               $conf->config($template)]
8691                                            )
8692     or die "can't create new Text::Template object: Text::Template::ERROR";
8693   $notify_template->compile()
8694     or die "can't compile template: Text::Template::ERROR";
8695
8696   $FS::notify_template::_template::company_name =
8697     $conf->config('company_name', $self->agentnum);
8698   $FS::notify_template::_template::company_address =
8699     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8700
8701   my $paydate = $self->paydate || '2037-12-31';
8702   $FS::notify_template::_template::first = $self->first;
8703   $FS::notify_template::_template::last = $self->last;
8704   $FS::notify_template::_template::company = $self->company;
8705   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8706   my $payby = $self->payby;
8707   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8708   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8709
8710   #credit cards expire at the end of the month/year of their exp date
8711   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8712     $FS::notify_template::_template::payby = 'credit card';
8713     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8714     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8715     $expire_time--;
8716   }elsif ($payby eq 'COMP') {
8717     $FS::notify_template::_template::payby = 'complimentary account';
8718   }else{
8719     $FS::notify_template::_template::payby = 'current method';
8720   }
8721   $FS::notify_template::_template::expdate = $expire_time;
8722
8723   for (keys %{$options{extra_fields}}){
8724     no strict "refs";
8725     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8726   }
8727
8728   send_email(from => $from,
8729              to => $to,
8730              subject => $subject,
8731              body => $notify_template->fill_in( PACKAGE =>
8732                                                 'FS::notify_template::_template'                                              ),
8733             );
8734
8735 }
8736
8737 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8738
8739 Generates a templated notification to the customer (see L<Text::Template>).
8740
8741 OPTIONS is a hash and may include
8742
8743 I<extra_fields> - a hashref of name/value pairs which will be substituted
8744    into the template.  These values may override values mentioned below
8745    and those from the customer record.
8746
8747 The following variables are available in the template instead of or in addition
8748 to the fields of the customer record.
8749
8750 I<$payby> - a description of the method of payment for the customer
8751             # would be nice to use FS::payby::shortname
8752 I<$payinfo> - the masked account information used to collect for this customer
8753 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8754 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8755
8756 =cut
8757
8758 sub generate_letter {
8759   my ($self, $template, %options) = @_;
8760
8761   return unless $conf->exists($template);
8762
8763   my $letter_template = new Text::Template
8764                         ( TYPE       => 'ARRAY',
8765                           SOURCE     => [ map "$_\n", $conf->config($template)],
8766                           DELIMITERS => [ '[@--', '--@]' ],
8767                         )
8768     or die "can't create new Text::Template object: Text::Template::ERROR";
8769
8770   $letter_template->compile()
8771     or die "can't compile template: Text::Template::ERROR";
8772
8773   my %letter_data = map { $_ => $self->$_ } $self->fields;
8774   $letter_data{payinfo} = $self->mask_payinfo;
8775
8776   #my $paydate = $self->paydate || '2037-12-31';
8777   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8778
8779   my $payby = $self->payby;
8780   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8781   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8782
8783   #credit cards expire at the end of the month/year of their exp date
8784   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8785     $letter_data{payby} = 'credit card';
8786     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8787     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8788     $expire_time--;
8789   }elsif ($payby eq 'COMP') {
8790     $letter_data{payby} = 'complimentary account';
8791   }else{
8792     $letter_data{payby} = 'current method';
8793   }
8794   $letter_data{expdate} = $expire_time;
8795
8796   for (keys %{$options{extra_fields}}){
8797     $letter_data{$_} = $options{extra_fields}->{$_};
8798   }
8799
8800   unless(exists($letter_data{returnaddress})){
8801     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8802                                                   $self->agent_template)
8803                      );
8804     if ( length($retadd) ) {
8805       $letter_data{returnaddress} = $retadd;
8806     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8807       $letter_data{returnaddress} =
8808         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8809                           $conf->config('company_address', $self->agentnum)
8810         );
8811     } else {
8812       $letter_data{returnaddress} = '~';
8813     }
8814   }
8815
8816   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8817
8818   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8819
8820   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8821   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8822                            DIR      => $dir,
8823                            SUFFIX   => '.tex',
8824                            UNLINK   => 0,
8825                          ) or die "can't open temp file: $!\n";
8826
8827   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8828   close $fh;
8829   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8830   return $1;
8831 }
8832
8833 =item print_ps TEMPLATE
8834
8835 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8836
8837 =cut
8838
8839 sub print_ps {
8840   my $self = shift;
8841   my $file = $self->generate_letter(@_);
8842   FS::Misc::generate_ps($file);
8843 }
8844
8845 =item print TEMPLATE
8846
8847 Prints the filled in template.
8848
8849 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8850
8851 =cut
8852
8853 sub queueable_print {
8854   my %opt = @_;
8855
8856   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8857     or die "invalid customer number: " . $opt{custvnum};
8858
8859   my $error = $self->print( $opt{template} );
8860   die $error if $error;
8861 }
8862
8863 sub print {
8864   my ($self, $template) = (shift, shift);
8865   do_print [ $self->print_ps($template) ];
8866 }
8867
8868 #these three subs should just go away once agent stuff is all config overrides
8869
8870 sub agent_template {
8871   my $self = shift;
8872   $self->_agent_plandata('agent_templatename');
8873 }
8874
8875 sub agent_invoice_from {
8876   my $self = shift;
8877   $self->_agent_plandata('agent_invoice_from');
8878 }
8879
8880 sub _agent_plandata {
8881   my( $self, $option ) = @_;
8882
8883   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
8884   #agent-specific Conf
8885
8886   use FS::part_event::Condition;
8887
8888   my $agentnum = $self->agentnum;
8889
8890   my $regexp = regexp_sql();
8891
8892   my $part_event_option =
8893     qsearchs({
8894       'select'    => 'part_event_option.*',
8895       'table'     => 'part_event_option',
8896       'addl_from' => q{
8897         LEFT JOIN part_event USING ( eventpart )
8898         LEFT JOIN part_event_option AS peo_agentnum
8899           ON ( part_event.eventpart = peo_agentnum.eventpart
8900                AND peo_agentnum.optionname = 'agentnum'
8901                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8902              )
8903         LEFT JOIN part_event_condition
8904           ON ( part_event.eventpart = part_event_condition.eventpart
8905                AND part_event_condition.conditionname = 'cust_bill_age'
8906              )
8907         LEFT JOIN part_event_condition_option
8908           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8909                AND part_event_condition_option.optionname = 'age'
8910              )
8911       },
8912       #'hashref'   => { 'optionname' => $option },
8913       #'hashref'   => { 'part_event_option.optionname' => $option },
8914       'extra_sql' =>
8915         " WHERE part_event_option.optionname = ". dbh->quote($option).
8916         " AND action = 'cust_bill_send_agent' ".
8917         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8918         " AND peo_agentnum.optionname = 'agentnum' ".
8919         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8920         " ORDER BY
8921            CASE WHEN part_event_condition_option.optionname IS NULL
8922            THEN -1
8923            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8924         " END
8925           , part_event.weight".
8926         " LIMIT 1"
8927     });
8928
8929   unless ( $part_event_option ) {
8930     return $self->agent->invoice_template || ''
8931       if $option eq 'agent_templatename';
8932     return '';
8933   }
8934
8935   $part_event_option->optionvalue;
8936
8937 }
8938
8939 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
8940
8941 Subroutine (not a method), designed to be called from the queue.
8942
8943 Takes a list of options and values.
8944
8945 Pulls up the customer record via the custnum option and calls bill_and_collect.
8946
8947 =cut
8948
8949 sub queued_bill {
8950   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8951
8952   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8953   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
8954
8955   $cust_main->bill_and_collect( %args );
8956 }
8957
8958 sub _upgrade_data { #class method
8959   my ($class, %opts) = @_;
8960
8961   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8962   my $sth = dbh->prepare($sql) or die dbh->errstr;
8963   $sth->execute or die $sth->errstr;
8964
8965   local($ignore_expired_card) = 1;
8966   $class->_upgrade_otaker(%opts);
8967
8968 }
8969
8970 =back
8971
8972 =head1 BUGS
8973
8974 The delete method.
8975
8976 The delete method should possibly take an FS::cust_main object reference
8977 instead of a scalar customer number.
8978
8979 Bill and collect options should probably be passed as references instead of a
8980 list.
8981
8982 There should probably be a configuration file with a list of allowed credit
8983 card types.
8984
8985 No multiple currency support (probably a larger project than just this module).
8986
8987 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8988
8989 Birthdates rely on negative epoch values.
8990
8991 The payby for card/check batches is broken.  With mixed batching, bad
8992 things will happen.
8993
8994 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8995
8996 =head1 SEE ALSO
8997
8998 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8999 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9000 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
9001
9002 =cut
9003
9004 1;
9005