FS/FS/cust_main.pm

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