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 =cut
2335
2336 sub bill_and_collect {
2337   my( $self, %options ) = @_;
2338
2339   #$options{actual_time} not $options{time} because freeside-daily -d is for
2340   #pre-printing invoices
2341   $self->cancel_expired_pkgs(    $options{actual_time} );
2342   $self->suspend_adjourned_pkgs( $options{actual_time} );
2343
2344   my $error = $self->bill( %options );
2345   warn "Error billing, custnum ". $self->custnum. ": $error" if $error;
2346
2347   $self->apply_payments_and_credits;
2348
2349   unless ( $conf->exists('cancelled_cust-noevents')
2350            && ! $self->num_ncancelled_pkgs
2351   ) {
2352
2353     $error = $self->collect( %options );
2354     warn "Error collecting, custnum". $self->custnum. ": $error" if $error;
2355
2356   }
2357
2358 }
2359
2360 sub cancel_expired_pkgs {
2361   my ( $self, $time ) = @_;
2362
2363   my @cancel_pkgs = $self->ncancelled_pkgs( {
2364     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2365   } );
2366
2367   foreach my $cust_pkg ( @cancel_pkgs ) {
2368     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2369     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
2370                                            'reason_otaker' => $cpr->otaker
2371                                          )
2372                                        : ()
2373                                  );
2374     warn "Error cancelling expired pkg ". $cust_pkg->pkgnum.
2375          " for custnum ". $self->custnum. ": $error"
2376       if $error;
2377   }
2378
2379 }
2380
2381 sub suspend_adjourned_pkgs {
2382   my ( $self, $time ) = @_;
2383
2384   my @susp_pkgs = $self->ncancelled_pkgs( {
2385     'extra_sql' =>
2386       " AND ( susp IS NULL OR susp = 0 )
2387         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
2388               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2389             )
2390       ",
2391   } );
2392
2393   #only because there's no SQL test for is_prepaid :/
2394   @susp_pkgs =
2395     grep {     (    $_->part_pkg->is_prepaid
2396                  && $_->bill
2397                  && $_->bill < $time
2398                )
2399             || (    $_->adjourn
2400                  && $_->adjourn <= $time
2401                )
2402
2403          }
2404          @susp_pkgs;
2405
2406   foreach my $cust_pkg ( @susp_pkgs ) {
2407     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2408       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2409     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2410                                             'reason_otaker' => $cpr->otaker
2411                                           )
2412                                         : ()
2413                                   );
2414
2415     warn "Error suspending package ". $cust_pkg->pkgnum.
2416          " for custnum ". $self->custnum. ": $error"
2417       if $error;
2418   }
2419
2420 }
2421
2422 =item bill OPTIONS
2423
2424 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2425 conjunction with the collect method by calling B<bill_and_collect>.
2426
2427 If there is an error, returns the error, otherwise returns false.
2428
2429 Options are passed as name-value pairs.  Currently available options are:
2430
2431 =over 4
2432
2433 =item resetup
2434
2435 If set true, re-charges setup fees.
2436
2437 =item time
2438
2439 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:
2440
2441  use Date::Parse;
2442  ...
2443  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2444
2445 =item pkg_list
2446
2447 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2448
2449  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2450
2451 =item invoice_time
2452
2453 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.
2454
2455 =item cancel
2456
2457 This boolean value informs the us that the package is being cancelled.  This
2458 typically might mean not charging the normal recurring fee but only usage
2459 fees since the last billing. Setup charges may be charged.  Not all package
2460 plans support this feature (they tend to charge 0).
2461
2462 =back
2463
2464 =cut
2465
2466 sub bill {
2467   my( $self, %options ) = @_;
2468   return '' if $self->payby eq 'COMP';
2469   warn "$me bill customer ". $self->custnum. "\n"
2470     if $DEBUG;
2471
2472   my $time = $options{'time'} || time;
2473   my $invoice_time = $options{'invoice_time'} || $time;
2474
2475   #put below somehow?
2476   local $SIG{HUP} = 'IGNORE';
2477   local $SIG{INT} = 'IGNORE';
2478   local $SIG{QUIT} = 'IGNORE';
2479   local $SIG{TERM} = 'IGNORE';
2480   local $SIG{TSTP} = 'IGNORE';
2481   local $SIG{PIPE} = 'IGNORE';
2482
2483   my $oldAutoCommit = $FS::UID::AutoCommit;
2484   local $FS::UID::AutoCommit = 0;
2485   my $dbh = dbh;
2486
2487   $self->select_for_update; #mutex
2488
2489   my @cust_bill_pkg = ();
2490
2491   ###
2492   # find the packages which are due for billing, find out how much they are
2493   # & generate invoice database.
2494   ###
2495
2496   my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
2497   my %taxlisthash;
2498   my @precommit_hooks = ();
2499
2500   $options{ pkg_list } ||= [ $self->ncancelled_pkgs ];  #param checks?
2501   foreach my $cust_pkg ( @{ $options{ pkg_list } } ) {
2502
2503     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2504
2505     #? to avoid use of uninitialized value errors... ?
2506     $cust_pkg->setfield('bill', '')
2507       unless defined($cust_pkg->bill);
2508
2509     #my $part_pkg = $cust_pkg->part_pkg;
2510
2511     my $real_pkgpart = $cust_pkg->pkgpart;
2512     my %hash = $cust_pkg->hash;
2513
2514     foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
2515
2516       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2517
2518       my $error =
2519         $self->_make_lines( 'part_pkg'            => $part_pkg,
2520                             'cust_pkg'            => $cust_pkg,
2521                             'precommit_hooks'     => \@precommit_hooks,
2522                             'line_items'          => \@cust_bill_pkg,
2523                             'setup'               => \$total_setup,
2524                             'recur'               => \$total_recur,
2525                             'tax_matrix'          => \%taxlisthash,
2526                             'time'                => $time,
2527                             'options'             => \%options,
2528                           );
2529       if ($error) {
2530         $dbh->rollback if $oldAutoCommit;
2531         return $error;
2532       }
2533
2534     } #foreach my $part_pkg
2535
2536   } #foreach my $cust_pkg
2537
2538   unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
2539     #but do commit any package date cycling that happened
2540     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2541     return '';
2542   }
2543
2544   if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
2545          !$conf->exists('postal_invoice-recurring_only')
2546      )
2547   {
2548
2549     my $postal_pkg = $self->charge_postal_fee();
2550     if ( $postal_pkg && !ref( $postal_pkg ) ) {
2551
2552       $dbh->rollback if $oldAutoCommit;
2553       return "can't charge postal invoice fee for customer ".
2554         $self->custnum. ": $postal_pkg";
2555
2556     } elsif ( $postal_pkg ) {
2557
2558       foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2559         my %postal_options = %options;
2560         delete $postal_options{cancel};
2561         my $error =
2562           $self->_make_lines( 'part_pkg'            => $part_pkg,
2563                               'cust_pkg'            => $postal_pkg,
2564                               'precommit_hooks'     => \@precommit_hooks,
2565                               'line_items'          => \@cust_bill_pkg,
2566                               'setup'               => \$total_setup,
2567                               'recur'               => \$total_recur,
2568                               'tax_matrix'          => \%taxlisthash,
2569                               'time'                => $time,
2570                               'options'             => \%postal_options,
2571                             );
2572         if ($error) {
2573           $dbh->rollback if $oldAutoCommit;
2574           return $error;
2575         }
2576       }
2577
2578     }
2579
2580   }
2581
2582   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2583
2584   # keys are tax names (as printed on invoices / itemdesc )
2585   # values are listrefs of taxlisthash keys (internal identifiers)
2586   my %taxname = ();
2587
2588   # keys are taxlisthash keys (internal identifiers)
2589   # values are (cumulative) amounts
2590   my %tax = ();
2591
2592   # keys are taxlisthash keys (internal identifiers)
2593   # values are listrefs of cust_bill_pkg_tax_location hashrefs
2594   my %tax_location = ();
2595
2596   # keys are taxlisthash keys (internal identifiers)
2597   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
2598   my %tax_rate_location = ();
2599
2600   foreach my $tax ( keys %taxlisthash ) {
2601     my $tax_object = shift @{ $taxlisthash{$tax} };
2602     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2603     warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
2604     my $hashref_or_error =
2605       $tax_object->taxline( $taxlisthash{$tax},
2606                             'custnum'      => $self->custnum,
2607                             'invoice_time' => $invoice_time
2608                           );
2609     unless ( ref($hashref_or_error) ) {
2610       $dbh->rollback if $oldAutoCommit;
2611       return $hashref_or_error;
2612     }
2613     unshift @{ $taxlisthash{$tax} }, $tax_object;
2614
2615     my $name   = $hashref_or_error->{'name'};
2616     my $amount = $hashref_or_error->{'amount'};
2617
2618     #warn "adding $amount as $name\n";
2619     $taxname{ $name } ||= [];
2620     push @{ $taxname{ $name } }, $tax;
2621
2622     $tax{ $tax } += $amount;
2623
2624     $tax_location{ $tax } ||= [];
2625     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
2626       push @{ $tax_location{ $tax }  },
2627         {
2628           'taxnum'      => $tax_object->taxnum,
2629           'taxtype'     => ref($tax_object),
2630           'pkgnum'      => $tax_object->get('pkgnum'),
2631           'locationnum' => $tax_object->get('locationnum'),
2632           'amount'      => sprintf('%.2f', $amount ),
2633         };
2634     }
2635
2636     $tax_rate_location{ $tax } ||= [];
2637     if ( ref($tax_object) eq 'FS::tax_rate' ) {
2638       my $taxratelocationnum =
2639         $tax_object->tax_rate_location->taxratelocationnum;
2640       push @{ $tax_rate_location{ $tax }  },
2641         {
2642           'taxnum'             => $tax_object->taxnum,
2643           'taxtype'            => ref($tax_object),
2644           'amount'             => sprintf('%.2f', $amount ),
2645           'locationtaxid'      => $tax_object->location,
2646           'taxratelocationnum' => $taxratelocationnum,
2647         };
2648     }
2649
2650   }
2651
2652   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
2653   my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
2654   foreach my $tax ( keys %taxlisthash ) {
2655     foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
2656       next unless ref($_) eq 'FS::cust_bill_pkg';
2657
2658       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
2659         splice( @{ $_->_cust_tax_exempt_pkg } );
2660     }
2661   }
2662
2663   #consolidate and create tax line items
2664   warn "consolidating and generating...\n" if $DEBUG > 2;
2665   foreach my $taxname ( keys %taxname ) {
2666     my $tax = 0;
2667     my %seen = ();
2668     my @cust_bill_pkg_tax_location = ();
2669     my @cust_bill_pkg_tax_rate_location = ();
2670     warn "adding $taxname\n" if $DEBUG > 1;
2671     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2672       next if $seen{$taxitem}++;
2673       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2674       $tax += $tax{$taxitem};
2675       push @cust_bill_pkg_tax_location,
2676         map { new FS::cust_bill_pkg_tax_location $_ }
2677             @{ $tax_location{ $taxitem } };
2678       push @cust_bill_pkg_tax_rate_location,
2679         map { new FS::cust_bill_pkg_tax_rate_location $_ }
2680             @{ $tax_rate_location{ $taxitem } };
2681     }
2682     next unless $tax;
2683
2684     $tax = sprintf('%.2f', $tax );
2685     $total_setup = sprintf('%.2f', $total_setup+$tax );
2686
2687     push @cust_bill_pkg, new FS::cust_bill_pkg {
2688       'pkgnum'   => 0,
2689       'setup'    => $tax,
2690       'recur'    => 0,
2691       'sdate'    => '',
2692       'edate'    => '',
2693       'itemdesc' => $taxname,
2694       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2695       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
2696     };
2697
2698   }
2699
2700   #add tax adjustments
2701   warn "adding tax adjustments...\n" if $DEBUG > 2;
2702   foreach my $cust_tax_adjustment (
2703     qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
2704                                      'billpkgnum' => '',
2705                                    }
2706            )
2707   ) {
2708
2709     my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
2710     $total_setup = sprintf('%.2f', $total_setup+$tax );
2711
2712     my $itemdesc = $cust_tax_adjustment->taxname;
2713     $itemdesc = '' if $itemdesc eq 'Tax';
2714
2715     push @cust_bill_pkg, new FS::cust_bill_pkg {
2716       'pkgnum'      => 0,
2717       'setup'       => $tax,
2718       'recur'       => 0,
2719       'sdate'       => '',
2720       'edate'       => '',
2721       'itemdesc'    => $itemdesc,
2722       'itemcomment' => $cust_tax_adjustment->comment,
2723       'cust_tax_adjustment' => $cust_tax_adjustment,
2724       #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
2725     };
2726
2727   }
2728
2729   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2730
2731   #create the new invoice
2732   my $cust_bill = new FS::cust_bill ( {
2733     'custnum' => $self->custnum,
2734     '_date'   => ( $invoice_time ),
2735     'charged' => $charged,
2736   } );
2737   my $error = $cust_bill->insert;
2738   if ( $error ) {
2739     $dbh->rollback if $oldAutoCommit;
2740     return "can't create invoice for customer #". $self->custnum. ": $error";
2741   }
2742
2743   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2744     $cust_bill_pkg->invnum($cust_bill->invnum);
2745     my $error = $cust_bill_pkg->insert;
2746     if ( $error ) {
2747       $dbh->rollback if $oldAutoCommit;
2748       return "can't create invoice line item: $error";
2749     }
2750   }
2751
2752
2753   foreach my $hook ( @precommit_hooks ) {
2754     eval {
2755       &{$hook}; #($self) ?
2756     };
2757     if ( $@ ) {
2758       $dbh->rollback if $oldAutoCommit;
2759       return "$@ running precommit hook $hook\n";
2760     }
2761   }
2762
2763   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2764   ''; #no error
2765 }
2766
2767
2768 sub _make_lines {
2769   my ($self, %params) = @_;
2770
2771   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2772   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2773   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2774   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2775   my $total_setup = $params{setup} or die "no setup accumulator specified";
2776   my $total_recur = $params{recur} or die "no recur accumulator specified";
2777   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2778   my $time = $params{'time'} or die "no time specified";
2779   my (%options) = %{$params{options}};
2780
2781   my $dbh = dbh;
2782   my $real_pkgpart = $cust_pkg->pkgpart;
2783   my %hash = $cust_pkg->hash;
2784   my $old_cust_pkg = new FS::cust_pkg \%hash;
2785
2786   my @details = ();
2787
2788   my $lineitems = 0;
2789
2790   $cust_pkg->pkgpart($part_pkg->pkgpart);
2791
2792   ###
2793   # bill setup
2794   ###
2795
2796   my $setup = 0;
2797   my $unitsetup = 0;
2798   if ( $options{'resetup'}
2799        || ( ! $cust_pkg->setup
2800             && ( ! $cust_pkg->start_date
2801                  || $cust_pkg->start_date <= $time
2802                )
2803             && ( ! $conf->exists('disable_setup_suspended_pkgs')
2804                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
2805                       ! $cust_pkg->getfield('susp')
2806                     )
2807                )
2808           )
2809     )
2810   {
2811
2812     warn "    bill setup\n" if $DEBUG > 1;
2813     $lineitems++;
2814
2815     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2816     return "$@ running calc_setup for $cust_pkg\n"
2817       if $@;
2818
2819     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2820
2821     $cust_pkg->setfield('setup', $time)
2822       unless $cust_pkg->setup;
2823           #do need it, but it won't get written to the db
2824           #|| $cust_pkg->pkgpart != $real_pkgpart;
2825
2826     $cust_pkg->setfield('start_date', '')
2827       if $cust_pkg->start_date;
2828
2829   }
2830
2831   ###
2832   # bill recurring fee
2833   ###
2834
2835   #XXX unit stuff here too
2836   my $recur = 0;
2837   my $unitrecur = 0;
2838   my $sdate;
2839   if ( ! $cust_pkg->getfield('susp') and
2840            ( $part_pkg->getfield('freq') ne '0' &&
2841              ( $cust_pkg->getfield('bill') || 0 ) <= $time
2842            )
2843         || ( $part_pkg->plan eq 'voip_cdr'
2844               && $part_pkg->option('bill_every_call')
2845            )
2846         || ( $options{cancel} )
2847   ) {
2848
2849     # XXX should this be a package event?  probably.  events are called
2850     # at collection time at the moment, though...
2851     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2852       if $part_pkg->can('reset_usage');
2853       #don't want to reset usage just cause we want a line item??
2854       #&& $part_pkg->pkgpart == $real_pkgpart;
2855
2856     warn "    bill recur\n" if $DEBUG > 1;
2857     $lineitems++;
2858
2859     # XXX shared with $recur_prog
2860     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
2861              || $cust_pkg->setup
2862              || $time;
2863
2864     #over two params!  lets at least switch to a hashref for the rest...
2865     my $increment_next_bill = ( $part_pkg->freq ne '0'
2866                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
2867                                 && !$options{cancel}
2868                               );
2869     my %param = ( 'precommit_hooks'     => $precommit_hooks,
2870                   'increment_next_bill' => $increment_next_bill,
2871                 );
2872
2873     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
2874     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
2875     return "$@ running $method for $cust_pkg\n"
2876       if ( $@ );
2877
2878     if ( $increment_next_bill ) {
2879
2880       my $next_bill = $part_pkg->add_freq($sdate);
2881       return "unparsable frequency: ". $part_pkg->freq
2882         if $next_bill == -1;
2883
2884       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
2885       # only for figuring next bill date, nothing else, so, reset $sdate again
2886       # here
2887       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2888       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2889       $cust_pkg->last_bill($sdate);
2890
2891       $cust_pkg->setfield('bill', $next_bill );
2892
2893     }
2894
2895   }
2896
2897   warn "\$setup is undefined" unless defined($setup);
2898   warn "\$recur is undefined" unless defined($recur);
2899   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2900
2901   ###
2902   # If there's line items, create em cust_bill_pkg records
2903   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2904   ###
2905
2906   if ( $lineitems ) {
2907
2908     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2909       # hmm.. and if just the options are modified in some weird price plan?
2910
2911       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2912         if $DEBUG >1;
2913
2914       my $error = $cust_pkg->replace( $old_cust_pkg,
2915                                       'options' => { $cust_pkg->options },
2916                                     );
2917       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2918         if $error; #just in case
2919     }
2920
2921     $setup = sprintf( "%.2f", $setup );
2922     $recur = sprintf( "%.2f", $recur );
2923     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2924       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2925     }
2926     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2927       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2928     }
2929
2930     if ( $setup != 0 || $recur != 0 ) {
2931
2932       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2933         if $DEBUG > 1;
2934
2935       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2936       if ( $DEBUG > 1 ) {
2937         warn "      adding customer package invoice detail: $_\n"
2938           foreach @cust_pkg_detail;
2939       }
2940       push @details, @cust_pkg_detail;
2941
2942       my $cust_bill_pkg = new FS::cust_bill_pkg {
2943         'pkgnum'    => $cust_pkg->pkgnum,
2944         'setup'     => $setup,
2945         'unitsetup' => $unitsetup,
2946         'recur'     => $recur,
2947         'unitrecur' => $unitrecur,
2948         'quantity'  => $cust_pkg->quantity,
2949         'details'   => \@details,
2950       };
2951
2952       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2953         $cust_bill_pkg->sdate( $hash{last_bill} );
2954         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
2955         $cust_bill_pkg->edate( $time ) if $options{cancel};
2956       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2957         $cust_bill_pkg->sdate( $sdate );
2958         $cust_bill_pkg->edate( $cust_pkg->bill );
2959         #$cust_bill_pkg->edate( $time ) if $options{cancel};
2960       }
2961
2962       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2963         unless $part_pkg->pkgpart == $real_pkgpart;
2964
2965       $$total_setup += $setup;
2966       $$total_recur += $recur;
2967
2968       ###
2969       # handle taxes
2970       ###
2971
2972       my $error =
2973         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
2974       return $error if $error;
2975
2976       push @$cust_bill_pkgs, $cust_bill_pkg;
2977
2978     } #if $setup != 0 || $recur != 0
2979
2980   } #if $line_items
2981
2982   '';
2983
2984 }
2985
2986 sub _handle_taxes {
2987   my $self = shift;
2988   my $part_pkg = shift;
2989   my $taxlisthash = shift;
2990   my $cust_bill_pkg = shift;
2991   my $cust_pkg = shift;
2992   my $invoice_time = shift;
2993
2994   my %cust_bill_pkg = ();
2995   my %taxes = ();
2996
2997   my @classes;
2998   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2999   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3000   push @classes, 'setup' if $cust_bill_pkg->setup;
3001   push @classes, 'recur' if $cust_bill_pkg->recur;
3002
3003   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3004
3005     if ( $conf->exists('enable_taxproducts')
3006          && ( scalar($part_pkg->part_pkg_taxoverride)
3007               || $part_pkg->has_taxproduct
3008             )
3009        )
3010     {
3011
3012       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3013         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3014       }
3015
3016       foreach my $class (@classes) {
3017         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3018         return $err_or_ref unless ref($err_or_ref);
3019         $taxes{$class} = $err_or_ref;
3020       }
3021
3022       unless (exists $taxes{''}) {
3023         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3024         return $err_or_ref unless ref($err_or_ref);
3025         $taxes{''} = $err_or_ref;
3026       }
3027
3028     } else {
3029
3030       my @loc_keys = qw( state county country );
3031       my %taxhash;
3032       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3033         my $cust_location = $cust_pkg->cust_location;
3034         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
3035       } else {
3036         my $prefix =
3037           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3038           ? 'ship_'
3039           : '';
3040         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3041       }
3042
3043       $taxhash{'taxclass'} = $part_pkg->taxclass;
3044
3045       my @taxes = qsearch( 'cust_main_county', \%taxhash );
3046
3047       my %taxhash_elim = %taxhash;
3048
3049       my @elim = qw( taxclass county state );
3050       while ( !scalar(@taxes) && scalar(@elim) ) {
3051         $taxhash_elim{ shift(@elim) } = '';
3052         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3053       }
3054
3055       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3056                     @taxes
3057         if $self->cust_main_exemption; #just to be safe
3058
3059       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3060         foreach (@taxes) {
3061           $_->set('pkgnum',      $cust_pkg->pkgnum );
3062           $_->set('locationnum', $cust_pkg->locationnum );
3063         }
3064       }
3065
3066       $taxes{''} = [ @taxes ];
3067       $taxes{'setup'} = [ @taxes ];
3068       $taxes{'recur'} = [ @taxes ];
3069       $taxes{$_} = [ @taxes ] foreach (@classes);
3070
3071       # # maybe eliminate this entirely, along with all the 0% records
3072       # unless ( @taxes ) {
3073       #   return
3074       #     "fatal: can't find tax rate for state/county/country/taxclass ".
3075       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
3076       # }
3077
3078     } #if $conf->exists('enable_taxproducts') ...
3079
3080   }
3081
3082   my @display = ();
3083   if ( $conf->exists('separate_usage') ) {
3084     my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
3085     my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
3086     push @display, new FS::cust_bill_pkg_display { type    => 'S' };
3087     push @display, new FS::cust_bill_pkg_display { type    => 'R' };
3088     push @display, new FS::cust_bill_pkg_display { type    => 'U',
3089                                                    section => $section
3090                                                  };
3091     if ($section && $summary) {
3092       $display[2]->post_total('Y');
3093       push @display, new FS::cust_bill_pkg_display { type    => 'U',
3094                                                      summary => 'Y',
3095                                                    }
3096     }
3097   }
3098   $cust_bill_pkg->set('display', \@display);
3099
3100   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3101   foreach my $key (keys %tax_cust_bill_pkg) {
3102     my @taxes = @{ $taxes{$key} || [] };
3103     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3104
3105     my %localtaxlisthash = ();
3106     foreach my $tax ( @taxes ) {
3107
3108       my $taxname = ref( $tax ). ' '. $tax->taxnum;
3109 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3110 #                  ' locationnum'. $cust_pkg->locationnum
3111 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3112
3113       $taxlisthash->{ $taxname } ||= [ $tax ];
3114       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
3115
3116       $localtaxlisthash{ $taxname } ||= [ $tax ];
3117       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
3118
3119     }
3120
3121     warn "finding taxed taxes...\n" if $DEBUG > 2;
3122     foreach my $tax ( keys %localtaxlisthash ) {
3123       my $tax_object = shift @{ $localtaxlisthash{$tax} };
3124       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3125         if $DEBUG > 2;
3126       next unless $tax_object->can('tax_on_tax');
3127
3128       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3129         my $totname = ref( $tot ). ' '. $tot->taxnum;
3130
3131         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3132           if $DEBUG > 2;
3133         next unless exists( $localtaxlisthash{ $totname } ); # only increase
3134                                                              # existing taxes
3135         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3136         my $hashref_or_error =
3137           $tax_object->taxline( $localtaxlisthash{$tax},
3138                                 'custnum'      => $self->custnum,
3139                                 'invoice_time' => $invoice_time,
3140                               );
3141         return $hashref_or_error
3142           unless ref($hashref_or_error);
3143
3144         $taxlisthash->{ $totname } ||= [ $tot ];
3145         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
3146
3147       }
3148     }
3149
3150   }
3151
3152   '';
3153 }
3154
3155 sub _gather_taxes {
3156   my $self = shift;
3157   my $part_pkg = shift;
3158   my $class = shift;
3159
3160   my @taxes = ();
3161   my $geocode = $self->geocode('cch');
3162
3163   my @taxclassnums = map { $_->taxclassnum }
3164                      $part_pkg->part_pkg_taxoverride($class);
3165
3166   unless (@taxclassnums) {
3167     @taxclassnums = map { $_->taxclassnum }
3168                     grep { $_->taxable eq 'Y' }
3169                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3170   }
3171   warn "Found taxclassnum values of ". join(',', @taxclassnums)
3172     if $DEBUG;
3173
3174   my $extra_sql =
3175     "AND (".
3176     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3177
3178   @taxes = qsearch({ 'table' => 'tax_rate',
3179                      'hashref' => { 'geocode' => $geocode, },
3180                      'extra_sql' => $extra_sql,
3181                   })
3182     if scalar(@taxclassnums);
3183
3184   warn "Found taxes ".
3185        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3186    if $DEBUG;
3187
3188   [ @taxes ];
3189
3190 }
3191
3192 =item collect OPTIONS
3193
3194 (Attempt to) collect money for this customer's outstanding invoices (see
3195 L<FS::cust_bill>).  Usually used after the bill method.
3196
3197 Actions are now triggered by billing events; see L<FS::part_event> and the
3198 billing events web interface.  Old-style invoice events (see
3199 L<FS::part_bill_event>) have been deprecated.
3200
3201 If there is an error, returns the error, otherwise returns false.
3202
3203 Options are passed as name-value pairs.
3204
3205 Currently available options are:
3206
3207 =over 4
3208
3209 =item invoice_time
3210
3211 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.
3212
3213 =item retry
3214
3215 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3216
3217 =item quiet
3218
3219 set true to surpress email card/ACH decline notices.
3220
3221 =item check_freq
3222
3223 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3224
3225 =item payby
3226
3227 allows for one time override of normal customer billing method
3228
3229 =item debug
3230
3231 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)
3232
3233
3234 =back
3235
3236 =cut
3237
3238 sub collect {
3239   my( $self, %options ) = @_;
3240   my $invoice_time = $options{'invoice_time'} || time;
3241
3242   #put below somehow?
3243   local $SIG{HUP} = 'IGNORE';
3244   local $SIG{INT} = 'IGNORE';
3245   local $SIG{QUIT} = 'IGNORE';
3246   local $SIG{TERM} = 'IGNORE';
3247   local $SIG{TSTP} = 'IGNORE';
3248   local $SIG{PIPE} = 'IGNORE';
3249
3250   my $oldAutoCommit = $FS::UID::AutoCommit;
3251   local $FS::UID::AutoCommit = 0;
3252   my $dbh = dbh;
3253
3254   $self->select_for_update; #mutex
3255
3256   if ( $DEBUG ) {
3257     my $balance = $self->balance;
3258     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3259   }
3260
3261   if ( exists($options{'retry_card'}) ) {
3262     carp 'retry_card option passed to collect is deprecated; use retry';
3263     $options{'retry'} ||= $options{'retry_card'};
3264   }
3265   if ( exists($options{'retry'}) && $options{'retry'} ) {
3266     my $error = $self->retry_realtime;
3267     if ( $error ) {
3268       $dbh->rollback if $oldAutoCommit;
3269       return $error;
3270     }
3271   }
3272
3273   # false laziness w/pay_batch::import_results
3274
3275   my $due_cust_event = $self->due_cust_event(
3276     'debug'      => ( $options{'debug'} || 0 ),
3277     'time'       => $invoice_time,
3278     'check_freq' => $options{'check_freq'},
3279   );
3280   unless( ref($due_cust_event) ) {
3281     $dbh->rollback if $oldAutoCommit;
3282     return $due_cust_event;
3283   }
3284
3285   foreach my $cust_event ( @$due_cust_event ) {
3286
3287     #XXX lock event
3288
3289     #re-eval event conditions (a previous event could have changed things)
3290     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
3291       #don't leave stray "new/locked" records around
3292       my $error = $cust_event->delete;
3293       if ( $error ) {
3294         #gah, even with transactions
3295         $dbh->commit if $oldAutoCommit; #well.
3296         return $error;
3297       }
3298       next;
3299     }
3300
3301     {
3302       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
3303       warn "  running cust_event ". $cust_event->eventnum. "\n"
3304         if $DEBUG > 1;
3305
3306
3307       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
3308       if ( my $error = $cust_event->do_event() ) {
3309         #XXX wtf is this?  figure out a proper dealio with return value
3310         #from do_event
3311           # gah, even with transactions.
3312           $dbh->commit if $oldAutoCommit; #well.
3313           return $error;
3314         }
3315     }
3316
3317   }
3318
3319   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3320   '';
3321
3322 }
3323
3324 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
3325
3326 Inserts database records for and returns an ordered listref of new events due
3327 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
3328 events are due, an empty listref is returned.  If there is an error, returns a
3329 scalar error message.
3330
3331 To actually run the events, call each event's test_condition method, and if
3332 still true, call the event's do_event method.
3333
3334 Options are passed as a hashref or as a list of name-value pairs.  Available
3335 options are:
3336
3337 =over 4
3338
3339 =item check_freq
3340
3341 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.
3342
3343 =item time
3344
3345 "Current time" for the events.
3346
3347 =item debug
3348
3349 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)
3350
3351 =item eventtable
3352
3353 Only return events for the specified eventtable (by default, events of all eventtables are returned)
3354
3355 =item objects
3356
3357 Explicitly pass the objects to be tested (typically used with eventtable).
3358
3359 =item testonly
3360
3361 Set to true to return the objects, but not actually insert them into the
3362 database.
3363
3364 =back
3365
3366 =cut
3367
3368 sub due_cust_event {
3369   my $self = shift;
3370   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
3371
3372   #???
3373   #my $DEBUG = $opt{'debug'}
3374   local($DEBUG) = $opt{'debug'}
3375     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
3376
3377   warn "$me due_cust_event called with options ".
3378        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
3379     if $DEBUG;
3380
3381   $opt{'time'} ||= time;
3382
3383   local $SIG{HUP} = 'IGNORE';
3384   local $SIG{INT} = 'IGNORE';
3385   local $SIG{QUIT} = 'IGNORE';
3386   local $SIG{TERM} = 'IGNORE';
3387   local $SIG{TSTP} = 'IGNORE';
3388   local $SIG{PIPE} = 'IGNORE';
3389
3390   my $oldAutoCommit = $FS::UID::AutoCommit;
3391   local $FS::UID::AutoCommit = 0;
3392   my $dbh = dbh;
3393
3394   $self->select_for_update #mutex
3395     unless $opt{testonly};
3396
3397   ###
3398   # 1: find possible events (initial search)
3399   ###
3400
3401   my @cust_event = ();
3402
3403   my @eventtable = $opt{'eventtable'}
3404                      ? ( $opt{'eventtable'} )
3405                      : FS::part_event->eventtables_runorder;
3406
3407   foreach my $eventtable ( @eventtable ) {
3408
3409     my @objects;
3410     if ( $opt{'objects'} ) {
3411
3412       @objects = @{ $opt{'objects'} };
3413
3414     } else {
3415
3416       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
3417       @objects = ( $eventtable eq 'cust_main' )
3418                    ? ( $self )
3419                    : ( $self->$eventtable() );
3420
3421     }
3422
3423     my @e_cust_event = ();
3424
3425     my $cross = "CROSS JOIN $eventtable";
3426     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
3427       unless $eventtable eq 'cust_main';
3428
3429     foreach my $object ( @objects ) {
3430
3431       #this first search uses the condition_sql magic for optimization.
3432       #the more possible events we can eliminate in this step the better
3433
3434       my $cross_where = '';
3435       my $pkey = $object->primary_key;
3436       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
3437
3438       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
3439       my $extra_sql =
3440         FS::part_event_condition->where_conditions_sql( $eventtable,
3441                                                         'time'=>$opt{'time'}
3442                                                       );
3443       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
3444
3445       $extra_sql = "AND $extra_sql" if $extra_sql;
3446
3447       #here is the agent virtualization
3448       $extra_sql .= " AND (    part_event.agentnum IS NULL
3449                             OR part_event.agentnum = ". $self->agentnum. ' )';
3450
3451       $extra_sql .= " $order";
3452
3453       warn "searching for events for $eventtable ". $object->$pkey. "\n"
3454         if $opt{'debug'} > 2;
3455       my @part_event = qsearch( {
3456         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
3457         'select'    => 'part_event.*',
3458         'table'     => 'part_event',
3459         'addl_from' => "$cross $join",
3460         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
3461                          'eventtable' => $eventtable,
3462                          'disabled'   => '',
3463                        },
3464         'extra_sql' => "AND $cross_where $extra_sql",
3465       } );
3466
3467       if ( $DEBUG > 2 ) {
3468         my $pkey = $object->primary_key;
3469         warn "      ". scalar(@part_event).
3470              " possible events found for $eventtable ". $object->$pkey(). "\n";
3471       }
3472
3473       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
3474
3475     }
3476
3477     warn "    ". scalar(@e_cust_event).
3478          " subtotal possible cust events found for $eventtable\n"
3479       if $DEBUG > 1;
3480
3481     push @cust_event, @e_cust_event;
3482
3483   }
3484
3485   warn "  ". scalar(@cust_event).
3486        " total possible cust events found in initial search\n"
3487     if $DEBUG; # > 1;
3488
3489   ##
3490   # 2: test conditions
3491   ##
3492
3493   my %unsat = ();
3494
3495   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
3496                                           'stats_hashref' => \%unsat ),
3497                      @cust_event;
3498
3499   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
3500     if $DEBUG; # > 1;
3501
3502   warn "    invalid conditions not eliminated with condition_sql:\n".
3503        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
3504     if $DEBUG; # > 1;
3505
3506   ##
3507   # 3: insert
3508   ##
3509
3510   unless( $opt{testonly} ) {
3511     foreach my $cust_event ( @cust_event ) {
3512
3513       my $error = $cust_event->insert();
3514       if ( $error ) {
3515         $dbh->rollback if $oldAutoCommit;
3516         return $error;
3517       }
3518
3519     }
3520   }
3521
3522   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3523
3524   ##
3525   # 4: return
3526   ##
3527
3528   warn "  returning events: ". Dumper(@cust_event). "\n"
3529     if $DEBUG > 2;
3530
3531   \@cust_event;
3532
3533 }
3534
3535 =item retry_realtime
3536
3537 Schedules realtime / batch  credit card / electronic check / LEC billing
3538 events for for retry.  Useful if card information has changed or manual
3539 retry is desired.  The 'collect' method must be called to actually retry
3540 the transaction.
3541
3542 Implementation details: For either this customer, or for each of this
3543 customer's open invoices, changes the status of the first "done" (with
3544 statustext error) realtime processing event to "failed".
3545
3546 =cut
3547
3548 sub retry_realtime {
3549   my $self = shift;
3550
3551   local $SIG{HUP} = 'IGNORE';
3552   local $SIG{INT} = 'IGNORE';
3553   local $SIG{QUIT} = 'IGNORE';
3554   local $SIG{TERM} = 'IGNORE';
3555   local $SIG{TSTP} = 'IGNORE';
3556   local $SIG{PIPE} = 'IGNORE';
3557
3558   my $oldAutoCommit = $FS::UID::AutoCommit;
3559   local $FS::UID::AutoCommit = 0;
3560   my $dbh = dbh;
3561
3562   #a little false laziness w/due_cust_event (not too bad, really)
3563
3564   my $join = FS::part_event_condition->join_conditions_sql;
3565   my $order = FS::part_event_condition->order_conditions_sql;
3566   my $mine =
3567   '( '
3568    . join ( ' OR ' , map {
3569     "( part_event.eventtable = " . dbh->quote($_)
3570     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3571    } FS::part_event->eventtables)
3572    . ') ';
3573
3574   #here is the agent virtualization
3575   my $agent_virt = " (    part_event.agentnum IS NULL
3576                        OR part_event.agentnum = ". $self->agentnum. ' )';
3577
3578   #XXX this shouldn't be hardcoded, actions should declare it...
3579   my @realtime_events = qw(
3580     cust_bill_realtime_card
3581     cust_bill_realtime_check
3582     cust_bill_realtime_lec
3583     cust_bill_batch
3584   );
3585
3586   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3587                                                   @realtime_events
3588                                      ).
3589                           ' ) ';
3590
3591   my @cust_event = qsearchs({
3592     'table'     => 'cust_event',
3593     'select'    => 'cust_event.*',
3594     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3595     'hashref'   => { 'status' => 'done' },
3596     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3597                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3598   });
3599
3600   my %seen_invnum = ();
3601   foreach my $cust_event (@cust_event) {
3602
3603     #max one for the customer, one for each open invoice
3604     my $cust_X = $cust_event->cust_X;
3605     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3606                           ? $cust_X->invnum
3607                           : 0
3608                         }++
3609          or $cust_event->part_event->eventtable eq 'cust_bill'
3610             && ! $cust_X->owed;
3611
3612     my $error = $cust_event->retry;
3613     if ( $error ) {
3614       $dbh->rollback if $oldAutoCommit;
3615       return "error scheduling event for retry: $error";
3616     }
3617
3618   }
3619
3620   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3621   '';
3622
3623 }
3624
3625 # some horrid false laziness here to avoid refactor fallout
3626 # eventually realtime realtime_bop and realtime_refund_bop should go
3627 # away and be replaced by _new_realtime_bop and _new_realtime_refund_bop
3628
3629 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3630
3631 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3632 via a Business::OnlinePayment realtime gateway.  See
3633 L<http://420.am/business-onlinepayment> for supported gateways.
3634
3635 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3636
3637 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3638
3639 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3640 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3641 if set, will override the value from the customer record.
3642
3643 I<description> is a free-text field passed to the gateway.  It defaults to
3644 "Internet services".
3645
3646 If an I<invnum> is specified, this payment (if successful) is applied to the
3647 specified invoice.  If you don't specify an I<invnum> you might want to
3648 call the B<apply_payments> method.
3649
3650 I<quiet> can be set true to surpress email decline notices.
3651
3652 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3653 resulting paynum, if any.
3654
3655 I<payunique> is a unique identifier for this payment.
3656
3657 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3658
3659 =cut
3660
3661 sub realtime_bop {
3662   my $self = shift;
3663
3664   return $self->_new_realtime_bop(@_)
3665     if $self->_new_bop_required();
3666
3667   my( $method, $amount, %options ) = @_;
3668   if ( $DEBUG ) {
3669     warn "$me realtime_bop: $method $amount\n";
3670     warn "  $_ => $options{$_}\n" foreach keys %options;
3671   }
3672
3673   $options{'description'} ||= 'Internet services';
3674
3675   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3676
3677   eval "use Business::OnlinePayment";
3678   die $@ if $@;
3679
3680   my $payinfo = exists($options{'payinfo'})
3681                   ? $options{'payinfo'}
3682                   : $self->payinfo;
3683
3684   my %method2payby = (
3685     'CC'     => 'CARD',
3686     'ECHECK' => 'CHEK',
3687     'LEC'    => 'LECB',
3688   );
3689
3690   ###
3691   # check for banned credit card/ACH
3692   ###
3693
3694   my $ban = qsearchs('banned_pay', {
3695     'payby'   => $method2payby{$method},
3696     'payinfo' => md5_base64($payinfo),
3697   } );
3698   return "Banned credit card" if $ban;
3699
3700   ###
3701   # set taxclass and trans_is_recur based on invnum if there is one
3702   ###
3703
3704   my $taxclass = '';
3705   my $trans_is_recur = 0;
3706   if ( $options{'invnum'} ) {
3707
3708     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3709     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3710
3711     my @part_pkg =
3712       map  { $_->part_pkg }
3713       grep { $_ }
3714       map  { $_->cust_pkg }
3715       $cust_bill->cust_bill_pkg;
3716
3717     my @taxclasses = map $_->taxclass, @part_pkg;
3718     $taxclass = $taxclasses[0]
3719       unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3720                                                         #different taxclasses
3721     $trans_is_recur = 1
3722       if grep { $_->freq ne '0' } @part_pkg;
3723
3724   }
3725
3726   ###
3727   # select a gateway
3728   ###
3729
3730   #look for an agent gateway override first
3731   my $cardtype;
3732   if ( $method eq 'CC' ) {
3733     $cardtype = cardtype($payinfo);
3734   } elsif ( $method eq 'ECHECK' ) {
3735     $cardtype = 'ACH';
3736   } else {
3737     $cardtype = $method;
3738   }
3739
3740   my $override =
3741        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3742                                            cardtype => $cardtype,
3743                                            taxclass => $taxclass,       } )
3744     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3745                                            cardtype => '',
3746                                            taxclass => $taxclass,       } )
3747     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3748                                            cardtype => $cardtype,
3749                                            taxclass => '',              } )
3750     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3751                                            cardtype => '',
3752                                            taxclass => '',              } );
3753
3754   my $payment_gateway = '';
3755   my( $processor, $login, $password, $action, @bop_options );
3756   if ( $override ) { #use a payment gateway override
3757
3758     $payment_gateway = $override->payment_gateway;
3759
3760     $processor   = $payment_gateway->gateway_module;
3761     $login       = $payment_gateway->gateway_username;
3762     $password    = $payment_gateway->gateway_password;
3763     $action      = $payment_gateway->gateway_action;
3764     @bop_options = $payment_gateway->options;
3765
3766   } else { #use the standard settings from the config
3767
3768     ( $processor, $login, $password, $action, @bop_options ) =
3769       $self->default_payment_gateway($method);
3770
3771   }
3772
3773   ###
3774   # massage data
3775   ###
3776
3777   my $address = exists($options{'address1'})
3778                     ? $options{'address1'}
3779                     : $self->address1;
3780   my $address2 = exists($options{'address2'})
3781                     ? $options{'address2'}
3782                     : $self->address2;
3783   $address .= ", ". $address2 if length($address2);
3784
3785   my $o_payname = exists($options{'payname'})
3786                     ? $options{'payname'}
3787                     : $self->payname;
3788   my($payname, $payfirst, $paylast);
3789   if ( $o_payname && $method ne 'ECHECK' ) {
3790     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3791       or return "Illegal payname $payname";
3792     ($payfirst, $paylast) = ($1, $2);
3793   } else {
3794     $payfirst = $self->getfield('first');
3795     $paylast = $self->getfield('last');
3796     $payname =  "$payfirst $paylast";
3797   }
3798
3799   my @invoicing_list = $self->invoicing_list_emailonly;
3800   if ( $conf->exists('emailinvoiceautoalways')
3801        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3802        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3803     push @invoicing_list, $self->all_emails;
3804   }
3805
3806   my $email = ($conf->exists('business-onlinepayment-email-override'))
3807               ? $conf->config('business-onlinepayment-email-override')
3808               : $invoicing_list[0];
3809
3810   my %content = ();
3811
3812   my $payip = exists($options{'payip'})
3813                 ? $options{'payip'}
3814                 : $self->payip;
3815   $content{customer_ip} = $payip
3816     if length($payip);
3817
3818   $content{invoice_number} = $options{'invnum'}
3819     if exists($options{'invnum'}) && length($options{'invnum'});
3820
3821   $content{email_customer} =
3822     (    $conf->exists('business-onlinepayment-email_customer')
3823       || $conf->exists('business-onlinepayment-email-override') );
3824
3825   my $paydate = '';
3826   if ( $method eq 'CC' ) {
3827
3828     $content{card_number} = $payinfo;
3829     $paydate = exists($options{'paydate'})
3830                     ? $options{'paydate'}
3831                     : $self->paydate;
3832     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3833     $content{expiration} = "$2/$1";
3834
3835     my $paycvv = exists($options{'paycvv'})
3836                    ? $options{'paycvv'}
3837                    : $self->paycvv;
3838     $content{cvv2} = $paycvv
3839       if length($paycvv);
3840
3841     my $paystart_month = exists($options{'paystart_month'})
3842                            ? $options{'paystart_month'}
3843                            : $self->paystart_month;
3844
3845     my $paystart_year  = exists($options{'paystart_year'})
3846                            ? $options{'paystart_year'}
3847                            : $self->paystart_year;
3848
3849     $content{card_start} = "$paystart_month/$paystart_year"
3850       if $paystart_month && $paystart_year;
3851
3852     my $payissue       = exists($options{'payissue'})
3853                            ? $options{'payissue'}
3854                            : $self->payissue;
3855     $content{issue_number} = $payissue if $payissue;
3856
3857     if ( $self->_bop_recurring_billing( 'payinfo'        => $payinfo,
3858                                         'trans_is_recur' => $trans_is_recur,
3859                                       )
3860        )
3861     {
3862       $content{recurring_billing} = 'YES';
3863       $content{acct_code} = 'rebill'
3864         if $conf->exists('credit_card-recurring_billing_acct_code');
3865     }
3866
3867   } elsif ( $method eq 'ECHECK' ) {
3868     ( $content{account_number}, $content{routing_code} ) =
3869       split('@', $payinfo);
3870     $content{bank_name} = $o_payname;
3871     $content{bank_state} = exists($options{'paystate'})
3872                              ? $options{'paystate'}
3873                              : $self->getfield('paystate');
3874     $content{account_type} = exists($options{'paytype'})
3875                                ? uc($options{'paytype'}) || 'CHECKING'
3876                                : uc($self->getfield('paytype')) || 'CHECKING';
3877     $content{account_name} = $payname;
3878     $content{customer_org} = $self->company ? 'B' : 'I';
3879     $content{state_id}       = exists($options{'stateid'})
3880                                  ? $options{'stateid'}
3881                                  : $self->getfield('stateid');
3882     $content{state_id_state} = exists($options{'stateid_state'})
3883                                  ? $options{'stateid_state'}
3884                                  : $self->getfield('stateid_state');
3885     $content{customer_ssn} = exists($options{'ss'})
3886                                ? $options{'ss'}
3887                                : $self->ss;
3888   } elsif ( $method eq 'LEC' ) {
3889     $content{phone} = $payinfo;
3890   }
3891
3892   ###
3893   # run transaction(s)
3894   ###
3895
3896   my $balance = exists( $options{'balance'} )
3897                   ? $options{'balance'}
3898                   : $self->balance;
3899
3900   $self->select_for_update; #mutex ... just until we get our pending record in
3901
3902   #the checks here are intended to catch concurrent payments
3903   #double-form-submission prevention is taken care of in cust_pay_pending::check
3904
3905   #check the balance
3906   return "The customer's balance has changed; $method transaction aborted."
3907     if $self->balance < $balance;
3908     #&& $self->balance < $amount; #might as well anyway?
3909
3910   #also check and make sure there aren't *other* pending payments for this cust
3911
3912   my @pending = qsearch('cust_pay_pending', {
3913     'custnum' => $self->custnum,
3914     'status'  => { op=>'!=', value=>'done' }
3915   });
3916   return "A payment is already being processed for this customer (".
3917          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3918          "); $method transaction aborted."
3919     if scalar(@pending);
3920
3921   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3922
3923   my $cust_pay_pending = new FS::cust_pay_pending {
3924     'custnum'           => $self->custnum,
3925     #'invnum'            => $options{'invnum'},
3926     'paid'              => $amount,
3927     '_date'             => '',
3928     'payby'             => $method2payby{$method},
3929     'payinfo'           => $payinfo,
3930     'paydate'           => $paydate,
3931     'recurring_billing' => $content{recurring_billing},
3932     'status'            => 'new',
3933     'gatewaynum'        => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3934   };
3935   $cust_pay_pending->payunique( $options{payunique} )
3936     if defined($options{payunique}) && length($options{payunique});
3937   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3938   return $cpp_new_err if $cpp_new_err;
3939
3940   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3941
3942   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3943   $transaction->content(
3944     'type'           => $method,
3945     'login'          => $login,
3946     'password'       => $password,
3947     'action'         => $action1,
3948     'description'    => $options{'description'},
3949     'amount'         => $amount,
3950     #'invoice_number' => $options{'invnum'},
3951     'customer_id'    => $self->custnum,
3952     'last_name'      => $paylast,
3953     'first_name'     => $payfirst,
3954     'name'           => $payname,
3955     'address'        => $address,
3956     'city'           => ( exists($options{'city'})
3957                             ? $options{'city'}
3958                             : $self->city          ),
3959     'state'          => ( exists($options{'state'})
3960                             ? $options{'state'}
3961                             : $self->state          ),
3962     'zip'            => ( exists($options{'zip'})
3963                             ? $options{'zip'}
3964                             : $self->zip          ),
3965     'country'        => ( exists($options{'country'})
3966                             ? $options{'country'}
3967                             : $self->country          ),
3968     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
3969     'email'          => $email,
3970     'phone'          => $self->daytime || $self->night,
3971     %content, #after
3972   );
3973
3974   $cust_pay_pending->status('pending');
3975   my $cpp_pending_err = $cust_pay_pending->replace;
3976   return $cpp_pending_err if $cpp_pending_err;
3977
3978   #config?
3979   my $BOP_TESTING = 0;
3980   my $BOP_TESTING_SUCCESS = 1;
3981
3982   unless ( $BOP_TESTING ) {
3983     $transaction->submit();
3984   } else {
3985     if ( $BOP_TESTING_SUCCESS ) {
3986       $transaction->is_success(1);
3987       $transaction->authorization('fake auth');
3988     } else {
3989       $transaction->is_success(0);
3990       $transaction->error_message('fake failure');
3991     }
3992   }
3993
3994   if ( $transaction->is_success() && $action2 ) {
3995
3996     $cust_pay_pending->status('authorized');
3997     my $cpp_authorized_err = $cust_pay_pending->replace;
3998     return $cpp_authorized_err if $cpp_authorized_err;
3999
4000     my $auth = $transaction->authorization;
4001     my $ordernum = $transaction->can('order_number')
4002                    ? $transaction->order_number
4003                    : '';
4004
4005     my $capture =
4006       new Business::OnlinePayment( $processor, @bop_options );
4007
4008     my %capture = (
4009       %content,
4010       type           => $method,
4011       action         => $action2,
4012       login          => $login,
4013       password       => $password,
4014       order_number   => $ordernum,
4015       amount         => $amount,
4016       authorization  => $auth,
4017       description    => $options{'description'},
4018     );
4019
4020     foreach my $field (qw( authorization_source_code returned_ACI
4021                            transaction_identifier validation_code
4022                            transaction_sequence_num local_transaction_date
4023                            local_transaction_time AVS_result_code          )) {
4024       $capture{$field} = $transaction->$field() if $transaction->can($field);
4025     }
4026
4027     $capture->content( %capture );
4028
4029     $capture->submit();
4030
4031     unless ( $capture->is_success ) {
4032       my $e = "Authorization successful but capture failed, custnum #".
4033               $self->custnum. ': '.  $capture->result_code.
4034               ": ". $capture->error_message;
4035       warn $e;
4036       return $e;
4037     }
4038
4039   }
4040
4041   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4042   my $cpp_captured_err = $cust_pay_pending->replace;
4043   return $cpp_captured_err if $cpp_captured_err;
4044
4045   ###
4046   # remove paycvv after initial transaction
4047   ###
4048
4049   #false laziness w/misc/process/payment.cgi - check both to make sure working
4050   # correctly
4051   if ( defined $self->dbdef_table->column('paycvv')
4052        && length($self->paycvv)
4053        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4054   ) {
4055     my $error = $self->remove_cvv;
4056     if ( $error ) {
4057       warn "WARNING: error removing cvv: $error\n";
4058     }
4059   }
4060
4061   ###
4062   # result handling
4063   ###
4064
4065   if ( $transaction->is_success() ) {
4066
4067     my $paybatch = '';
4068     if ( $payment_gateway ) { # agent override
4069       $paybatch = $payment_gateway->gatewaynum. '-';
4070     }
4071
4072     $paybatch .= "$processor:". $transaction->authorization;
4073
4074     $paybatch .= ':'. $transaction->order_number
4075       if $transaction->can('order_number')
4076       && length($transaction->order_number);
4077
4078     my $cust_pay = new FS::cust_pay ( {
4079        'custnum'  => $self->custnum,
4080        'invnum'   => $options{'invnum'},
4081        'paid'     => $amount,
4082        '_date'    => '',
4083        'payby'    => $method2payby{$method},
4084        'payinfo'  => $payinfo,
4085        'paybatch' => $paybatch,
4086        'paydate'  => $paydate,
4087     } );
4088     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4089     $cust_pay->payunique( $options{payunique} )
4090       if defined($options{payunique}) && length($options{payunique});
4091
4092     my $oldAutoCommit = $FS::UID::AutoCommit;
4093     local $FS::UID::AutoCommit = 0;
4094     my $dbh = dbh;
4095
4096     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4097
4098     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4099
4100     if ( $error ) {
4101       $cust_pay->invnum(''); #try again with no specific invnum
4102       my $error2 = $cust_pay->insert( $options{'manual'} ?
4103                                       ( 'manual' => 1 ) : ()
4104                                     );
4105       if ( $error2 ) {
4106         # gah.  but at least we have a record of the state we had to abort in
4107         # from cust_pay_pending now.
4108         my $e = "WARNING: $method captured but payment not recorded - ".
4109                 "error inserting payment ($processor): $error2".
4110                 " (previously tried insert with invnum #$options{'invnum'}" .
4111                 ": $error ) - pending payment saved as paypendingnum ".
4112                 $cust_pay_pending->paypendingnum. "\n";
4113         warn $e;
4114         return $e;
4115       }
4116     }
4117
4118     if ( $options{'paynum_ref'} ) {
4119       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4120     }
4121
4122     $cust_pay_pending->status('done');
4123     $cust_pay_pending->statustext('captured');
4124     $cust_pay_pending->paynum($cust_pay->paynum);
4125     my $cpp_done_err = $cust_pay_pending->replace;
4126
4127     if ( $cpp_done_err ) {
4128
4129       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4130       my $e = "WARNING: $method captured but payment not recorded - ".
4131               "error updating status for paypendingnum ".
4132               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4133       warn $e;
4134       return $e;
4135
4136     } else {
4137
4138       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4139       return ''; #no error
4140
4141     }
4142
4143   } else {
4144
4145     my $perror = "$processor error: ". $transaction->error_message;
4146
4147     unless ( $transaction->error_message ) {
4148
4149       my $t_response;
4150       if ( $transaction->can('response_page') ) {
4151         $t_response = {
4152                         'page'    => ( $transaction->can('response_page')
4153                                          ? $transaction->response_page
4154                                          : ''
4155                                      ),
4156                         'code'    => ( $transaction->can('response_code')
4157                                          ? $transaction->response_code
4158                                          : ''
4159                                      ),
4160                         'headers' => ( $transaction->can('response_headers')
4161                                          ? $transaction->response_headers
4162                                          : ''
4163                                      ),
4164                       };
4165       } else {
4166         $t_response .=
4167           "No additional debugging information available for $processor";
4168       }
4169
4170       $perror .= "No error_message returned from $processor -- ".
4171                  ( ref($t_response) ? Dumper($t_response) : $t_response );
4172
4173     }
4174
4175     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4176          && $conf->exists('emaildecline')
4177          && grep { $_ ne 'POST' } $self->invoicing_list
4178          && ! grep { $transaction->error_message =~ /$_/ }
4179                    $conf->config('emaildecline-exclude')
4180     ) {
4181       my @templ = $conf->config('declinetemplate');
4182       my $template = new Text::Template (
4183         TYPE   => 'ARRAY',
4184         SOURCE => [ map "$_\n", @templ ],
4185       ) or return "($perror) can't create template: $Text::Template::ERROR";
4186       $template->compile()
4187         or return "($perror) can't compile template: $Text::Template::ERROR";
4188
4189       my $templ_hash = { error => $transaction->error_message };
4190
4191       my $error = send_email(
4192         'from'    => $conf->config('invoice_from', $self->agentnum ),
4193         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4194         'subject' => 'Your payment could not be processed',
4195         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
4196       );
4197
4198       $perror .= " (also received error sending decline notification: $error)"
4199         if $error;
4200
4201     }
4202
4203     $cust_pay_pending->status('done');
4204     $cust_pay_pending->statustext("declined: $perror");
4205     my $cpp_done_err = $cust_pay_pending->replace;
4206     if ( $cpp_done_err ) {
4207       my $e = "WARNING: $method declined but pending payment not resolved - ".
4208               "error updating status for paypendingnum ".
4209               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4210       warn $e;
4211       $perror = "$e ($perror)";
4212     }
4213
4214     return $perror;
4215   }
4216
4217 }
4218
4219 sub _bop_recurring_billing {
4220   my( $self, %opt ) = @_;
4221
4222   my $method = $conf->config('credit_card-recurring_billing_flag');
4223
4224   if ( $method eq 'transaction_is_recur' ) {
4225
4226     return 1 if $opt{'trans_is_recur'};
4227
4228   } else {
4229
4230     my %hash = ( 'custnum' => $self->custnum,
4231                  'payby'   => 'CARD',
4232                );
4233
4234     return 1
4235       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4236       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4237                                                                $opt{'payinfo'} )
4238                              } );
4239
4240   }
4241
4242   return 0;
4243
4244 }
4245
4246
4247 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4248
4249 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4250 via a Business::OnlinePayment realtime gateway.  See
4251 L<http://420.am/business-onlinepayment> for supported gateways.
4252
4253 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4254
4255 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4256
4257 Most gateways require a reference to an original payment transaction to refund,
4258 so you probably need to specify a I<paynum>.
4259
4260 I<amount> defaults to the original amount of the payment if not specified.
4261
4262 I<reason> specifies a reason for the refund.
4263
4264 I<paydate> specifies the expiration date for a credit card overriding the
4265 value from the customer record or the payment record. Specified as yyyy-mm-dd
4266
4267 Implementation note: If I<amount> is unspecified or equal to the amount of the
4268 orignal payment, first an attempt is made to "void" the transaction via
4269 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4270 the normal attempt is made to "refund" ("credit") the transaction via the
4271 gateway is attempted.
4272
4273 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4274 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4275 #if set, will override the value from the customer record.
4276
4277 #If an I<invnum> is specified, this payment (if successful) is applied to the
4278 #specified invoice.  If you don't specify an I<invnum> you might want to
4279 #call the B<apply_payments> method.
4280
4281 =cut
4282
4283 #some false laziness w/realtime_bop, not enough to make it worth merging
4284 #but some useful small subs should be pulled out
4285 sub realtime_refund_bop {
4286   my $self = shift;
4287
4288   return $self->_new_realtime_refund_bop(@_)
4289     if $self->_new_bop_required();
4290
4291   my( $method, %options ) = @_;
4292   if ( $DEBUG ) {
4293     warn "$me realtime_refund_bop: $method refund\n";
4294     warn "  $_ => $options{$_}\n" foreach keys %options;
4295   }
4296
4297   eval "use Business::OnlinePayment";
4298   die $@ if $@;
4299
4300   ###
4301   # look up the original payment and optionally a gateway for that payment
4302   ###
4303
4304   my $cust_pay = '';
4305   my $amount = $options{'amount'};
4306
4307   my( $processor, $login, $password, @bop_options ) ;
4308   my( $auth, $order_number ) = ( '', '', '' );
4309
4310   if ( $options{'paynum'} ) {
4311
4312     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
4313     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4314       or return "Unknown paynum $options{'paynum'}";
4315     $amount ||= $cust_pay->paid;
4316
4317     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4318       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4319                 $cust_pay->paybatch;
4320     my $gatewaynum = '';
4321     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4322
4323     if ( $gatewaynum ) { #gateway for the payment to be refunded
4324
4325       my $payment_gateway =
4326         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4327       die "payment gateway $gatewaynum not found"
4328         unless $payment_gateway;
4329
4330       $processor   = $payment_gateway->gateway_module;
4331       $login       = $payment_gateway->gateway_username;
4332       $password    = $payment_gateway->gateway_password;
4333       @bop_options = $payment_gateway->options;
4334
4335     } else { #try the default gateway
4336
4337       my( $conf_processor, $unused_action );
4338       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4339         $self->default_payment_gateway($method);
4340
4341       return "processor of payment $options{'paynum'} $processor does not".
4342              " match default processor $conf_processor"
4343         unless $processor eq $conf_processor;
4344
4345     }
4346
4347
4348   } else { # didn't specify a paynum, so look for agent gateway overrides
4349            # like a normal transaction
4350
4351     my $cardtype;
4352     if ( $method eq 'CC' ) {
4353       $cardtype = cardtype($self->payinfo);
4354     } elsif ( $method eq 'ECHECK' ) {
4355       $cardtype = 'ACH';
4356     } else {
4357       $cardtype = $method;
4358     }
4359     my $override =
4360            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4361                                                cardtype => $cardtype,
4362                                                taxclass => '',              } )
4363         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4364                                                cardtype => '',
4365                                                taxclass => '',              } );
4366
4367     if ( $override ) { #use a payment gateway override
4368
4369       my $payment_gateway = $override->payment_gateway;
4370
4371       $processor   = $payment_gateway->gateway_module;
4372       $login       = $payment_gateway->gateway_username;
4373       $password    = $payment_gateway->gateway_password;
4374       #$action      = $payment_gateway->gateway_action;
4375       @bop_options = $payment_gateway->options;
4376
4377     } else { #use the standard settings from the config
4378
4379       my $unused_action;
4380       ( $processor, $login, $password, $unused_action, @bop_options ) =
4381         $self->default_payment_gateway($method);
4382
4383     }
4384
4385   }
4386   return "neither amount nor paynum specified" unless $amount;
4387
4388   my %content = (
4389     'type'           => $method,
4390     'login'          => $login,
4391     'password'       => $password,
4392     'order_number'   => $order_number,
4393     'amount'         => $amount,
4394     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4395   );
4396   $content{authorization} = $auth
4397     if length($auth); #echeck/ACH transactions have an order # but no auth
4398                       #(at least with authorize.net)
4399
4400   my $disable_void_after;
4401   if ($conf->exists('disable_void_after')
4402       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4403     $disable_void_after = $1;
4404   }
4405
4406   #first try void if applicable
4407   if ( $cust_pay && $cust_pay->paid == $amount
4408     && (
4409       ( not defined($disable_void_after) )
4410       || ( time < ($cust_pay->_date + $disable_void_after ) )
4411     )
4412   ) {
4413     warn "  attempting void\n" if $DEBUG > 1;
4414     my $void = new Business::OnlinePayment( $processor, @bop_options );
4415     $void->content( 'action' => 'void', %content );
4416     $void->submit();
4417     if ( $void->is_success ) {
4418       my $error = $cust_pay->void($options{'reason'});
4419       if ( $error ) {
4420         # gah, even with transactions.
4421         my $e = 'WARNING: Card/ACH voided but database not updated - '.
4422                 "error voiding payment: $error";
4423         warn $e;
4424         return $e;
4425       }
4426       warn "  void successful\n" if $DEBUG > 1;
4427       return '';
4428     }
4429   }
4430
4431   warn "  void unsuccessful, trying refund\n"
4432     if $DEBUG > 1;
4433
4434   #massage data
4435   my $address = $self->address1;
4436   $address .= ", ". $self->address2 if $self->address2;
4437
4438   my($payname, $payfirst, $paylast);
4439   if ( $self->payname && $method ne 'ECHECK' ) {
4440     $payname = $self->payname;
4441     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4442       or return "Illegal payname $payname";
4443     ($payfirst, $paylast) = ($1, $2);
4444   } else {
4445     $payfirst = $self->getfield('first');
4446     $paylast = $self->getfield('last');
4447     $payname =  "$payfirst $paylast";
4448   }
4449
4450   my @invoicing_list = $self->invoicing_list_emailonly;
4451   if ( $conf->exists('emailinvoiceautoalways')
4452        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4453        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4454     push @invoicing_list, $self->all_emails;
4455   }
4456
4457   my $email = ($conf->exists('business-onlinepayment-email-override'))
4458               ? $conf->config('business-onlinepayment-email-override')
4459               : $invoicing_list[0];
4460
4461   my $payip = exists($options{'payip'})
4462                 ? $options{'payip'}
4463                 : $self->payip;
4464   $content{customer_ip} = $payip
4465     if length($payip);
4466
4467   my $payinfo = '';
4468   if ( $method eq 'CC' ) {
4469
4470     if ( $cust_pay ) {
4471       $content{card_number} = $payinfo = $cust_pay->payinfo;
4472       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4473         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4474         ($content{expiration} = "$2/$1");  # where available
4475     } else {
4476       $content{card_number} = $payinfo = $self->payinfo;
4477       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4478         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4479       $content{expiration} = "$2/$1";
4480     }
4481
4482   } elsif ( $method eq 'ECHECK' ) {
4483
4484     if ( $cust_pay ) {
4485       $payinfo = $cust_pay->payinfo;
4486     } else {
4487       $payinfo = $self->payinfo;
4488     }
4489     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4490     $content{bank_name} = $self->payname;
4491     $content{account_type} = 'CHECKING';
4492     $content{account_name} = $payname;
4493     $content{customer_org} = $self->company ? 'B' : 'I';
4494     $content{customer_ssn} = $self->ss;
4495   } elsif ( $method eq 'LEC' ) {
4496     $content{phone} = $payinfo = $self->payinfo;
4497   }
4498
4499   #then try refund
4500   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4501   my %sub_content = $refund->content(
4502     'action'         => 'credit',
4503     'customer_id'    => $self->custnum,
4504     'last_name'      => $paylast,
4505     'first_name'     => $payfirst,
4506     'name'           => $payname,
4507     'address'        => $address,
4508     'city'           => $self->city,
4509     'state'          => $self->state,
4510     'zip'            => $self->zip,
4511     'country'        => $self->country,
4512     'email'          => $email,
4513     'phone'          => $self->daytime || $self->night,
4514     %content, #after
4515   );
4516   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4517     if $DEBUG > 1;
4518   $refund->submit();
4519
4520   return "$processor error: ". $refund->error_message
4521     unless $refund->is_success();
4522
4523   my %method2payby = (
4524     'CC'     => 'CARD',
4525     'ECHECK' => 'CHEK',
4526     'LEC'    => 'LECB',
4527   );
4528
4529   my $paybatch = "$processor:". $refund->authorization;
4530   $paybatch .= ':'. $refund->order_number
4531     if $refund->can('order_number') && $refund->order_number;
4532
4533   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4534     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4535     last unless @cust_bill_pay;
4536     my $cust_bill_pay = pop @cust_bill_pay;
4537     my $error = $cust_bill_pay->delete;
4538     last if $error;
4539   }
4540
4541   my $cust_refund = new FS::cust_refund ( {
4542     'custnum'  => $self->custnum,
4543     'paynum'   => $options{'paynum'},
4544     'refund'   => $amount,
4545     '_date'    => '',
4546     'payby'    => $method2payby{$method},
4547     'payinfo'  => $payinfo,
4548     'paybatch' => $paybatch,
4549     'reason'   => $options{'reason'} || 'card or ACH refund',
4550   } );
4551   my $error = $cust_refund->insert;
4552   if ( $error ) {
4553     $cust_refund->paynum(''); #try again with no specific paynum
4554     my $error2 = $cust_refund->insert;
4555     if ( $error2 ) {
4556       # gah, even with transactions.
4557       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4558               "error inserting refund ($processor): $error2".
4559               " (previously tried insert with paynum #$options{'paynum'}" .
4560               ": $error )";
4561       warn $e;
4562       return $e;
4563     }
4564   }
4565
4566   ''; #no error
4567
4568 }
4569
4570 # does the configuration indicate the new bop routines are required?
4571
4572 sub _new_bop_required {
4573   my $self = shift;
4574
4575   my $botpp = 'Business::OnlineThirdPartyPayment';
4576
4577   return 1
4578     if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4579          scalar( grep { $_->gateway_namespace eq $botpp }
4580                  qsearch( 'payment_gateway', { 'disabled' => '' } )
4581                )
4582        )
4583   ;
4584
4585   '';
4586 }
4587
4588
4589 =item realtime_collect [ OPTION => VALUE ... ]
4590
4591 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4592 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4593 gateway.  See L<http://420.am/business-onlinepayment> and
4594 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4595
4596 On failure returns an error message.
4597
4598 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.
4599
4600 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4601
4602 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4603 then it is deduced from the customer record.
4604
4605 If no I<amount> is specified, then the customer balance is used.
4606
4607 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4608 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4609 if set, will override the value from the customer record.
4610
4611 I<description> is a free-text field passed to the gateway.  It defaults to
4612 "Internet services".
4613
4614 If an I<invnum> is specified, this payment (if successful) is applied to the
4615 specified invoice.  If you don't specify an I<invnum> you might want to
4616 call the B<apply_payments> method.
4617
4618 I<quiet> can be set true to surpress email decline notices.
4619
4620 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4621 resulting paynum, if any.
4622
4623 I<payunique> is a unique identifier for this payment.
4624
4625 I<session_id> is a session identifier associated with this payment.
4626
4627 I<depend_jobnum> allows payment capture to unlock export jobs
4628
4629 =cut
4630
4631 sub realtime_collect {
4632   my( $self, %options ) = @_;
4633
4634   if ( $DEBUG ) {
4635     warn "$me realtime_collect:\n";
4636     warn "  $_ => $options{$_}\n" foreach keys %options;
4637   }
4638
4639   $options{amount} = $self->balance unless exists( $options{amount} );
4640   $options{method} = FS::payby->payby2bop($self->payby)
4641     unless exists( $options{method} );
4642
4643   return $self->realtime_bop({%options});
4644
4645 }
4646
4647 =item _realtime_bop { [ ARG => VALUE ... ] }
4648
4649 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4650 via a Business::OnlinePayment realtime gateway.  See
4651 L<http://420.am/business-onlinepayment> for supported gateways.
4652
4653 Required arguments in the hashref are I<method>, and I<amount>
4654
4655 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4656
4657 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4658
4659 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4660 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4661 if set, will override the value from the customer record.
4662
4663 I<description> is a free-text field passed to the gateway.  It defaults to
4664 "Internet services".
4665
4666 If an I<invnum> is specified, this payment (if successful) is applied to the
4667 specified invoice.  If you don't specify an I<invnum> you might want to
4668 call the B<apply_payments> method.
4669
4670 I<quiet> can be set true to surpress email decline notices.
4671
4672 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4673 resulting paynum, if any.
4674
4675 I<payunique> is a unique identifier for this payment.
4676
4677 I<session_id> is a session identifier associated with this payment.
4678
4679 I<depend_jobnum> allows payment capture to unlock export jobs
4680
4681 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4682
4683 =cut
4684
4685 # some helper routines
4686 sub _payment_gateway {
4687   my ($self, $options) = @_;
4688
4689   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4690     unless exists($options->{payment_gateway});
4691
4692   $options->{payment_gateway};
4693 }
4694
4695 sub _bop_auth {
4696   my ($self, $options) = @_;
4697
4698   (
4699     'login'    => $options->{payment_gateway}->gateway_username,
4700     'password' => $options->{payment_gateway}->gateway_password,
4701   );
4702 }
4703
4704 sub _bop_options {
4705   my ($self, $options) = @_;
4706
4707   $options->{payment_gateway}->gatewaynum
4708     ? $options->{payment_gateway}->options
4709     : @{ $options->{payment_gateway}->get('options') };
4710 }
4711
4712 sub _bop_defaults {
4713   my ($self, $options) = @_;
4714
4715   $options->{description} ||= 'Internet services';
4716   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4717   $options->{invnum} ||= '';
4718   $options->{payname} = $self->payname unless exists( $options->{payname} );
4719 }
4720
4721 sub _bop_content {
4722   my ($self, $options) = @_;
4723   my %content = ();
4724
4725   $content{address} = exists($options->{'address1'})
4726                         ? $options->{'address1'}
4727                         : $self->address1;
4728   my $address2 = exists($options->{'address2'})
4729                    ? $options->{'address2'}
4730                    : $self->address2;
4731   $content{address} .= ", ". $address2 if length($address2);
4732
4733   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4734   $content{customer_ip} = $payip if length($payip);
4735
4736   $content{invoice_number} = $options->{'invnum'}
4737     if exists($options->{'invnum'}) && length($options->{'invnum'});
4738
4739   $content{email_customer} =
4740     (    $conf->exists('business-onlinepayment-email_customer')
4741       || $conf->exists('business-onlinepayment-email-override') );
4742
4743   $content{payfirst} = $self->getfield('first');
4744   $content{paylast} = $self->getfield('last');
4745
4746   $content{account_name} = "$content{payfirst} $content{paylast}"
4747     if $options->{method} eq 'ECHECK';
4748
4749   $content{name} = $options->{payname};
4750   $content{name} = $content{account_name} if exists($content{account_name});
4751
4752   $content{city} = exists($options->{city})
4753                      ? $options->{city}
4754                      : $self->city;
4755   $content{state} = exists($options->{state})
4756                       ? $options->{state}
4757                       : $self->state;
4758   $content{zip} = exists($options->{zip})
4759                     ? $options->{'zip'}
4760                     : $self->zip;
4761   $content{country} = exists($options->{country})
4762                         ? $options->{country}
4763                         : $self->country;
4764   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4765   $content{phone} = $self->daytime || $self->night;
4766
4767   (%content);
4768 }
4769
4770 my %bop_method2payby = (
4771   'CC'     => 'CARD',
4772   'ECHECK' => 'CHEK',
4773   'LEC'    => 'LECB',
4774 );
4775
4776 sub _new_realtime_bop {
4777   my $self = shift;
4778
4779   my %options = ();
4780   if (ref($_[0]) eq 'HASH') {
4781     %options = %{$_[0]};
4782   } else {
4783     my ( $method, $amount ) = ( shift, shift );
4784     %options = @_;
4785     $options{method} = $method;
4786     $options{amount} = $amount;
4787   }
4788
4789   if ( $DEBUG ) {
4790     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4791     warn "  $_ => $options{$_}\n" foreach keys %options;
4792   }
4793
4794   return $self->fake_bop(%options) if $options{'fake'};
4795
4796   $self->_bop_defaults(\%options);
4797
4798   ###
4799   # set trans_is_recur based on invnum if there is one
4800   ###
4801
4802   my $trans_is_recur = 0;
4803   if ( $options{'invnum'} ) {
4804
4805     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4806     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4807
4808     my @part_pkg =
4809       map  { $_->part_pkg }
4810       grep { $_ }
4811       map  { $_->cust_pkg }
4812       $cust_bill->cust_bill_pkg;
4813
4814     $trans_is_recur = 1
4815       if grep { $_->freq ne '0' } @part_pkg;
4816
4817   }
4818
4819   ###
4820   # select a gateway
4821   ###
4822
4823   my $payment_gateway =  $self->_payment_gateway( \%options );
4824   my $namespace = $payment_gateway->gateway_namespace;
4825
4826   eval "use $namespace";
4827   die $@ if $@;
4828
4829   ###
4830   # check for banned credit card/ACH
4831   ###
4832
4833   my $ban = qsearchs('banned_pay', {
4834     'payby'   => $bop_method2payby{$options{method}},
4835     'payinfo' => md5_base64($options{payinfo}),
4836   } );
4837   return "Banned credit card" if $ban;
4838
4839   ###
4840   # massage data
4841   ###
4842
4843   my (%bop_content) = $self->_bop_content(\%options);
4844
4845   if ( $options{method} ne 'ECHECK' ) {
4846     $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4847       or return "Illegal payname $options{payname}";
4848     ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
4849   }
4850
4851   my @invoicing_list = $self->invoicing_list_emailonly;
4852   if ( $conf->exists('emailinvoiceautoalways')
4853        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4854        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4855     push @invoicing_list, $self->all_emails;
4856   }
4857
4858   my $email = ($conf->exists('business-onlinepayment-email-override'))
4859               ? $conf->config('business-onlinepayment-email-override')
4860               : $invoicing_list[0];
4861
4862   my $paydate = '';
4863   my %content = ();
4864   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4865
4866     $content{card_number} = $options{payinfo};
4867     $paydate = exists($options{'paydate'})
4868                     ? $options{'paydate'}
4869                     : $self->paydate;
4870     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4871     $content{expiration} = "$2/$1";
4872
4873     my $paycvv = exists($options{'paycvv'})
4874                    ? $options{'paycvv'}
4875                    : $self->paycvv;
4876     $content{cvv2} = $paycvv
4877       if length($paycvv);
4878
4879     my $paystart_month = exists($options{'paystart_month'})
4880                            ? $options{'paystart_month'}
4881                            : $self->paystart_month;
4882
4883     my $paystart_year  = exists($options{'paystart_year'})
4884                            ? $options{'paystart_year'}
4885                            : $self->paystart_year;
4886
4887     $content{card_start} = "$paystart_month/$paystart_year"
4888       if $paystart_month && $paystart_year;
4889
4890     my $payissue       = exists($options{'payissue'})
4891                            ? $options{'payissue'}
4892                            : $self->payissue;
4893     $content{issue_number} = $payissue if $payissue;
4894
4895     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
4896                                         'trans_is_recur' => $trans_is_recur,
4897                                       )
4898        )
4899     {
4900       $content{recurring_billing} = 'YES';
4901       $content{acct_code} = 'rebill'
4902         if $conf->exists('credit_card-recurring_billing_acct_code');
4903     }
4904
4905   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4906     ( $content{account_number}, $content{routing_code} ) =
4907       split('@', $options{payinfo});
4908     $content{bank_name} = $options{payname};
4909     $content{bank_state} = exists($options{'paystate'})
4910                              ? $options{'paystate'}
4911                              : $self->getfield('paystate');
4912     $content{account_type} = exists($options{'paytype'})
4913                                ? uc($options{'paytype'}) || 'CHECKING'
4914                                : uc($self->getfield('paytype')) || 'CHECKING';
4915     $content{customer_org} = $self->company ? 'B' : 'I';
4916     $content{state_id}       = exists($options{'stateid'})
4917                                  ? $options{'stateid'}
4918                                  : $self->getfield('stateid');
4919     $content{state_id_state} = exists($options{'stateid_state'})
4920                                  ? $options{'stateid_state'}
4921                                  : $self->getfield('stateid_state');
4922     $content{customer_ssn} = exists($options{'ss'})
4923                                ? $options{'ss'}
4924                                : $self->ss;
4925   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4926     $content{phone} = $options{payinfo};
4927   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4928     #move along
4929   } else {
4930     #die an evil death
4931   }
4932
4933   ###
4934   # run transaction(s)
4935   ###
4936
4937   my $balance = exists( $options{'balance'} )
4938                   ? $options{'balance'}
4939                   : $self->balance;
4940
4941   $self->select_for_update; #mutex ... just until we get our pending record in
4942
4943   #the checks here are intended to catch concurrent payments
4944   #double-form-submission prevention is taken care of in cust_pay_pending::check
4945
4946   #check the balance
4947   return "The customer's balance has changed; $options{method} transaction aborted."
4948     if $self->balance < $balance;
4949     #&& $self->balance < $options{amount}; #might as well anyway?
4950
4951   #also check and make sure there aren't *other* pending payments for this cust
4952
4953   my @pending = qsearch('cust_pay_pending', {
4954     'custnum' => $self->custnum,
4955     'status'  => { op=>'!=', value=>'done' }
4956   });
4957   return "A payment is already being processed for this customer (".
4958          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4959          "); $options{method} transaction aborted."
4960     if scalar(@pending);
4961
4962   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4963
4964   my $cust_pay_pending = new FS::cust_pay_pending {
4965     'custnum'           => $self->custnum,
4966     #'invnum'            => $options{'invnum'},
4967     'paid'              => $options{amount},
4968     '_date'             => '',
4969     'payby'             => $bop_method2payby{$options{method}},
4970     'payinfo'           => $options{payinfo},
4971     'paydate'           => $paydate,
4972     'recurring_billing' => $content{recurring_billing},
4973     'status'            => 'new',
4974     'gatewaynum'        => $payment_gateway->gatewaynum || '',
4975     'session_id'        => $options{session_id} || '',
4976     'jobnum'            => $options{depend_jobnum} || '',
4977   };
4978   $cust_pay_pending->payunique( $options{payunique} )
4979     if defined($options{payunique}) && length($options{payunique});
4980   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4981   return $cpp_new_err if $cpp_new_err;
4982
4983   my( $action1, $action2 ) =
4984     split( /\s*\,\s*/, $payment_gateway->gateway_action );
4985
4986   my $transaction = new $namespace( $payment_gateway->gateway_module,
4987                                     $self->_bop_options(\%options),
4988                                   );
4989
4990   $transaction->content(
4991     'type'           => $options{method},
4992     $self->_bop_auth(\%options),
4993     'action'         => $action1,
4994     'description'    => $options{'description'},
4995     'amount'         => $options{amount},
4996     #'invoice_number' => $options{'invnum'},
4997     'customer_id'    => $self->custnum,
4998     %bop_content,
4999     'reference'      => $cust_pay_pending->paypendingnum, #for now
5000     'email'          => $email,
5001     %content, #after
5002   );
5003
5004   $cust_pay_pending->status('pending');
5005   my $cpp_pending_err = $cust_pay_pending->replace;
5006   return $cpp_pending_err if $cpp_pending_err;
5007
5008   #config?
5009   my $BOP_TESTING = 0;
5010   my $BOP_TESTING_SUCCESS = 1;
5011
5012   unless ( $BOP_TESTING ) {
5013     $transaction->submit();
5014   } else {
5015     if ( $BOP_TESTING_SUCCESS ) {
5016       $transaction->is_success(1);
5017       $transaction->authorization('fake auth');
5018     } else {
5019       $transaction->is_success(0);
5020       $transaction->error_message('fake failure');
5021     }
5022   }
5023
5024   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5025
5026     return { reference => $cust_pay_pending->paypendingnum,
5027              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5028
5029   } elsif ( $transaction->is_success() && $action2 ) {
5030
5031     $cust_pay_pending->status('authorized');
5032     my $cpp_authorized_err = $cust_pay_pending->replace;
5033     return $cpp_authorized_err if $cpp_authorized_err;
5034
5035     my $auth = $transaction->authorization;
5036     my $ordernum = $transaction->can('order_number')
5037                    ? $transaction->order_number
5038                    : '';
5039
5040     my $capture =
5041       new Business::OnlinePayment( $payment_gateway->gateway_module,
5042                                    $self->_bop_options(\%options),
5043                                  );
5044
5045     my %capture = (
5046       %content,
5047       type           => $options{method},
5048       action         => $action2,
5049       $self->_bop_auth(\%options),
5050       order_number   => $ordernum,
5051       amount         => $options{amount},
5052       authorization  => $auth,
5053       description    => $options{'description'},
5054     );
5055
5056     foreach my $field (qw( authorization_source_code returned_ACI
5057                            transaction_identifier validation_code
5058                            transaction_sequence_num local_transaction_date
5059                            local_transaction_time AVS_result_code          )) {
5060       $capture{$field} = $transaction->$field() if $transaction->can($field);
5061     }
5062
5063     $capture->content( %capture );
5064
5065     $capture->submit();
5066
5067     unless ( $capture->is_success ) {
5068       my $e = "Authorization successful but capture failed, custnum #".
5069               $self->custnum. ': '.  $capture->result_code.
5070               ": ". $capture->error_message;
5071       warn $e;
5072       return $e;
5073     }
5074
5075   }
5076
5077   ###
5078   # remove paycvv after initial transaction
5079   ###
5080
5081   #false laziness w/misc/process/payment.cgi - check both to make sure working
5082   # correctly
5083   if ( defined $self->dbdef_table->column('paycvv')
5084        && length($self->paycvv)
5085        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5086   ) {
5087     my $error = $self->remove_cvv;
5088     if ( $error ) {
5089       warn "WARNING: error removing cvv: $error\n";
5090     }
5091   }
5092
5093   ###
5094   # result handling
5095   ###
5096
5097   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5098
5099 }
5100
5101 =item fake_bop
5102
5103 =cut
5104
5105 sub fake_bop {
5106   my $self = shift;
5107
5108   my %options = ();
5109   if (ref($_[0]) eq 'HASH') {
5110     %options = %{$_[0]};
5111   } else {
5112     my ( $method, $amount ) = ( shift, shift );
5113     %options = @_;
5114     $options{method} = $method;
5115     $options{amount} = $amount;
5116   }
5117
5118   if ( $options{'fake_failure'} ) {
5119      return "Error: No error; test failure requested with fake_failure";
5120   }
5121
5122   #my $paybatch = '';
5123   #if ( $payment_gateway->gatewaynum ) { # agent override
5124   #  $paybatch = $payment_gateway->gatewaynum. '-';
5125   #}
5126   #
5127   #$paybatch .= "$processor:". $transaction->authorization;
5128   #
5129   #$paybatch .= ':'. $transaction->order_number
5130   #  if $transaction->can('order_number')
5131   #  && length($transaction->order_number);
5132
5133   my $paybatch = 'FakeProcessor:54:32';
5134
5135   my $cust_pay = new FS::cust_pay ( {
5136      'custnum'  => $self->custnum,
5137      'invnum'   => $options{'invnum'},
5138      'paid'     => $options{amount},
5139      '_date'    => '',
5140      'payby'    => $bop_method2payby{$options{method}},
5141      #'payinfo'  => $payinfo,
5142      'payinfo'  => '4111111111111111',
5143      'paybatch' => $paybatch,
5144      #'paydate'  => $paydate,
5145      'paydate'  => '2012-05-01',
5146   } );
5147   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5148
5149   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5150
5151   if ( $error ) {
5152     $cust_pay->invnum(''); #try again with no specific invnum
5153     my $error2 = $cust_pay->insert( $options{'manual'} ?
5154                                     ( 'manual' => 1 ) : ()
5155                                   );
5156     if ( $error2 ) {
5157       # gah, even with transactions.
5158       my $e = 'WARNING: Card/ACH debited but database not updated - '.
5159               "error inserting (fake!) payment: $error2".
5160               " (previously tried insert with invnum #$options{'invnum'}" .
5161               ": $error )";
5162       warn $e;
5163       return $e;
5164     }
5165   }
5166
5167   if ( $options{'paynum_ref'} ) {
5168     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5169   }
5170
5171   return ''; #no error
5172
5173 }
5174
5175
5176 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5177 #
5178 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5179 # phone bill transaction.
5180
5181 sub _realtime_bop_result {
5182   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5183   if ( $DEBUG ) {
5184     warn "$me _realtime_bop_result: pending transaction ".
5185       $cust_pay_pending->paypendingnum. "\n";
5186     warn "  $_ => $options{$_}\n" foreach keys %options;
5187   }
5188
5189   my $payment_gateway = $options{payment_gateway}
5190     or return "no payment gateway in arguments to _realtime_bop_result";
5191
5192   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5193   my $cpp_captured_err = $cust_pay_pending->replace;
5194   return $cpp_captured_err if $cpp_captured_err;
5195
5196   if ( $transaction->is_success() ) {
5197
5198     my $paybatch = '';
5199     if ( $payment_gateway->gatewaynum ) { # agent override
5200       $paybatch = $payment_gateway->gatewaynum. '-';
5201     }
5202
5203     $paybatch .= $payment_gateway->gateway_module. ":".
5204       $transaction->authorization;
5205
5206     $paybatch .= ':'. $transaction->order_number
5207       if $transaction->can('order_number')
5208       && length($transaction->order_number);
5209
5210     my $cust_pay = new FS::cust_pay ( {
5211        'custnum'  => $self->custnum,
5212        'invnum'   => $options{'invnum'},
5213        'paid'     => $cust_pay_pending->paid,
5214        '_date'    => '',
5215        'payby'    => $cust_pay_pending->payby,
5216        #'payinfo'  => $payinfo,
5217        'paybatch' => $paybatch,
5218        'paydate'  => $cust_pay_pending->paydate,
5219     } );
5220     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5221     $cust_pay->payunique( $options{payunique} )
5222       if defined($options{payunique}) && length($options{payunique});
5223
5224     my $oldAutoCommit = $FS::UID::AutoCommit;
5225     local $FS::UID::AutoCommit = 0;
5226     my $dbh = dbh;
5227
5228     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5229
5230     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5231
5232     if ( $error ) {
5233       $cust_pay->invnum(''); #try again with no specific invnum
5234       my $error2 = $cust_pay->insert( $options{'manual'} ?
5235                                       ( 'manual' => 1 ) : ()
5236                                     );
5237       if ( $error2 ) {
5238         # gah.  but at least we have a record of the state we had to abort in
5239         # from cust_pay_pending now.
5240         my $e = "WARNING: $options{method} captured but payment not recorded -".
5241                 " error inserting payment (". $payment_gateway->gateway_module.
5242                 "): $error2".
5243                 " (previously tried insert with invnum #$options{'invnum'}" .
5244                 ": $error ) - pending payment saved as paypendingnum ".
5245                 $cust_pay_pending->paypendingnum. "\n";
5246         warn $e;
5247         return $e;
5248       }
5249     }
5250
5251     my $jobnum = $cust_pay_pending->jobnum;
5252     if ( $jobnum ) {
5253        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5254
5255        unless ( $placeholder ) {
5256          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5257          my $e = "WARNING: $options{method} captured but job $jobnum not ".
5258              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5259          warn $e;
5260          return $e;
5261        }
5262
5263        $error = $placeholder->delete;
5264
5265        if ( $error ) {
5266          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5267          my $e = "WARNING: $options{method} captured but could not delete ".
5268               "job $jobnum for paypendingnum ".
5269               $cust_pay_pending->paypendingnum. ": $error\n";
5270          warn $e;
5271          return $e;
5272        }
5273
5274     }
5275
5276     if ( $options{'paynum_ref'} ) {
5277       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5278     }
5279
5280     $cust_pay_pending->status('done');
5281     $cust_pay_pending->statustext('captured');
5282     $cust_pay_pending->paynum($cust_pay->paynum);
5283     my $cpp_done_err = $cust_pay_pending->replace;
5284
5285     if ( $cpp_done_err ) {
5286
5287       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5288       my $e = "WARNING: $options{method} captured but payment not recorded - ".
5289               "error updating status for paypendingnum ".
5290               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5291       warn $e;
5292       return $e;
5293
5294     } else {
5295
5296       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5297       return ''; #no error
5298
5299     }
5300
5301   } else {
5302
5303     my $perror = $payment_gateway->gateway_module. " error: ".
5304       $transaction->error_message;
5305
5306     my $jobnum = $cust_pay_pending->jobnum;
5307     if ( $jobnum ) {
5308        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5309
5310        if ( $placeholder ) {
5311          my $error = $placeholder->depended_delete;
5312          $error ||= $placeholder->delete;
5313          warn "error removing provisioning jobs after declined paypendingnum ".
5314            $cust_pay_pending->paypendingnum. "\n";
5315        } else {
5316          my $e = "error finding job $jobnum for declined paypendingnum ".
5317               $cust_pay_pending->paypendingnum. "\n";
5318          warn $e;
5319        }
5320
5321     }
5322
5323     unless ( $transaction->error_message ) {
5324
5325       my $t_response;
5326       if ( $transaction->can('response_page') ) {
5327         $t_response = {
5328                         'page'    => ( $transaction->can('response_page')
5329                                          ? $transaction->response_page
5330                                          : ''
5331                                      ),
5332                         'code'    => ( $transaction->can('response_code')
5333                                          ? $transaction->response_code
5334                                          : ''
5335                                      ),
5336                         'headers' => ( $transaction->can('response_headers')
5337                                          ? $transaction->response_headers
5338                                          : ''
5339                                      ),
5340                       };
5341       } else {
5342         $t_response .=
5343           "No additional debugging information available for ".
5344             $payment_gateway->gateway_module;
5345       }
5346
5347       $perror .= "No error_message returned from ".
5348                    $payment_gateway->gateway_module. " -- ".
5349                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5350
5351     }
5352
5353     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5354          && $conf->exists('emaildecline')
5355          && grep { $_ ne 'POST' } $self->invoicing_list
5356          && ! grep { $transaction->error_message =~ /$_/ }
5357                    $conf->config('emaildecline-exclude')
5358     ) {
5359       my @templ = $conf->config('declinetemplate');
5360       my $template = new Text::Template (
5361         TYPE   => 'ARRAY',
5362         SOURCE => [ map "$_\n", @templ ],
5363       ) or return "($perror) can't create template: $Text::Template::ERROR";
5364       $template->compile()
5365         or return "($perror) can't compile template: $Text::Template::ERROR";
5366
5367       my $templ_hash = { error => $transaction->error_message };
5368
5369       my $error = send_email(
5370         'from'    => $conf->config('invoice_from', $self->agentnum ),
5371         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5372         'subject' => 'Your payment could not be processed',
5373         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5374       );
5375
5376       $perror .= " (also received error sending decline notification: $error)"
5377         if $error;
5378
5379     }
5380
5381     $cust_pay_pending->status('done');
5382     $cust_pay_pending->statustext("declined: $perror");
5383     my $cpp_done_err = $cust_pay_pending->replace;
5384     if ( $cpp_done_err ) {
5385       my $e = "WARNING: $options{method} declined but pending payment not ".
5386               "resolved - error updating status for paypendingnum ".
5387               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5388       warn $e;
5389       $perror = "$e ($perror)";
5390     }
5391
5392     return $perror;
5393   }
5394
5395 }
5396
5397 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5398
5399 Verifies successful third party processing of a realtime credit card,
5400 ACH (electronic check) or phone bill transaction via a
5401 Business::OnlineThirdPartyPayment realtime gateway.  See
5402 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5403
5404 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5405
5406 The additional options I<payname>, I<city>, I<state>,
5407 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5408 if set, will override the value from the customer record.
5409
5410 I<description> is a free-text field passed to the gateway.  It defaults to
5411 "Internet services".
5412
5413 If an I<invnum> is specified, this payment (if successful) is applied to the
5414 specified invoice.  If you don't specify an I<invnum> you might want to
5415 call the B<apply_payments> method.
5416
5417 I<quiet> can be set true to surpress email decline notices.
5418
5419 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5420 resulting paynum, if any.
5421
5422 I<payunique> is a unique identifier for this payment.
5423
5424 Returns a hashref containing elements bill_error (which will be undefined
5425 upon success) and session_id of any associated session.
5426
5427 =cut
5428
5429 sub realtime_botpp_capture {
5430   my( $self, $cust_pay_pending, %options ) = @_;
5431   if ( $DEBUG ) {
5432     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5433     warn "  $_ => $options{$_}\n" foreach keys %options;
5434   }
5435
5436   eval "use Business::OnlineThirdPartyPayment";
5437   die $@ if $@;
5438
5439   ###
5440   # select the gateway
5441   ###
5442
5443   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5444
5445   my $payment_gateway = $cust_pay_pending->gatewaynum
5446     ? qsearchs( 'payment_gateway',
5447                 { gatewaynum => $cust_pay_pending->gatewaynum }
5448               )
5449     : $self->agent->payment_gateway( 'method' => $method,
5450                                      # 'invnum'  => $cust_pay_pending->invnum,
5451                                      # 'payinfo' => $cust_pay_pending->payinfo,
5452                                    );
5453
5454   $options{payment_gateway} = $payment_gateway; # for the helper subs
5455
5456   ###
5457   # massage data
5458   ###
5459
5460   my @invoicing_list = $self->invoicing_list_emailonly;
5461   if ( $conf->exists('emailinvoiceautoalways')
5462        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5463        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5464     push @invoicing_list, $self->all_emails;
5465   }
5466
5467   my $email = ($conf->exists('business-onlinepayment-email-override'))
5468               ? $conf->config('business-onlinepayment-email-override')
5469               : $invoicing_list[0];
5470
5471   my %content = ();
5472
5473   $content{email_customer} =
5474     (    $conf->exists('business-onlinepayment-email_customer')
5475       || $conf->exists('business-onlinepayment-email-override') );
5476
5477   ###
5478   # run transaction(s)
5479   ###
5480
5481   my $transaction =
5482     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5483                                            $self->_bop_options(\%options),
5484                                          );
5485
5486   $transaction->reference({ %options });
5487
5488   $transaction->content(
5489     'type'           => $method,
5490     $self->_bop_auth(\%options),
5491     'action'         => 'Post Authorization',
5492     'description'    => $options{'description'},
5493     'amount'         => $cust_pay_pending->paid,
5494     #'invoice_number' => $options{'invnum'},
5495     'customer_id'    => $self->custnum,
5496     'referer'        => 'http://cleanwhisker.420.am/',
5497     'reference'      => $cust_pay_pending->paypendingnum,
5498     'email'          => $email,
5499     'phone'          => $self->daytime || $self->night,
5500     %content, #after
5501     # plus whatever is required for bogus capture avoidance
5502   );
5503
5504   $transaction->submit();
5505
5506   my $error =
5507     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5508
5509   {
5510     bill_error => $error,
5511     session_id => $cust_pay_pending->session_id,
5512   }
5513
5514 }
5515
5516 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5517
5518 =cut
5519
5520 sub default_payment_gateway {
5521   my( $self, $method ) = @_;
5522
5523   die "Real-time processing not enabled\n"
5524     unless $conf->exists('business-onlinepayment');
5525
5526   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5527
5528   #load up config
5529   my $bop_config = 'business-onlinepayment';
5530   $bop_config .= '-ach'
5531     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5532   my ( $processor, $login, $password, $action, @bop_options ) =
5533     $conf->config($bop_config);
5534   $action ||= 'normal authorization';
5535   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5536   die "No real-time processor is enabled - ".
5537       "did you set the business-onlinepayment configuration value?\n"
5538     unless $processor;
5539
5540   ( $processor, $login, $password, $action, @bop_options )
5541 }
5542
5543 =item remove_cvv
5544
5545 Removes the I<paycvv> field from the database directly.
5546
5547 If there is an error, returns the error, otherwise returns false.
5548
5549 =cut
5550
5551 sub remove_cvv {
5552   my $self = shift;
5553   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5554     or return dbh->errstr;
5555   $sth->execute($self->custnum)
5556     or return $sth->errstr;
5557   $self->paycvv('');
5558   '';
5559 }
5560
5561 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5562
5563 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5564 via a Business::OnlinePayment realtime gateway.  See
5565 L<http://420.am/business-onlinepayment> for supported gateways.
5566
5567 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5568
5569 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5570
5571 Most gateways require a reference to an original payment transaction to refund,
5572 so you probably need to specify a I<paynum>.
5573
5574 I<amount> defaults to the original amount of the payment if not specified.
5575
5576 I<reason> specifies a reason for the refund.
5577
5578 I<paydate> specifies the expiration date for a credit card overriding the
5579 value from the customer record or the payment record. Specified as yyyy-mm-dd
5580
5581 Implementation note: If I<amount> is unspecified or equal to the amount of the
5582 orignal payment, first an attempt is made to "void" the transaction via
5583 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5584 the normal attempt is made to "refund" ("credit") the transaction via the
5585 gateway is attempted.
5586
5587 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5588 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5589 #if set, will override the value from the customer record.
5590
5591 #If an I<invnum> is specified, this payment (if successful) is applied to the
5592 #specified invoice.  If you don't specify an I<invnum> you might want to
5593 #call the B<apply_payments> method.
5594
5595 =cut
5596
5597 #some false laziness w/realtime_bop, not enough to make it worth merging
5598 #but some useful small subs should be pulled out
5599 sub _new_realtime_refund_bop {
5600   my $self = shift;
5601
5602   my %options = ();
5603   if (ref($_[0]) ne 'HASH') {
5604     %options = %{$_[0]};
5605   } else {
5606     my $method = shift;
5607     %options = @_;
5608     $options{method} = $method;
5609   }
5610
5611   if ( $DEBUG ) {
5612     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5613     warn "  $_ => $options{$_}\n" foreach keys %options;
5614   }
5615
5616   ###
5617   # look up the original payment and optionally a gateway for that payment
5618   ###
5619
5620   my $cust_pay = '';
5621   my $amount = $options{'amount'};
5622
5623   my( $processor, $login, $password, @bop_options, $namespace ) ;
5624   my( $auth, $order_number ) = ( '', '', '' );
5625
5626   if ( $options{'paynum'} ) {
5627
5628     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5629     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5630       or return "Unknown paynum $options{'paynum'}";
5631     $amount ||= $cust_pay->paid;
5632
5633     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5634       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5635                 $cust_pay->paybatch;
5636     my $gatewaynum = '';
5637     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5638
5639     if ( $gatewaynum ) { #gateway for the payment to be refunded
5640
5641       my $payment_gateway =
5642         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5643       die "payment gateway $gatewaynum not found"
5644         unless $payment_gateway;
5645
5646       $processor   = $payment_gateway->gateway_module;
5647       $login       = $payment_gateway->gateway_username;
5648       $password    = $payment_gateway->gateway_password;
5649       $namespace   = $payment_gateway->gateway_namespace;
5650       @bop_options = $payment_gateway->options;
5651
5652     } else { #try the default gateway
5653
5654       my $conf_processor;
5655       my $payment_gateway =
5656         $self->agent->payment_gateway('method' => $options{method});
5657
5658       ( $conf_processor, $login, $password, $namespace ) =
5659         map { my $method = "gateway_$_"; $payment_gateway->$method }
5660           qw( module username password namespace );
5661
5662       @bop_options = $payment_gateway->gatewaynum
5663                        ? $payment_gateway->options
5664                        : @{ $payment_gateway->get('options') };
5665
5666       return "processor of payment $options{'paynum'} $processor does not".
5667              " match default processor $conf_processor"
5668         unless $processor eq $conf_processor;
5669
5670     }
5671
5672
5673   } else { # didn't specify a paynum, so look for agent gateway overrides
5674            # like a normal transaction
5675
5676     my $payment_gateway =
5677       $self->agent->payment_gateway( 'method'  => $options{method},
5678                                      #'payinfo' => $payinfo,
5679                                    );
5680     my( $processor, $login, $password, $namespace ) =
5681       map { my $method = "gateway_$_"; $payment_gateway->$method }
5682         qw( module username password namespace );
5683
5684     my @bop_options = $payment_gateway->gatewaynum
5685                         ? $payment_gateway->options
5686                         : @{ $payment_gateway->get('options') };
5687
5688   }
5689   return "neither amount nor paynum specified" unless $amount;
5690
5691   eval "use $namespace";
5692   die $@ if $@;
5693
5694   my %content = (
5695     'type'           => $options{method},
5696     'login'          => $login,
5697     'password'       => $password,
5698     'order_number'   => $order_number,
5699     'amount'         => $amount,
5700     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5701   );
5702   $content{authorization} = $auth
5703     if length($auth); #echeck/ACH transactions have an order # but no auth
5704                       #(at least with authorize.net)
5705
5706   my $disable_void_after;
5707   if ($conf->exists('disable_void_after')
5708       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5709     $disable_void_after = $1;
5710   }
5711
5712   #first try void if applicable
5713   if ( $cust_pay && $cust_pay->paid == $amount
5714     && (
5715       ( not defined($disable_void_after) )
5716       || ( time < ($cust_pay->_date + $disable_void_after ) )
5717     )
5718   ) {
5719     warn "  attempting void\n" if $DEBUG > 1;
5720     my $void = new Business::OnlinePayment( $processor, @bop_options );
5721     $void->content( 'action' => 'void', %content );
5722     $void->submit();
5723     if ( $void->is_success ) {
5724       my $error = $cust_pay->void($options{'reason'});
5725       if ( $error ) {
5726         # gah, even with transactions.
5727         my $e = 'WARNING: Card/ACH voided but database not updated - '.
5728                 "error voiding payment: $error";
5729         warn $e;
5730         return $e;
5731       }
5732       warn "  void successful\n" if $DEBUG > 1;
5733       return '';
5734     }
5735   }
5736
5737   warn "  void unsuccessful, trying refund\n"
5738     if $DEBUG > 1;
5739
5740   #massage data
5741   my $address = $self->address1;
5742   $address .= ", ". $self->address2 if $self->address2;
5743
5744   my($payname, $payfirst, $paylast);
5745   if ( $self->payname && $options{method} ne 'ECHECK' ) {
5746     $payname = $self->payname;
5747     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5748       or return "Illegal payname $payname";
5749     ($payfirst, $paylast) = ($1, $2);
5750   } else {
5751     $payfirst = $self->getfield('first');
5752     $paylast = $self->getfield('last');
5753     $payname =  "$payfirst $paylast";
5754   }
5755
5756   my @invoicing_list = $self->invoicing_list_emailonly;
5757   if ( $conf->exists('emailinvoiceautoalways')
5758        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5759        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5760     push @invoicing_list, $self->all_emails;
5761   }
5762
5763   my $email = ($conf->exists('business-onlinepayment-email-override'))
5764               ? $conf->config('business-onlinepayment-email-override')
5765               : $invoicing_list[0];
5766
5767   my $payip = exists($options{'payip'})
5768                 ? $options{'payip'}
5769                 : $self->payip;
5770   $content{customer_ip} = $payip
5771     if length($payip);
5772
5773   my $payinfo = '';
5774   if ( $options{method} eq 'CC' ) {
5775
5776     if ( $cust_pay ) {
5777       $content{card_number} = $payinfo = $cust_pay->payinfo;
5778       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5779         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5780         ($content{expiration} = "$2/$1");  # where available
5781     } else {
5782       $content{card_number} = $payinfo = $self->payinfo;
5783       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5784         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5785       $content{expiration} = "$2/$1";
5786     }
5787
5788   } elsif ( $options{method} eq 'ECHECK' ) {
5789
5790     if ( $cust_pay ) {
5791       $payinfo = $cust_pay->payinfo;
5792     } else {
5793       $payinfo = $self->payinfo;
5794     }
5795     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5796     $content{bank_name} = $self->payname;
5797     $content{account_type} = 'CHECKING';
5798     $content{account_name} = $payname;
5799     $content{customer_org} = $self->company ? 'B' : 'I';
5800     $content{customer_ssn} = $self->ss;
5801   } elsif ( $options{method} eq 'LEC' ) {
5802     $content{phone} = $payinfo = $self->payinfo;
5803   }
5804
5805   #then try refund
5806   my $refund = new Business::OnlinePayment( $processor, @bop_options );
5807   my %sub_content = $refund->content(
5808     'action'         => 'credit',
5809     'customer_id'    => $self->custnum,
5810     'last_name'      => $paylast,
5811     'first_name'     => $payfirst,
5812     'name'           => $payname,
5813     'address'        => $address,
5814     'city'           => $self->city,
5815     'state'          => $self->state,
5816     'zip'            => $self->zip,
5817     'country'        => $self->country,
5818     'email'          => $email,
5819     'phone'          => $self->daytime || $self->night,
5820     %content, #after
5821   );
5822   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
5823     if $DEBUG > 1;
5824   $refund->submit();
5825
5826   return "$processor error: ". $refund->error_message
5827     unless $refund->is_success();
5828
5829   my $paybatch = "$processor:". $refund->authorization;
5830   $paybatch .= ':'. $refund->order_number
5831     if $refund->can('order_number') && $refund->order_number;
5832
5833   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5834     my @cust_bill_pay = $cust_pay->cust_bill_pay;
5835     last unless @cust_bill_pay;
5836     my $cust_bill_pay = pop @cust_bill_pay;
5837     my $error = $cust_bill_pay->delete;
5838     last if $error;
5839   }
5840
5841   my $cust_refund = new FS::cust_refund ( {
5842     'custnum'  => $self->custnum,
5843     'paynum'   => $options{'paynum'},
5844     'refund'   => $amount,
5845     '_date'    => '',
5846     'payby'    => $bop_method2payby{$options{method}},
5847     'payinfo'  => $payinfo,
5848     'paybatch' => $paybatch,
5849     'reason'   => $options{'reason'} || 'card or ACH refund',
5850   } );
5851   my $error = $cust_refund->insert;
5852   if ( $error ) {
5853     $cust_refund->paynum(''); #try again with no specific paynum
5854     my $error2 = $cust_refund->insert;
5855     if ( $error2 ) {
5856       # gah, even with transactions.
5857       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5858               "error inserting refund ($processor): $error2".
5859               " (previously tried insert with paynum #$options{'paynum'}" .
5860               ": $error )";
5861       warn $e;
5862       return $e;
5863     }
5864   }
5865
5866   ''; #no error
5867
5868 }
5869
5870 =item batch_card OPTION => VALUE...
5871
5872 Adds a payment for this invoice to the pending credit card batch (see
5873 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5874 runs the payment using a realtime gateway.
5875
5876 =cut
5877
5878 sub batch_card {
5879   my ($self, %options) = @_;
5880
5881   my $amount;
5882   if (exists($options{amount})) {
5883     $amount = $options{amount};
5884   }else{
5885     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5886   }
5887   return '' unless $amount > 0;
5888
5889   my $invnum = delete $options{invnum};
5890   my $payby = $options{invnum} || $self->payby;  #dubious
5891
5892   if ($options{'realtime'}) {
5893     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5894                                 $amount,
5895                                 %options,
5896                               );
5897   }
5898
5899   my $oldAutoCommit = $FS::UID::AutoCommit;
5900   local $FS::UID::AutoCommit = 0;
5901   my $dbh = dbh;
5902
5903   #this needs to handle mysql as well as Pg, like svc_acct.pm
5904   #(make it into a common function if folks need to do batching with mysql)
5905   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5906     or return "Cannot lock pay_batch: " . $dbh->errstr;
5907
5908   my %pay_batch = (
5909     'status' => 'O',
5910     'payby'  => FS::payby->payby2payment($payby),
5911   );
5912
5913   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5914
5915   unless ( $pay_batch ) {
5916     $pay_batch = new FS::pay_batch \%pay_batch;
5917     my $error = $pay_batch->insert;
5918     if ( $error ) {
5919       $dbh->rollback if $oldAutoCommit;
5920       die "error creating new batch: $error\n";
5921     }
5922   }
5923
5924   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5925       'batchnum' => $pay_batch->batchnum,
5926       'custnum'  => $self->custnum,
5927   } );
5928
5929   foreach (qw( address1 address2 city state zip country payby payinfo paydate
5930                payname )) {
5931     $options{$_} = '' unless exists($options{$_});
5932   }
5933
5934   my $cust_pay_batch = new FS::cust_pay_batch ( {
5935     'batchnum' => $pay_batch->batchnum,
5936     'invnum'   => $invnum || 0,                    # is there a better value?
5937                                                    # this field should be
5938                                                    # removed...
5939                                                    # cust_bill_pay_batch now
5940     'custnum'  => $self->custnum,
5941     'last'     => $self->getfield('last'),
5942     'first'    => $self->getfield('first'),
5943     'address1' => $options{address1} || $self->address1,
5944     'address2' => $options{address2} || $self->address2,
5945     'city'     => $options{city}     || $self->city,
5946     'state'    => $options{state}    || $self->state,
5947     'zip'      => $options{zip}      || $self->zip,
5948     'country'  => $options{country}  || $self->country,
5949     'payby'    => $options{payby}    || $self->payby,
5950     'payinfo'  => $options{payinfo}  || $self->payinfo,
5951     'exp'      => $options{paydate}  || $self->paydate,
5952     'payname'  => $options{payname}  || $self->payname,
5953     'amount'   => $amount,                         # consolidating
5954   } );
5955
5956   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5957     if $old_cust_pay_batch;
5958
5959   my $error;
5960   if ($old_cust_pay_batch) {
5961     $error = $cust_pay_batch->replace($old_cust_pay_batch)
5962   } else {
5963     $error = $cust_pay_batch->insert;
5964   }
5965
5966   if ( $error ) {
5967     $dbh->rollback if $oldAutoCommit;
5968     die $error;
5969   }
5970
5971   my $unapplied =   $self->total_unapplied_credits
5972                   + $self->total_unapplied_payments
5973                   + $self->in_transit_payments;
5974   foreach my $cust_bill ($self->open_cust_bill) {
5975     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5976     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5977       'invnum' => $cust_bill->invnum,
5978       'paybatchnum' => $cust_pay_batch->paybatchnum,
5979       'amount' => $cust_bill->owed,
5980       '_date' => time,
5981     };
5982     if ($unapplied >= $cust_bill_pay_batch->amount){
5983       $unapplied -= $cust_bill_pay_batch->amount;
5984       next;
5985     }else{
5986       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5987                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
5988     }
5989     $error = $cust_bill_pay_batch->insert;
5990     if ( $error ) {
5991       $dbh->rollback if $oldAutoCommit;
5992       die $error;
5993     }
5994   }
5995
5996   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5997   '';
5998 }
5999
6000 =item apply_payments_and_credits
6001
6002 Applies unapplied payments and credits.
6003
6004 In most cases, this new method should be used in place of sequential
6005 apply_payments and apply_credits methods.
6006
6007 If there is an error, returns the error, otherwise returns false.
6008
6009 =cut
6010
6011 sub apply_payments_and_credits {
6012   my $self = shift;
6013
6014   local $SIG{HUP} = 'IGNORE';
6015   local $SIG{INT} = 'IGNORE';
6016   local $SIG{QUIT} = 'IGNORE';
6017   local $SIG{TERM} = 'IGNORE';
6018   local $SIG{TSTP} = 'IGNORE';
6019   local $SIG{PIPE} = 'IGNORE';
6020
6021   my $oldAutoCommit = $FS::UID::AutoCommit;
6022   local $FS::UID::AutoCommit = 0;
6023   my $dbh = dbh;
6024
6025   $self->select_for_update; #mutex
6026
6027   foreach my $cust_bill ( $self->open_cust_bill ) {
6028     my $error = $cust_bill->apply_payments_and_credits;
6029     if ( $error ) {
6030       $dbh->rollback if $oldAutoCommit;
6031       return "Error applying: $error";
6032     }
6033   }
6034
6035   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6036   ''; #no error
6037
6038 }
6039
6040 =item apply_credits OPTION => VALUE ...
6041
6042 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6043 to outstanding invoice balances in chronological order (or reverse
6044 chronological order if the I<order> option is set to B<newest>) and returns the
6045 value of any remaining unapplied credits available for refund (see
6046 L<FS::cust_refund>).
6047
6048 Dies if there is an error.
6049
6050 =cut
6051
6052 sub apply_credits {
6053   my $self = shift;
6054   my %opt = @_;
6055
6056   local $SIG{HUP} = 'IGNORE';
6057   local $SIG{INT} = 'IGNORE';
6058   local $SIG{QUIT} = 'IGNORE';
6059   local $SIG{TERM} = 'IGNORE';
6060   local $SIG{TSTP} = 'IGNORE';
6061   local $SIG{PIPE} = 'IGNORE';
6062
6063   my $oldAutoCommit = $FS::UID::AutoCommit;
6064   local $FS::UID::AutoCommit = 0;
6065   my $dbh = dbh;
6066
6067   $self->select_for_update; #mutex
6068
6069   unless ( $self->total_unapplied_credits ) {
6070     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6071     return 0;
6072   }
6073
6074   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6075       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6076
6077   my @invoices = $self->open_cust_bill;
6078   @invoices = sort { $b->_date <=> $a->_date } @invoices
6079     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6080
6081   my $credit;
6082   foreach my $cust_bill ( @invoices ) {
6083     my $amount;
6084
6085     if ( !defined($credit) || $credit->credited == 0) {
6086       $credit = pop @credits or last;
6087     }
6088
6089     if ($cust_bill->owed >= $credit->credited) {
6090       $amount=$credit->credited;
6091     }else{
6092       $amount=$cust_bill->owed;
6093     }
6094
6095     my $cust_credit_bill = new FS::cust_credit_bill ( {
6096       'crednum' => $credit->crednum,
6097       'invnum'  => $cust_bill->invnum,
6098       'amount'  => $amount,
6099     } );
6100     my $error = $cust_credit_bill->insert;
6101     if ( $error ) {
6102       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6103       die $error;
6104     }
6105
6106     redo if ($cust_bill->owed > 0);
6107
6108   }
6109
6110   my $total_unapplied_credits = $self->total_unapplied_credits;
6111
6112   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6113
6114   return $total_unapplied_credits;
6115 }
6116
6117 =item apply_payments
6118
6119 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6120 to outstanding invoice balances in chronological order.
6121
6122  #and returns the value of any remaining unapplied payments.
6123
6124 Dies if there is an error.
6125
6126 =cut
6127
6128 sub apply_payments {
6129   my $self = shift;
6130
6131   local $SIG{HUP} = 'IGNORE';
6132   local $SIG{INT} = 'IGNORE';
6133   local $SIG{QUIT} = 'IGNORE';
6134   local $SIG{TERM} = 'IGNORE';
6135   local $SIG{TSTP} = 'IGNORE';
6136   local $SIG{PIPE} = 'IGNORE';
6137
6138   my $oldAutoCommit = $FS::UID::AutoCommit;
6139   local $FS::UID::AutoCommit = 0;
6140   my $dbh = dbh;
6141
6142   $self->select_for_update; #mutex
6143
6144   #return 0 unless
6145
6146   my @payments = sort { $b->_date <=> $a->_date }
6147                  grep { $_->unapplied > 0 }
6148                  $self->cust_pay;
6149
6150   my @invoices = sort { $a->_date <=> $b->_date}
6151                  grep { $_->owed > 0 }
6152                  $self->cust_bill;
6153
6154   my $payment;
6155
6156   foreach my $cust_bill ( @invoices ) {
6157     my $amount;
6158
6159     if ( !defined($payment) || $payment->unapplied == 0 ) {
6160       $payment = pop @payments or last;
6161     }
6162
6163     if ( $cust_bill->owed >= $payment->unapplied ) {
6164       $amount = $payment->unapplied;
6165     } else {
6166       $amount = $cust_bill->owed;
6167     }
6168
6169     my $cust_bill_pay = new FS::cust_bill_pay ( {
6170       'paynum' => $payment->paynum,
6171       'invnum' => $cust_bill->invnum,
6172       'amount' => $amount,
6173     } );
6174     my $error = $cust_bill_pay->insert;
6175     if ( $error ) {
6176       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6177       die $error;
6178     }
6179
6180     redo if ( $cust_bill->owed > 0);
6181
6182   }
6183
6184   my $total_unapplied_payments = $self->total_unapplied_payments;
6185
6186   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6187
6188   return $total_unapplied_payments;
6189 }
6190
6191 =item total_owed
6192
6193 Returns the total owed for this customer on all invoices
6194 (see L<FS::cust_bill/owed>).
6195
6196 =cut
6197
6198 sub total_owed {
6199   my $self = shift;
6200   $self->total_owed_date(2145859200); #12/31/2037
6201 }
6202
6203 =item total_owed_date TIME
6204
6205 Returns the total owed for this customer on all invoices with date earlier than
6206 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6207 see L<Time::Local> and L<Date::Parse> for conversion functions.
6208
6209 =cut
6210
6211 sub total_owed_date {
6212   my $self = shift;
6213   my $time = shift;
6214
6215 #  my $custnum = $self->custnum;
6216 #
6217 #  my $owed_sql = FS::cust_bill->owed_sql;
6218 #
6219 #  my $sql = "
6220 #    SELECT SUM($owed_sql) FROM cust_bill
6221 #      WHERE custnum = $custnum
6222 #        AND _date <= $time
6223 #  ";
6224 #
6225 #  my $sth = dbh->prepare($sql) or die dbh->errstr;
6226 #  $sth->execute() or die $sth->errstr;
6227 #
6228 #  return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6229
6230   my $total_bill = 0;
6231   foreach my $cust_bill (
6232     grep { $_->_date <= $time }
6233       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6234   ) {
6235     $total_bill += $cust_bill->owed;
6236   }
6237   sprintf( "%.2f", $total_bill );
6238
6239 }
6240
6241 =item total_paid
6242
6243 Returns the total amount of all payments.
6244
6245 =cut
6246
6247 sub total_paid {
6248   my $self = shift;
6249   my $total = 0;
6250   $total += $_->paid foreach $self->cust_pay;
6251   sprintf( "%.2f", $total );
6252 }
6253
6254 =item total_unapplied_credits
6255
6256 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6257 customer.  See L<FS::cust_credit/credited>.
6258
6259 =item total_credited
6260
6261 Old name for total_unapplied_credits.  Don't use.
6262
6263 =cut
6264
6265 sub total_credited {
6266   #carp "total_credited deprecated, use total_unapplied_credits";
6267   shift->total_unapplied_credits(@_);
6268 }
6269
6270 sub total_unapplied_credits {
6271   my $self = shift;
6272   my $total_credit = 0;
6273   $total_credit += $_->credited foreach $self->cust_credit;
6274   sprintf( "%.2f", $total_credit );
6275 }
6276
6277 =item total_unapplied_payments
6278
6279 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6280 See L<FS::cust_pay/unapplied>.
6281
6282 =cut
6283
6284 sub total_unapplied_payments {
6285   my $self = shift;
6286   my $total_unapplied = 0;
6287   $total_unapplied += $_->unapplied foreach $self->cust_pay;
6288   sprintf( "%.2f", $total_unapplied );
6289 }
6290
6291 =item total_unapplied_refunds
6292
6293 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6294 customer.  See L<FS::cust_refund/unapplied>.
6295
6296 =cut
6297
6298 sub total_unapplied_refunds {
6299   my $self = shift;
6300   my $total_unapplied = 0;
6301   $total_unapplied += $_->unapplied foreach $self->cust_refund;
6302   sprintf( "%.2f", $total_unapplied );
6303 }
6304
6305 =item balance
6306
6307 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6308 total_unapplied_credits minus total_unapplied_payments).
6309
6310 =cut
6311
6312 sub balance {
6313   my $self = shift;
6314   sprintf( "%.2f",
6315       $self->total_owed
6316     + $self->total_unapplied_refunds
6317     - $self->total_unapplied_credits
6318     - $self->total_unapplied_payments
6319   );
6320 }
6321
6322 =item balance_date TIME
6323
6324 Returns the balance for this customer, only considering invoices with date
6325 earlier than TIME (total_owed_date minus total_credited minus
6326 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6327 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6328 functions.
6329
6330 =cut
6331
6332 sub balance_date {
6333   my $self = shift;
6334   my $time = shift;
6335   sprintf( "%.2f",
6336         $self->total_owed_date($time)
6337       + $self->total_unapplied_refunds
6338       - $self->total_unapplied_credits
6339       - $self->total_unapplied_payments
6340   );
6341 }
6342
6343 =item in_transit_payments
6344
6345 Returns the total of requests for payments for this customer pending in
6346 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6347
6348 =cut
6349
6350 sub in_transit_payments {
6351   my $self = shift;
6352   my $in_transit_payments = 0;
6353   foreach my $pay_batch ( qsearch('pay_batch', {
6354     'status' => 'I',
6355   } ) ) {
6356     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6357       'batchnum' => $pay_batch->batchnum,
6358       'custnum' => $self->custnum,
6359     } ) ) {
6360       $in_transit_payments += $cust_pay_batch->amount;
6361     }
6362   }
6363   sprintf( "%.2f", $in_transit_payments );
6364 }
6365
6366 =item payment_info
6367
6368 Returns a hash of useful information for making a payment.
6369
6370 =over 4
6371
6372 =item balance
6373
6374 Current balance.
6375
6376 =item payby
6377
6378 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6379 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6380 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6381
6382 =back
6383
6384 For credit card transactions:
6385
6386 =over 4
6387
6388 =item card_type 1
6389
6390 =item payname
6391
6392 Exact name on card
6393
6394 =back
6395
6396 For electronic check transactions:
6397
6398 =over 4
6399
6400 =item stateid_state
6401
6402 =back
6403
6404 =cut
6405
6406 sub payment_info {
6407   my $self = shift;
6408
6409   my %return = ();
6410
6411   $return{balance} = $self->balance;
6412
6413   $return{payname} = $self->payname
6414                      || ( $self->first. ' '. $self->get('last') );
6415
6416   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6417
6418   $return{payby} = $self->payby;
6419   $return{stateid_state} = $self->stateid_state;
6420
6421   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6422     $return{card_type} = cardtype($self->payinfo);
6423     $return{payinfo} = $self->paymask;
6424
6425     @return{'month', 'year'} = $self->paydate_monthyear;
6426
6427   }
6428
6429   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6430     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6431     $return{payinfo1} = $payinfo1;
6432     $return{payinfo2} = $payinfo2;
6433     $return{paytype}  = $self->paytype;
6434     $return{paystate} = $self->paystate;
6435
6436   }
6437
6438   #doubleclick protection
6439   my $_date = time;
6440   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6441
6442   %return;
6443
6444 }
6445
6446 =item paydate_monthyear
6447
6448 Returns a two-element list consisting of the month and year of this customer's
6449 paydate (credit card expiration date for CARD customers)
6450
6451 =cut
6452
6453 sub paydate_monthyear {
6454   my $self = shift;
6455   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6456     ( $2, $1 );
6457   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6458     ( $1, $3 );
6459   } else {
6460     ('', '');
6461   }
6462 }
6463
6464 =item tax_exemption TAXNAME
6465
6466 =cut
6467
6468 sub tax_exemption {
6469   my( $self, $taxname ) = @_;
6470
6471   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6472                                      'taxname' => $taxname,
6473                                    },
6474           );
6475 }
6476
6477 =item cust_main_exemption
6478
6479 =cut
6480
6481 sub cust_main_exemption {
6482   my $self = shift;
6483   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6484 }
6485
6486 =item invoicing_list [ ARRAYREF ]
6487
6488 If an arguement is given, sets these email addresses as invoice recipients
6489 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6490 (except as warnings), so use check_invoicing_list first.
6491
6492 Returns a list of email addresses (with svcnum entries expanded).
6493
6494 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6495 check it without disturbing anything by passing nothing.
6496
6497 This interface may change in the future.
6498
6499 =cut
6500
6501 sub invoicing_list {
6502   my( $self, $arrayref ) = @_;
6503
6504   if ( $arrayref ) {
6505     my @cust_main_invoice;
6506     if ( $self->custnum ) {
6507       @cust_main_invoice =
6508         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6509     } else {
6510       @cust_main_invoice = ();
6511     }
6512     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6513       #warn $cust_main_invoice->destnum;
6514       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6515         #warn $cust_main_invoice->destnum;
6516         my $error = $cust_main_invoice->delete;
6517         warn $error if $error;
6518       }
6519     }
6520     if ( $self->custnum ) {
6521       @cust_main_invoice =
6522         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6523     } else {
6524       @cust_main_invoice = ();
6525     }
6526     my %seen = map { $_->address => 1 } @cust_main_invoice;
6527     foreach my $address ( @{$arrayref} ) {
6528       next if exists $seen{$address} && $seen{$address};
6529       $seen{$address} = 1;
6530       my $cust_main_invoice = new FS::cust_main_invoice ( {
6531         'custnum' => $self->custnum,
6532         'dest'    => $address,
6533       } );
6534       my $error = $cust_main_invoice->insert;
6535       warn $error if $error;
6536     }
6537   }
6538
6539   if ( $self->custnum ) {
6540     map { $_->address }
6541       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6542   } else {
6543     ();
6544   }
6545
6546 }
6547
6548 =item check_invoicing_list ARRAYREF
6549
6550 Checks these arguements as valid input for the invoicing_list method.  If there
6551 is an error, returns the error, otherwise returns false.
6552
6553 =cut
6554
6555 sub check_invoicing_list {
6556   my( $self, $arrayref ) = @_;
6557
6558   foreach my $address ( @$arrayref ) {
6559
6560     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6561       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6562     }
6563
6564     my $cust_main_invoice = new FS::cust_main_invoice ( {
6565       'custnum' => $self->custnum,
6566       'dest'    => $address,
6567     } );
6568     my $error = $self->custnum
6569                 ? $cust_main_invoice->check
6570                 : $cust_main_invoice->checkdest
6571     ;
6572     return $error if $error;
6573
6574   }
6575
6576   return "Email address required"
6577     if $conf->exists('cust_main-require_invoicing_list_email')
6578     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6579
6580   '';
6581 }
6582
6583 =item set_default_invoicing_list
6584
6585 Sets the invoicing list to all accounts associated with this customer,
6586 overwriting any previous invoicing list.
6587
6588 =cut
6589
6590 sub set_default_invoicing_list {
6591   my $self = shift;
6592   $self->invoicing_list($self->all_emails);
6593 }
6594
6595 =item all_emails
6596
6597 Returns the email addresses of all accounts provisioned for this customer.
6598
6599 =cut
6600
6601 sub all_emails {
6602   my $self = shift;
6603   my %list;
6604   foreach my $cust_pkg ( $self->all_pkgs ) {
6605     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6606     my @svc_acct =
6607       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6608         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6609           @cust_svc;
6610     $list{$_}=1 foreach map { $_->email } @svc_acct;
6611   }
6612   keys %list;
6613 }
6614
6615 =item invoicing_list_addpost
6616
6617 Adds postal invoicing to this customer.  If this customer is already configured
6618 to receive postal invoices, does nothing.
6619
6620 =cut
6621
6622 sub invoicing_list_addpost {
6623   my $self = shift;
6624   return if grep { $_ eq 'POST' } $self->invoicing_list;
6625   my @invoicing_list = $self->invoicing_list;
6626   push @invoicing_list, 'POST';
6627   $self->invoicing_list(\@invoicing_list);
6628 }
6629
6630 =item invoicing_list_emailonly
6631
6632 Returns the list of email invoice recipients (invoicing_list without non-email
6633 destinations such as POST and FAX).
6634
6635 =cut
6636
6637 sub invoicing_list_emailonly {
6638   my $self = shift;
6639   warn "$me invoicing_list_emailonly called"
6640     if $DEBUG;
6641   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6642 }
6643
6644 =item invoicing_list_emailonly_scalar
6645
6646 Returns the list of email invoice recipients (invoicing_list without non-email
6647 destinations such as POST and FAX) as a comma-separated scalar.
6648
6649 =cut
6650
6651 sub invoicing_list_emailonly_scalar {
6652   my $self = shift;
6653   warn "$me invoicing_list_emailonly_scalar called"
6654     if $DEBUG;
6655   join(', ', $self->invoicing_list_emailonly);
6656 }
6657
6658 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6659
6660 Returns an array of customers referred by this customer (referral_custnum set
6661 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6662 customers referred by customers referred by this customer and so on, inclusive.
6663 The default behavior is DEPTH 1 (no recursion).
6664
6665 =cut
6666
6667 sub referral_cust_main {
6668   my $self = shift;
6669   my $depth = @_ ? shift : 1;
6670   my $exclude = @_ ? shift : {};
6671
6672   my @cust_main =
6673     map { $exclude->{$_->custnum}++; $_; }
6674       grep { ! $exclude->{ $_->custnum } }
6675         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6676
6677   if ( $depth > 1 ) {
6678     push @cust_main,
6679       map { $_->referral_cust_main($depth-1, $exclude) }
6680         @cust_main;
6681   }
6682
6683   @cust_main;
6684 }
6685
6686 =item referral_cust_main_ncancelled
6687
6688 Same as referral_cust_main, except only returns customers with uncancelled
6689 packages.
6690
6691 =cut
6692
6693 sub referral_cust_main_ncancelled {
6694   my $self = shift;
6695   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6696 }
6697
6698 =item referral_cust_pkg [ DEPTH ]
6699
6700 Like referral_cust_main, except returns a flat list of all unsuspended (and
6701 uncancelled) packages for each customer.  The number of items in this list may
6702 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6703
6704 =cut
6705
6706 sub referral_cust_pkg {
6707   my $self = shift;
6708   my $depth = @_ ? shift : 1;
6709
6710   map { $_->unsuspended_pkgs }
6711     grep { $_->unsuspended_pkgs }
6712       $self->referral_cust_main($depth);
6713 }
6714
6715 =item referring_cust_main
6716
6717 Returns the single cust_main record for the customer who referred this customer
6718 (referral_custnum), or false.
6719
6720 =cut
6721
6722 sub referring_cust_main {
6723   my $self = shift;
6724   return '' unless $self->referral_custnum;
6725   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6726 }
6727
6728 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6729
6730 Applies a credit to this customer.  If there is an error, returns the error,
6731 otherwise returns false.
6732
6733 REASON can be a text string, an FS::reason object, or a scalar reference to
6734 a reasonnum.  If a text string, it will be automatically inserted as a new
6735 reason, and a 'reason_type' option must be passed to indicate the
6736 FS::reason_type for the new reason.
6737
6738 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6739
6740 Any other options are passed to FS::cust_credit::insert.
6741
6742 =cut
6743
6744 sub credit {
6745   my( $self, $amount, $reason, %options ) = @_;
6746
6747   my $cust_credit = new FS::cust_credit {
6748     'custnum' => $self->custnum,
6749     'amount'  => $amount,
6750   };
6751
6752   if ( ref($reason) ) {
6753
6754     if ( ref($reason) eq 'SCALAR' ) {
6755       $cust_credit->reasonnum( $$reason );
6756     } else {
6757       $cust_credit->reasonnum( $reason->reasonnum );
6758     }
6759
6760   } else {
6761     $cust_credit->set('reason', $reason)
6762   }
6763
6764   $cust_credit->addlinfo( delete $options{'addlinfo'} )
6765     if exists($options{'addlinfo'});
6766
6767   $cust_credit->insert(%options);
6768
6769 }
6770
6771 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6772
6773 Creates a one-time charge for this customer.  If there is an error, returns
6774 the error, otherwise returns false.
6775
6776 New-style, with a hashref of options:
6777
6778   my $error = $cust_main->charge(
6779                                   {
6780                                     'amount'     => 54.32,
6781                                     'quantity'   => 1,
6782                                     'start_date' => str2time('7/4/2009'),
6783                                     'pkg'        => 'Description',
6784                                     'comment'    => 'Comment',
6785                                     'additional' => [], #extra invoice detail
6786                                     'classnum'   => 1,  #pkg_class
6787
6788                                     'setuptax'   => '', # or 'Y' for tax exempt
6789
6790                                     #internal taxation
6791                                     'taxclass'   => 'Tax class',
6792
6793                                     #vendor taxation
6794                                     'taxproduct' => 2,  #part_pkg_taxproduct
6795                                     'override'   => {}, #XXX describe
6796                                   }
6797                                 );
6798
6799 Old-style:
6800
6801   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6802
6803 =cut
6804
6805 sub charge {
6806   my $self = shift;
6807   my ( $amount, $quantity, $start_date, $classnum );
6808   my ( $pkg, $comment, $additional );
6809   my ( $setuptax, $taxclass );   #internal taxes
6810   my ( $taxproduct, $override ); #vendor (CCH) taxes
6811   if ( ref( $_[0] ) ) {
6812     $amount     = $_[0]->{amount};
6813     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6814     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6815     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6816     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6817                                            : '$'. sprintf("%.2f",$amount);
6818     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6819     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6820     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6821     $additional = $_[0]->{additional} || [];
6822     $taxproduct = $_[0]->{taxproductnum};
6823     $override   = { '' => $_[0]->{tax_override} };
6824   } else {
6825     $amount     = shift;
6826     $quantity   = 1;
6827     $start_date = '';
6828     $pkg        = @_ ? shift : 'One-time charge';
6829     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6830     $setuptax   = '';
6831     $taxclass   = @_ ? shift : '';
6832     $additional = [];
6833   }
6834
6835   local $SIG{HUP} = 'IGNORE';
6836   local $SIG{INT} = 'IGNORE';
6837   local $SIG{QUIT} = 'IGNORE';
6838   local $SIG{TERM} = 'IGNORE';
6839   local $SIG{TSTP} = 'IGNORE';
6840   local $SIG{PIPE} = 'IGNORE';
6841
6842   my $oldAutoCommit = $FS::UID::AutoCommit;
6843   local $FS::UID::AutoCommit = 0;
6844   my $dbh = dbh;
6845
6846   my $part_pkg = new FS::part_pkg ( {
6847     'pkg'           => $pkg,
6848     'comment'       => $comment,
6849     'plan'          => 'flat',
6850     'freq'          => 0,
6851     'disabled'      => 'Y',
6852     'classnum'      => $classnum ? $classnum : '',
6853     'setuptax'      => $setuptax,
6854     'taxclass'      => $taxclass,
6855     'taxproductnum' => $taxproduct,
6856   } );
6857
6858   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6859                         ( 0 .. @$additional - 1 )
6860                   ),
6861                   'additional_count' => scalar(@$additional),
6862                   'setup_fee' => $amount,
6863                 );
6864
6865   my $error = $part_pkg->insert( options       => \%options,
6866                                  tax_overrides => $override,
6867                                );
6868   if ( $error ) {
6869     $dbh->rollback if $oldAutoCommit;
6870     return $error;
6871   }
6872
6873   my $pkgpart = $part_pkg->pkgpart;
6874   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6875   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6876     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6877     $error = $type_pkgs->insert;
6878     if ( $error ) {
6879       $dbh->rollback if $oldAutoCommit;
6880       return $error;
6881     }
6882   }
6883
6884   my $cust_pkg = new FS::cust_pkg ( {
6885     'custnum'    => $self->custnum,
6886     'pkgpart'    => $pkgpart,
6887     'quantity'   => $quantity,
6888     'start_date' => $start_date,
6889   } );
6890
6891   $error = $cust_pkg->insert;
6892   if ( $error ) {
6893     $dbh->rollback if $oldAutoCommit;
6894     return $error;
6895   }
6896
6897   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6898   '';
6899
6900 }
6901
6902 #=item charge_postal_fee
6903 #
6904 #Applies a one time charge this customer.  If there is an error,
6905 #returns the error, returns the cust_pkg charge object or false
6906 #if there was no charge.
6907 #
6908 #=cut
6909 #
6910 # This should be a customer event.  For that to work requires that bill
6911 # also be a customer event.
6912
6913 sub charge_postal_fee {
6914   my $self = shift;
6915
6916   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6917   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6918
6919   my $cust_pkg = new FS::cust_pkg ( {
6920     'custnum'  => $self->custnum,
6921     'pkgpart'  => $pkgpart,
6922     'quantity' => 1,
6923   } );
6924
6925   my $error = $cust_pkg->insert;
6926   $error ? $error : $cust_pkg;
6927 }
6928
6929 =item cust_bill
6930
6931 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6932
6933 =cut
6934
6935 sub cust_bill {
6936   my $self = shift;
6937   sort { $a->_date <=> $b->_date }
6938     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6939 }
6940
6941 =item open_cust_bill
6942
6943 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6944 customer.
6945
6946 =cut
6947
6948 sub open_cust_bill {
6949   my $self = shift;
6950
6951   qsearch({
6952     'table'     => 'cust_bill',
6953     'hashref'   => { 'custnum' => $self->custnum, },
6954     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6955     'order_by'  => 'ORDER BY _date ASC',
6956   });
6957
6958 }
6959
6960 =item cust_credit
6961
6962 Returns all the credits (see L<FS::cust_credit>) for this customer.
6963
6964 =cut
6965
6966 sub cust_credit {
6967   my $self = shift;
6968   sort { $a->_date <=> $b->_date }
6969     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6970 }
6971
6972 =item cust_pay
6973
6974 Returns all the payments (see L<FS::cust_pay>) for this customer.
6975
6976 =cut
6977
6978 sub cust_pay {
6979   my $self = shift;
6980   sort { $a->_date <=> $b->_date }
6981     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6982 }
6983
6984 =item cust_pay_void
6985
6986 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6987
6988 =cut
6989
6990 sub cust_pay_void {
6991   my $self = shift;
6992   sort { $a->_date <=> $b->_date }
6993     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6994 }
6995
6996 =item cust_pay_batch
6997
6998 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6999
7000 =cut
7001
7002 sub cust_pay_batch {
7003   my $self = shift;
7004   sort { $a->paybatchnum <=> $b->paybatchnum }
7005     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7006 }
7007
7008 =item cust_pay_pending
7009
7010 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7011 (without status "done").
7012
7013 =cut
7014
7015 sub cust_pay_pending {
7016   my $self = shift;
7017   return $self->num_cust_pay_pending unless wantarray;
7018   sort { $a->_date <=> $b->_date }
7019     qsearch( 'cust_pay_pending', {
7020                                    'custnum' => $self->custnum,
7021                                    'status'  => { op=>'!=', value=>'done' },
7022                                  },
7023            );
7024 }
7025
7026 =item num_cust_pay_pending
7027
7028 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7029 customer (without status "done").  Also called automatically when the
7030 cust_pay_pending method is used in a scalar context.
7031
7032 =cut
7033
7034 sub num_cust_pay_pending {
7035   my $self = shift;
7036   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7037             "   WHERE custnum = ? AND status != 'done' ";
7038   my $sth = dbh->prepare($sql) or die dbh->errstr;
7039   $sth->execute($self->custnum) or die $sth->errstr;
7040   $sth->fetchrow_arrayref->[0];
7041 }
7042
7043 =item cust_refund
7044
7045 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7046
7047 =cut
7048
7049 sub cust_refund {
7050   my $self = shift;
7051   sort { $a->_date <=> $b->_date }
7052     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7053 }
7054
7055 =item display_custnum
7056
7057 Returns the displayed customer number for this customer: agent_custid if
7058 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7059
7060 =cut
7061
7062 sub display_custnum {
7063   my $self = shift;
7064   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7065     return $self->agent_custid;
7066   } else {
7067     return $self->custnum;
7068   }
7069 }
7070
7071 =item name
7072
7073 Returns a name string for this customer, either "Company (Last, First)" or
7074 "Last, First".
7075
7076 =cut
7077
7078 sub name {
7079   my $self = shift;
7080   my $name = $self->contact;
7081   $name = $self->company. " ($name)" if $self->company;
7082   $name;
7083 }
7084
7085 =item ship_name
7086
7087 Returns a name string for this (service/shipping) contact, either
7088 "Company (Last, First)" or "Last, First".
7089
7090 =cut
7091
7092 sub ship_name {
7093   my $self = shift;
7094   if ( $self->get('ship_last') ) {
7095     my $name = $self->ship_contact;
7096     $name = $self->ship_company. " ($name)" if $self->ship_company;
7097     $name;
7098   } else {
7099     $self->name;
7100   }
7101 }
7102
7103 =item name_short
7104
7105 Returns a name string for this customer, either "Company" or "First Last".
7106
7107 =cut
7108
7109 sub name_short {
7110   my $self = shift;
7111   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7112 }
7113
7114 =item ship_name_short
7115
7116 Returns a name string for this (service/shipping) contact, either "Company"
7117 or "First Last".
7118
7119 =cut
7120
7121 sub ship_name_short {
7122   my $self = shift;
7123   if ( $self->get('ship_last') ) {
7124     $self->ship_company !~ /^\s*$/
7125       ? $self->ship_company
7126       : $self->ship_contact_firstlast;
7127   } else {
7128     $self->name_company_or_firstlast;
7129   }
7130 }
7131
7132 =item contact
7133
7134 Returns this customer's full (billing) contact name only, "Last, First"
7135
7136 =cut
7137
7138 sub contact {
7139   my $self = shift;
7140   $self->get('last'). ', '. $self->first;
7141 }
7142
7143 =item ship_contact
7144
7145 Returns this customer's full (shipping) contact name only, "Last, First"
7146
7147 =cut
7148
7149 sub ship_contact {
7150   my $self = shift;
7151   $self->get('ship_last')
7152     ? $self->get('ship_last'). ', '. $self->ship_first
7153     : $self->contact;
7154 }
7155
7156 =item contact_firstlast
7157
7158 Returns this customers full (billing) contact name only, "First Last".
7159
7160 =cut
7161
7162 sub contact_firstlast {
7163   my $self = shift;
7164   $self->first. ' '. $self->get('last');
7165 }
7166
7167 =item ship_contact_firstlast
7168
7169 Returns this customer's full (shipping) contact name only, "First Last".
7170
7171 =cut
7172
7173 sub ship_contact_firstlast {
7174   my $self = shift;
7175   $self->get('ship_last')
7176     ? $self->first. ' '. $self->get('ship_last')
7177     : $self->contact_firstlast;
7178 }
7179
7180 =item country_full
7181
7182 Returns this customer's full country name
7183
7184 =cut
7185
7186 sub country_full {
7187   my $self = shift;
7188   code2country($self->country);
7189 }
7190
7191 =item geocode DATA_VENDOR
7192
7193 Returns a value for the customer location as encoded by DATA_VENDOR.
7194 Currently this only makes sense for "CCH" as DATA_VENDOR.
7195
7196 =cut
7197
7198 sub geocode {
7199   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7200
7201   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7202   return $geocode if $geocode;
7203
7204   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7205                ? 'ship_'
7206                : '';
7207
7208   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7209     if $self->country eq 'US';
7210
7211   #CCH specific location stuff
7212   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7213
7214   my @cust_tax_location =
7215     qsearch( {
7216                'table'     => 'cust_tax_location',
7217                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7218                'extra_sql' => $extra_sql,
7219                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7220              }
7221            );
7222   $geocode = $cust_tax_location[0]->geocode
7223     if scalar(@cust_tax_location);
7224
7225   $geocode;
7226 }
7227
7228 =item cust_status
7229
7230 =item status
7231
7232 Returns a status string for this customer, currently:
7233
7234 =over 4
7235
7236 =item prospect - No packages have ever been ordered
7237
7238 =item active - One or more recurring packages is active
7239
7240 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7241
7242 =item suspended - All non-cancelled recurring packages are suspended
7243
7244 =item cancelled - All recurring packages are cancelled
7245
7246 =back
7247
7248 =cut
7249
7250 sub status { shift->cust_status(@_); }
7251
7252 sub cust_status {
7253   my $self = shift;
7254   for my $status (qw( prospect active inactive suspended cancelled )) {
7255     my $method = $status.'_sql';
7256     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7257     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7258     $sth->execute( ($self->custnum) x $numnum )
7259       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7260     return $status if $sth->fetchrow_arrayref->[0];
7261   }
7262 }
7263
7264 =item ucfirst_cust_status
7265
7266 =item ucfirst_status
7267
7268 Returns the status with the first character capitalized.
7269
7270 =cut
7271
7272 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7273
7274 sub ucfirst_cust_status {
7275   my $self = shift;
7276   ucfirst($self->cust_status);
7277 }
7278
7279 =item statuscolor
7280
7281 Returns a hex triplet color string for this customer's status.
7282
7283 =cut
7284
7285 use vars qw(%statuscolor);
7286 tie %statuscolor, 'Tie::IxHash',
7287   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7288   'active'    => '00CC00', #green
7289   'inactive'  => '0000CC', #blue
7290   'suspended' => 'FF9900', #yellow
7291   'cancelled' => 'FF0000', #red
7292 ;
7293
7294 sub statuscolor { shift->cust_statuscolor(@_); }
7295
7296 sub cust_statuscolor {
7297   my $self = shift;
7298   $statuscolor{$self->cust_status};
7299 }
7300
7301 =item tickets
7302
7303 Returns an array of hashes representing the customer's RT tickets.
7304
7305 =cut
7306
7307 sub tickets {
7308   my $self = shift;
7309
7310   my $num = $conf->config('cust_main-max_tickets') || 10;
7311   my @tickets = ();
7312
7313   if ( $conf->config('ticket_system') ) {
7314     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7315
7316       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7317
7318     } else {
7319
7320       foreach my $priority (
7321         $conf->config('ticket_system-custom_priority_field-values'), ''
7322       ) {
7323         last if scalar(@tickets) >= $num;
7324         push @tickets,
7325           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7326                                                  $num - scalar(@tickets),
7327                                                  $priority,
7328                                                )
7329            };
7330       }
7331     }
7332   }
7333   (@tickets);
7334 }
7335
7336 # Return services representing svc_accts in customer support packages
7337 sub support_services {
7338   my $self = shift;
7339   my %packages = map { $_ => 1 } $conf->config('support_packages');
7340
7341   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7342     grep { $_->part_svc->svcdb eq 'svc_acct' }
7343     map { $_->cust_svc }
7344     grep { exists $packages{ $_->pkgpart } }
7345     $self->ncancelled_pkgs;
7346
7347 }
7348
7349 =back
7350
7351 =head1 CLASS METHODS
7352
7353 =over 4
7354
7355 =item statuses
7356
7357 Class method that returns the list of possible status strings for customers
7358 (see L<the status method|/status>).  For example:
7359
7360   @statuses = FS::cust_main->statuses();
7361
7362 =cut
7363
7364 sub statuses {
7365   #my $self = shift; #could be class...
7366   keys %statuscolor;
7367 }
7368
7369 =item prospect_sql
7370
7371 Returns an SQL expression identifying prospective cust_main records (customers
7372 with no packages ever ordered)
7373
7374 =cut
7375
7376 use vars qw($select_count_pkgs);
7377 $select_count_pkgs =
7378   "SELECT COUNT(*) FROM cust_pkg
7379     WHERE cust_pkg.custnum = cust_main.custnum";
7380
7381 sub select_count_pkgs_sql {
7382   $select_count_pkgs;
7383 }
7384
7385 sub prospect_sql { "
7386   0 = ( $select_count_pkgs )
7387 "; }
7388
7389 =item active_sql
7390
7391 Returns an SQL expression identifying active cust_main records (customers with
7392 active recurring packages).
7393
7394 =cut
7395
7396 sub active_sql { "
7397   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7398       )
7399 "; }
7400
7401 =item inactive_sql
7402
7403 Returns an SQL expression identifying inactive cust_main records (customers with
7404 no active recurring packages, but otherwise unsuspended/uncancelled).
7405
7406 =cut
7407
7408 sub inactive_sql { "
7409   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7410   AND
7411   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7412 "; }
7413
7414 =item susp_sql
7415 =item suspended_sql
7416
7417 Returns an SQL expression identifying suspended cust_main records.
7418
7419 =cut
7420
7421
7422 sub suspended_sql { susp_sql(@_); }
7423 sub susp_sql { "
7424     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7425     AND
7426     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7427 "; }
7428
7429 =item cancel_sql
7430 =item cancelled_sql
7431
7432 Returns an SQL expression identifying cancelled cust_main records.
7433
7434 =cut
7435
7436 sub cancelled_sql { cancel_sql(@_); }
7437 sub cancel_sql {
7438
7439   my $recurring_sql = FS::cust_pkg->recurring_sql;
7440   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7441
7442   "
7443         0 < ( $select_count_pkgs )
7444     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7445     AND 0 = ( $select_count_pkgs AND $recurring_sql
7446                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7447             )
7448     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7449   ";
7450
7451 }
7452
7453 =item uncancel_sql
7454 =item uncancelled_sql
7455
7456 Returns an SQL expression identifying un-cancelled cust_main records.
7457
7458 =cut
7459
7460 sub uncancelled_sql { uncancel_sql(@_); }
7461 sub uncancel_sql { "
7462   ( 0 < ( $select_count_pkgs
7463                    AND ( cust_pkg.cancel IS NULL
7464                          OR cust_pkg.cancel = 0
7465                        )
7466         )
7467     OR 0 = ( $select_count_pkgs )
7468   )
7469 "; }
7470
7471 =item balance_sql
7472
7473 Returns an SQL fragment to retreive the balance.
7474
7475 =cut
7476
7477 sub balance_sql { "
7478     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7479         WHERE cust_bill.custnum   = cust_main.custnum     )
7480   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7481         WHERE cust_pay.custnum    = cust_main.custnum     )
7482   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7483         WHERE cust_credit.custnum = cust_main.custnum     )
7484   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7485         WHERE cust_refund.custnum = cust_main.custnum     )
7486 "; }
7487
7488 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7489
7490 Returns an SQL fragment to retreive the balance for this customer, only
7491 considering invoices with date earlier than START_TIME, and optionally not
7492 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7493 total_unapplied_payments).
7494
7495 Times are specified as SQL fragments or numeric
7496 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7497 L<Date::Parse> for conversion functions.  The empty string can be passed
7498 to disable that time constraint completely.
7499
7500 Available options are:
7501
7502 =over 4
7503
7504 =item unapplied_date
7505
7506 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)
7507
7508 =item total
7509
7510 (unused.  obsolete?)
7511 set to true to remove all customer comparison clauses, for totals
7512
7513 =item where
7514
7515 (unused.  obsolete?)
7516 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7517
7518 =item join
7519
7520 (unused.  obsolete?)
7521 JOIN clause (typically used with the total option)
7522
7523 =back
7524
7525 =cut
7526
7527 sub balance_date_sql {
7528   my( $class, $start, $end, %opt ) = @_;
7529
7530   my $owed         = FS::cust_bill->owed_sql;
7531   my $unapp_refund = FS::cust_refund->unapplied_sql;
7532   my $unapp_credit = FS::cust_credit->unapplied_sql;
7533   my $unapp_pay    = FS::cust_pay->unapplied_sql;
7534
7535   my $j = $opt{'join'} || '';
7536
7537   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7538   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7539   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7540   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7541
7542   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7543     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7544     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7545     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7546   ";
7547
7548 }
7549
7550 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7551
7552 Returns an SQL fragment to retreive the total unapplied payments for this
7553 customer, only considering invoices with date earlier than START_TIME, and
7554 optionally not later than END_TIME.
7555
7556 Times are specified as SQL fragments or numeric
7557 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7558 L<Date::Parse> for conversion functions.  The empty string can be passed
7559 to disable that time constraint completely.
7560
7561 Available options are:
7562
7563 =cut
7564
7565 sub unapplied_payments_date_sql {
7566   my( $class, $start, $end, ) = @_;
7567
7568   my $unapp_pay    = FS::cust_pay->unapplied_sql;
7569
7570   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7571                                                           'unapplied_date'=>1 );
7572
7573   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7574 }
7575
7576 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7577
7578 Helper method for balance_date_sql; name (and usage) subject to change
7579 (suggestions welcome).
7580
7581 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7582 cust_refund, cust_credit or cust_pay).
7583
7584 If TABLE is "cust_bill" or the unapplied_date option is true, only
7585 considers records with date earlier than START_TIME, and optionally not
7586 later than END_TIME .
7587
7588 =cut
7589
7590 sub _money_table_where {
7591   my( $class, $table, $start, $end, %opt ) = @_;
7592
7593   my @where = ();
7594   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7595   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7596     push @where, "$table._date <= $start" if defined($start) && length($start);
7597     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7598   }
7599   push @where, @{$opt{'where'}} if $opt{'where'};
7600   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7601
7602   $where;
7603
7604 }
7605
7606 =item search_sql HASHREF
7607
7608 (Class method)
7609
7610 Returns a qsearch hash expression to search for parameters specified in HREF.
7611 Valid parameters are
7612
7613 =over 4
7614
7615 =item agentnum
7616
7617 =item status
7618
7619 =item cancelled_pkgs
7620
7621 bool
7622
7623 =item signupdate
7624
7625 listref of start date, end date
7626
7627 =item payby
7628
7629 listref
7630
7631 =item current_balance
7632
7633 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7634
7635 =item cust_fields
7636
7637 =item flattened_pkgs
7638
7639 bool
7640
7641 =back
7642
7643 =cut
7644
7645 sub search_sql {
7646   my ($class, $params) = @_;
7647
7648   my $dbh = dbh;
7649
7650   my @where = ();
7651   my $orderby;
7652
7653   ##
7654   # parse agent
7655   ##
7656
7657   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7658     push @where,
7659       "cust_main.agentnum = $1";
7660   }
7661
7662   ##
7663   # parse status
7664   ##
7665
7666   #prospect active inactive suspended cancelled
7667   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7668     my $method = $params->{'status'}. '_sql';
7669     #push @where, $class->$method();
7670     push @where, FS::cust_main->$method();
7671   }
7672
7673   ##
7674   # parse cancelled package checkbox
7675   ##
7676
7677   my $pkgwhere = "";
7678
7679   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7680     unless $params->{'cancelled_pkgs'};
7681
7682   ##
7683   # parse without census tract checkbox
7684   ##
7685
7686   push @where, "(censustract = '' or censustract is null)"
7687     if $params->{'no_censustract'};
7688
7689   ##
7690   # dates
7691   ##
7692
7693   foreach my $field (qw( signupdate )) {
7694
7695     next unless exists($params->{$field});
7696
7697     my($beginning, $ending) = @{$params->{$field}};
7698
7699     push @where,
7700       "cust_main.$field IS NOT NULL",
7701       "cust_main.$field >= $beginning",
7702       "cust_main.$field <= $ending";
7703
7704     $orderby ||= "ORDER BY cust_main.$field";
7705
7706   }
7707
7708   ###
7709   # payby
7710   ###
7711
7712   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7713   if ( @payby ) {
7714     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7715   }
7716
7717   ##
7718   # amounts
7719   ##
7720
7721   #my $balance_sql = $class->balance_sql();
7722   my $balance_sql = FS::cust_main->balance_sql();
7723
7724   push @where, map { s/current_balance/$balance_sql/; $_ }
7725                    @{ $params->{'current_balance'} };
7726
7727   ##
7728   # custbatch
7729   ##
7730
7731   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7732     push @where,
7733       "cust_main.custbatch = '$1'";
7734   }
7735
7736   ##
7737   # setup queries, subs, etc. for the search
7738   ##
7739
7740   $orderby ||= 'ORDER BY custnum';
7741
7742   # here is the agent virtualization
7743   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7744
7745   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7746
7747   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
7748
7749   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7750
7751   my $select = join(', ',
7752                  'cust_main.custnum',
7753                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7754                );
7755
7756   my(@extra_headers) = ();
7757   my(@extra_fields)  = ();
7758
7759   if ($params->{'flattened_pkgs'}) {
7760
7761     if ($dbh->{Driver}->{Name} eq 'Pg') {
7762
7763       $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";
7764
7765     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7766       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7767       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7768     }else{
7769       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7770            "omitting packing information from report.";
7771     }
7772
7773     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";
7774
7775     my $sth = dbh->prepare($header_query) or die dbh->errstr;
7776     $sth->execute() or die $sth->errstr;
7777     my $headerrow = $sth->fetchrow_arrayref;
7778     my $headercount = $headerrow ? $headerrow->[0] : 0;
7779     while($headercount) {
7780       unshift @extra_headers, "Package ". $headercount;
7781       unshift @extra_fields, eval q!sub {my $c = shift;
7782                                          my @a = split '\|', $c->magic;
7783                                          my $p = $a[!.--$headercount. q!];
7784                                          $p;
7785                                         };!;
7786     }
7787
7788   }
7789
7790   my $sql_query = {
7791     'table'         => 'cust_main',
7792     'select'        => $select,
7793     'hashref'       => {},
7794     'extra_sql'     => $extra_sql,
7795     'order_by'      => $orderby,
7796     'count_query'   => $count_query,
7797     'extra_headers' => \@extra_headers,
7798     'extra_fields'  => \@extra_fields,
7799   };
7800
7801 }
7802
7803 =item email_search_sql HASHREF
7804
7805 (Class method)
7806
7807 Emails a notice to the specified customers.
7808
7809 Valid parameters are those of the L<search_sql> method, plus the following:
7810
7811 =over 4
7812
7813 =item from
7814
7815 From: address
7816
7817 =item subject
7818
7819 Email Subject:
7820
7821 =item html_body
7822
7823 HTML body
7824
7825 =item text_body
7826
7827 Text body
7828
7829 =item job
7830
7831 Optional job queue job for status updates.
7832
7833 =back
7834
7835 Returns an error message, or false for success.
7836
7837 If an error occurs during any email, stops the enture send and returns that
7838 error.  Presumably if you're getting SMTP errors aborting is better than
7839 retrying everything.
7840
7841 =cut
7842
7843 sub email_search_sql {
7844   my($class, $params) = @_;
7845
7846   my $from = delete $params->{from};
7847   my $subject = delete $params->{subject};
7848   my $html_body = delete $params->{html_body};
7849   my $text_body = delete $params->{text_body};
7850
7851   my $job = delete $params->{'job'};
7852
7853   my $sql_query = $class->search_sql($params);
7854
7855   my $count_query   = delete($sql_query->{'count_query'});
7856   my $count_sth = dbh->prepare($count_query)
7857     or die "Error preparing $count_query: ". dbh->errstr;
7858   $count_sth->execute
7859     or die "Error executing $count_query: ". $count_sth->errstr;
7860   my $count_arrayref = $count_sth->fetchrow_arrayref;
7861   my $num_cust = $count_arrayref->[0];
7862
7863   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7864   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
7865
7866
7867   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7868
7869   #eventually order+limit magic to reduce memory use?
7870   foreach my $cust_main ( qsearch($sql_query) ) {
7871
7872     my $to = $cust_main->invoicing_list_emailonly_scalar;
7873     next unless $to;
7874
7875     my $error = send_email(
7876       generate_email(
7877         'from'      => $from,
7878         'to'        => $to,
7879         'subject'   => $subject,
7880         'html_body' => $html_body,
7881         'text_body' => $text_body,
7882       )
7883     );
7884     return $error if $error;
7885
7886     if ( $job ) { #progressbar foo
7887       $num++;
7888       if ( time - $min_sec > $last ) {
7889         my $error = $job->update_statustext(
7890           int( 100 * $num / $num_cust )
7891         );
7892         die $error if $error;
7893         $last = time;
7894       }
7895     }
7896
7897   }
7898
7899   return '';
7900 }
7901
7902 use Storable qw(thaw);
7903 use Data::Dumper;
7904 use MIME::Base64;
7905 sub process_email_search_sql {
7906   my $job = shift;
7907   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7908
7909   my $param = thaw(decode_base64(shift));
7910   warn Dumper($param) if $DEBUG;
7911
7912   $param->{'job'} = $job;
7913
7914   my $error = FS::cust_main->email_search_sql( $param );
7915   die $error if $error;
7916
7917 }
7918
7919 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7920
7921 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7922 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
7923 appropriate ship_ field is also searched).
7924
7925 Additional options are the same as FS::Record::qsearch
7926
7927 =cut
7928
7929 sub fuzzy_search {
7930   my( $self, $fuzzy, $hash, @opt) = @_;
7931   #$self
7932   $hash ||= {};
7933   my @cust_main = ();
7934
7935   check_and_rebuild_fuzzyfiles();
7936   foreach my $field ( keys %$fuzzy ) {
7937
7938     my $all = $self->all_X($field);
7939     next unless scalar(@$all);
7940
7941     my %match = ();
7942     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7943
7944     my @fcust = ();
7945     foreach ( keys %match ) {
7946       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7947       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7948     }
7949     my %fsaw = ();
7950     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7951   }
7952
7953   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7954   my %saw = ();
7955   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7956
7957   @cust_main;
7958
7959 }
7960
7961 =item masked FIELD
7962
7963 Returns a masked version of the named field
7964
7965 =cut
7966
7967 sub masked {
7968 my ($self,$field) = @_;
7969
7970 # Show last four
7971
7972 'x'x(length($self->getfield($field))-4).
7973   substr($self->getfield($field), (length($self->getfield($field))-4));
7974
7975 }
7976
7977 =back
7978
7979 =head1 SUBROUTINES
7980
7981 =over 4
7982
7983 =item smart_search OPTION => VALUE ...
7984
7985 Accepts the following options: I<search>, the string to search for.  The string
7986 will be searched for as a customer number, phone number, name or company name,
7987 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7988 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7989 skip fuzzy matching when an exact match is found.
7990
7991 Any additional options are treated as an additional qualifier on the search
7992 (i.e. I<agentnum>).
7993
7994 Returns a (possibly empty) array of FS::cust_main objects.
7995
7996 =cut
7997
7998 sub smart_search {
7999   my %options = @_;
8000
8001   #here is the agent virtualization
8002   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8003
8004   my @cust_main = ();
8005
8006   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8007   my $search = delete $options{'search'};
8008   ( my $alphanum_search = $search ) =~ s/\W//g;
8009
8010   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8011
8012     #false laziness w/Record::ut_phone
8013     my $phonen = "$1-$2-$3";
8014     $phonen .= " x$4" if $4;
8015
8016     push @cust_main, qsearch( {
8017       'table'   => 'cust_main',
8018       'hashref' => { %options },
8019       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8020                      ' ( '.
8021                          join(' OR ', map "$_ = '$phonen'",
8022                                           qw( daytime night fax
8023                                               ship_daytime ship_night ship_fax )
8024                              ).
8025                      ' ) '.
8026                      " AND $agentnums_sql", #agent virtualization
8027     } );
8028
8029     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8030       #try looking for matches with extensions unless one was specified
8031
8032       push @cust_main, qsearch( {
8033         'table'   => 'cust_main',
8034         'hashref' => { %options },
8035         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8036                        ' ( '.
8037                            join(' OR ', map "$_ LIKE '$phonen\%'",
8038                                             qw( daytime night
8039                                                 ship_daytime ship_night )
8040                                ).
8041                        ' ) '.
8042                        " AND $agentnums_sql", #agent virtualization
8043       } );
8044
8045     }
8046
8047   # custnum search (also try agent_custid), with some tweaking options if your
8048   # legacy cust "numbers" have letters
8049   }
8050
8051   if ( $search =~ /^\s*(\d+)\s*$/
8052             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8053                  && $search =~ /^\s*(\w\w?\d+)\s*$/
8054                )
8055           )
8056   {
8057
8058     my $num = $1;
8059
8060     if ( $num <= 2147483647 ) { #need a bigint custnum?  wow.
8061       push @cust_main, qsearch( {
8062         'table'     => 'cust_main',
8063         'hashref'   => { 'custnum' => $num, %options },
8064         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8065       } );
8066     }
8067
8068     push @cust_main, qsearch( {
8069       'table'     => 'cust_main',
8070       'hashref'   => { 'agent_custid' => $num, %options },
8071       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8072     } );
8073
8074   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8075
8076     my($company, $last, $first) = ( $1, $2, $3 );
8077
8078     # "Company (Last, First)"
8079     #this is probably something a browser remembered,
8080     #so just do an exact search
8081
8082     foreach my $prefix ( '', 'ship_' ) {
8083       push @cust_main, qsearch( {
8084         'table'     => 'cust_main',
8085         'hashref'   => { $prefix.'first'   => $first,
8086                          $prefix.'last'    => $last,
8087                          $prefix.'company' => $company,
8088                          %options,
8089                        },
8090         'extra_sql' => " AND $agentnums_sql",
8091       } );
8092     }
8093
8094   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8095                                               # try (ship_){last,company}
8096
8097     my $value = lc($1);
8098
8099     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8100     # # full strings the browser remembers won't work
8101     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8102
8103     use Lingua::EN::NameParse;
8104     my $NameParse = new Lingua::EN::NameParse(
8105              auto_clean     => 1,
8106              allow_reversed => 1,
8107     );
8108
8109     my($last, $first) = ( '', '' );
8110     #maybe disable this too and just rely on NameParse?
8111     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8112
8113       ($last, $first) = ( $1, $2 );
8114
8115     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8116     } elsif ( ! $NameParse->parse($value) ) {
8117
8118       my %name = $NameParse->components;
8119       $first = $name{'given_name_1'};
8120       $last  = $name{'surname_1'};
8121
8122     }
8123
8124     if ( $first && $last ) {
8125
8126       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8127
8128       #exact
8129       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8130       $sql .= "
8131         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8132            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8133         )";
8134
8135       push @cust_main, qsearch( {
8136         'table'     => 'cust_main',
8137         'hashref'   => \%options,
8138         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8139       } );
8140
8141       # or it just be something that was typed in... (try that in a sec)
8142
8143     }
8144
8145     my $q_value = dbh->quote($value);
8146
8147     #exact
8148     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8149     $sql .= " (    LOWER(last)         = $q_value
8150                 OR LOWER(company)      = $q_value
8151                 OR LOWER(ship_last)    = $q_value
8152                 OR LOWER(ship_company) = $q_value
8153               )";
8154
8155     push @cust_main, qsearch( {
8156       'table'     => 'cust_main',
8157       'hashref'   => \%options,
8158       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8159     } );
8160
8161     #no exact match, trying substring/fuzzy
8162     #always do substring & fuzzy (unless they're explicity config'ed off)
8163     #getting complaints searches are not returning enough
8164     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8165
8166       #still some false laziness w/search_sql (was search/cust_main.cgi)
8167
8168       #substring
8169
8170       my @hashrefs = (
8171         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8172         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8173       );
8174
8175       if ( $first && $last ) {
8176
8177         push @hashrefs,
8178           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8179             'last'         => { op=>'ILIKE', value=>"%$last%" },
8180           },
8181           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8182             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8183           },
8184         ;
8185
8186       } else {
8187
8188         push @hashrefs,
8189           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8190           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8191         ;
8192       }
8193
8194       foreach my $hashref ( @hashrefs ) {
8195
8196         push @cust_main, qsearch( {
8197           'table'     => 'cust_main',
8198           'hashref'   => { %$hashref,
8199                            %options,
8200                          },
8201           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8202         } );
8203
8204       }
8205
8206       #fuzzy
8207       my @fuzopts = (
8208         \%options,                #hashref
8209         '',                       #select
8210         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8211       );
8212
8213       if ( $first && $last ) {
8214         push @cust_main, FS::cust_main->fuzzy_search(
8215           { 'last'   => $last,    #fuzzy hashref
8216             'first'  => $first }, #
8217           @fuzopts
8218         );
8219       }
8220       foreach my $field ( 'last', 'company' ) {
8221         push @cust_main,
8222           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8223       }
8224
8225     }
8226
8227   }
8228
8229   #eliminate duplicates
8230   my %saw = ();
8231   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8232
8233   @cust_main;
8234
8235 }
8236
8237 =item email_search
8238
8239 Accepts the following options: I<email>, the email address to search for.  The
8240 email address will be searched for as an email invoice destination and as an
8241 svc_acct account.
8242
8243 #Any additional options are treated as an additional qualifier on the search
8244 #(i.e. I<agentnum>).
8245
8246 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8247 none or one).
8248
8249 =cut
8250
8251 sub email_search {
8252   my %options = @_;
8253
8254   local($DEBUG) = 1;
8255
8256   my $email = delete $options{'email'};
8257
8258   #we're only being used by RT at the moment... no agent virtualization yet
8259   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8260
8261   my @cust_main = ();
8262
8263   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8264
8265     my ( $user, $domain ) = ( $1, $2 );
8266
8267     warn "$me smart_search: searching for $user in domain $domain"
8268       if $DEBUG;
8269
8270     push @cust_main,
8271       map $_->cust_main,
8272           qsearch( {
8273                      'table'     => 'cust_main_invoice',
8274                      'hashref'   => { 'dest' => $email },
8275                    }
8276                  );
8277
8278     push @cust_main,
8279       map  $_->cust_main,
8280       grep $_,
8281       map  $_->cust_svc->cust_pkg,
8282           qsearch( {
8283                      'table'     => 'svc_acct',
8284                      'hashref'   => { 'username' => $user, },
8285                      'extra_sql' =>
8286                        'AND ( SELECT domain FROM svc_domain
8287                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8288                             ) = '. dbh->quote($domain),
8289                    }
8290                  );
8291   }
8292
8293   my %saw = ();
8294   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8295
8296   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8297     if $DEBUG;
8298
8299   @cust_main;
8300
8301 }
8302
8303 =item check_and_rebuild_fuzzyfiles
8304
8305 =cut
8306
8307 use vars qw(@fuzzyfields);
8308 @fuzzyfields = ( 'last', 'first', 'company' );
8309
8310 sub check_and_rebuild_fuzzyfiles {
8311   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8312   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8313 }
8314
8315 =item rebuild_fuzzyfiles
8316
8317 =cut
8318
8319 sub rebuild_fuzzyfiles {
8320
8321   use Fcntl qw(:flock);
8322
8323   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8324   mkdir $dir, 0700 unless -d $dir;
8325
8326   foreach my $fuzzy ( @fuzzyfields ) {
8327
8328     open(LOCK,">>$dir/cust_main.$fuzzy")
8329       or die "can't open $dir/cust_main.$fuzzy: $!";
8330     flock(LOCK,LOCK_EX)
8331       or die "can't lock $dir/cust_main.$fuzzy: $!";
8332
8333     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8334       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8335
8336     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8337       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8338                              " WHERE $field != '' AND $field IS NOT NULL");
8339       $sth->execute or die $sth->errstr;
8340
8341       while ( my $row = $sth->fetchrow_arrayref ) {
8342         print CACHE $row->[0]. "\n";
8343       }
8344
8345     }
8346
8347     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8348
8349     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8350     close LOCK;
8351   }
8352
8353 }
8354
8355 =item all_X
8356
8357 =cut
8358
8359 sub all_X {
8360   my( $self, $field ) = @_;
8361   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8362   open(CACHE,"<$dir/cust_main.$field")
8363     or die "can't open $dir/cust_main.$field: $!";
8364   my @array = map { chomp; $_; } <CACHE>;
8365   close CACHE;
8366   \@array;
8367 }
8368
8369 =item append_fuzzyfiles LASTNAME COMPANY
8370
8371 =cut
8372
8373 sub append_fuzzyfiles {
8374   #my( $first, $last, $company ) = @_;
8375
8376   &check_and_rebuild_fuzzyfiles;
8377
8378   use Fcntl qw(:flock);
8379
8380   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8381
8382   foreach my $field (qw( first last company )) {
8383     my $value = shift;
8384
8385     if ( $value ) {
8386
8387       open(CACHE,">>$dir/cust_main.$field")
8388         or die "can't open $dir/cust_main.$field: $!";
8389       flock(CACHE,LOCK_EX)
8390         or die "can't lock $dir/cust_main.$field: $!";
8391
8392       print CACHE "$value\n";
8393
8394       flock(CACHE,LOCK_UN)
8395         or die "can't unlock $dir/cust_main.$field: $!";
8396       close CACHE;
8397     }
8398
8399   }
8400
8401   1;
8402 }
8403
8404 =item batch_charge
8405
8406 =cut
8407
8408 sub batch_charge {
8409   my $param = shift;
8410   #warn join('-',keys %$param);
8411   my $fh = $param->{filehandle};
8412   my @fields = @{$param->{fields}};
8413
8414   eval "use Text::CSV_XS;";
8415   die $@ if $@;
8416
8417   my $csv = new Text::CSV_XS;
8418   #warn $csv;
8419   #warn $fh;
8420
8421   my $imported = 0;
8422   #my $columns;
8423
8424   local $SIG{HUP} = 'IGNORE';
8425   local $SIG{INT} = 'IGNORE';
8426   local $SIG{QUIT} = 'IGNORE';
8427   local $SIG{TERM} = 'IGNORE';
8428   local $SIG{TSTP} = 'IGNORE';
8429   local $SIG{PIPE} = 'IGNORE';
8430
8431   my $oldAutoCommit = $FS::UID::AutoCommit;
8432   local $FS::UID::AutoCommit = 0;
8433   my $dbh = dbh;
8434
8435   #while ( $columns = $csv->getline($fh) ) {
8436   my $line;
8437   while ( defined($line=<$fh>) ) {
8438
8439     $csv->parse($line) or do {
8440       $dbh->rollback if $oldAutoCommit;
8441       return "can't parse: ". $csv->error_input();
8442     };
8443
8444     my @columns = $csv->fields();
8445     #warn join('-',@columns);
8446
8447     my %row = ();
8448     foreach my $field ( @fields ) {
8449       $row{$field} = shift @columns;
8450     }
8451
8452     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8453     unless ( $cust_main ) {
8454       $dbh->rollback if $oldAutoCommit;
8455       return "unknown custnum $row{'custnum'}";
8456     }
8457
8458     if ( $row{'amount'} > 0 ) {
8459       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8460       if ( $error ) {
8461         $dbh->rollback if $oldAutoCommit;
8462         return $error;
8463       }
8464       $imported++;
8465     } elsif ( $row{'amount'} < 0 ) {
8466       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8467                                       $row{'pkg'}                         );
8468       if ( $error ) {
8469         $dbh->rollback if $oldAutoCommit;
8470         return $error;
8471       }
8472       $imported++;
8473     } else {
8474       #hmm?
8475     }
8476
8477   }
8478
8479   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8480
8481   return "Empty file!" unless $imported;
8482
8483   ''; #no error
8484
8485 }
8486
8487 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8488
8489 Sends a templated email notification to the customer (see L<Text::Template>).
8490
8491 OPTIONS is a hash and may include
8492
8493 I<from> - the email sender (default is invoice_from)
8494
8495 I<to> - comma-separated scalar or arrayref of recipients
8496    (default is invoicing_list)
8497
8498 I<subject> - The subject line of the sent email notification
8499    (default is "Notice from company_name")
8500
8501 I<extra_fields> - a hashref of name/value pairs which will be substituted
8502    into the template
8503
8504 The following variables are vavailable in the template.
8505
8506 I<$first> - the customer first name
8507 I<$last> - the customer last name
8508 I<$company> - the customer company
8509 I<$payby> - a description of the method of payment for the customer
8510             # would be nice to use FS::payby::shortname
8511 I<$payinfo> - the account information used to collect for this customer
8512 I<$expdate> - the expiration of the customer payment in seconds from epoch
8513
8514 =cut
8515
8516 sub notify {
8517   my ($self, $template, %options) = @_;
8518
8519   return unless $conf->exists($template);
8520
8521   my $from = $conf->config('invoice_from', $self->agentnum)
8522     if $conf->exists('invoice_from', $self->agentnum);
8523   $from = $options{from} if exists($options{from});
8524
8525   my $to = join(',', $self->invoicing_list_emailonly);
8526   $to = $options{to} if exists($options{to});
8527
8528   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8529     if $conf->exists('company_name', $self->agentnum);
8530   $subject = $options{subject} if exists($options{subject});
8531
8532   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8533                                             SOURCE => [ map "$_\n",
8534                                               $conf->config($template)]
8535                                            )
8536     or die "can't create new Text::Template object: Text::Template::ERROR";
8537   $notify_template->compile()
8538     or die "can't compile template: Text::Template::ERROR";
8539
8540   $FS::notify_template::_template::company_name =
8541     $conf->config('company_name', $self->agentnum);
8542   $FS::notify_template::_template::company_address =
8543     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8544
8545   my $paydate = $self->paydate || '2037-12-31';
8546   $FS::notify_template::_template::first = $self->first;
8547   $FS::notify_template::_template::last = $self->last;
8548   $FS::notify_template::_template::company = $self->company;
8549   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8550   my $payby = $self->payby;
8551   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8552   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8553
8554   #credit cards expire at the end of the month/year of their exp date
8555   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8556     $FS::notify_template::_template::payby = 'credit card';
8557     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8558     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8559     $expire_time--;
8560   }elsif ($payby eq 'COMP') {
8561     $FS::notify_template::_template::payby = 'complimentary account';
8562   }else{
8563     $FS::notify_template::_template::payby = 'current method';
8564   }
8565   $FS::notify_template::_template::expdate = $expire_time;
8566
8567   for (keys %{$options{extra_fields}}){
8568     no strict "refs";
8569     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8570   }
8571
8572   send_email(from => $from,
8573              to => $to,
8574              subject => $subject,
8575              body => $notify_template->fill_in( PACKAGE =>
8576                                                 'FS::notify_template::_template'                                              ),
8577             );
8578
8579 }
8580
8581 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8582
8583 Generates a templated notification to the customer (see L<Text::Template>).
8584
8585 OPTIONS is a hash and may include
8586
8587 I<extra_fields> - a hashref of name/value pairs which will be substituted
8588    into the template.  These values may override values mentioned below
8589    and those from the customer record.
8590
8591 The following variables are available in the template instead of or in addition
8592 to the fields of the customer record.
8593
8594 I<$payby> - a description of the method of payment for the customer
8595             # would be nice to use FS::payby::shortname
8596 I<$payinfo> - the masked account information used to collect for this customer
8597 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8598 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8599
8600 =cut
8601
8602 sub generate_letter {
8603   my ($self, $template, %options) = @_;
8604
8605   return unless $conf->exists($template);
8606
8607   my $letter_template = new Text::Template
8608                         ( TYPE       => 'ARRAY',
8609                           SOURCE     => [ map "$_\n", $conf->config($template)],
8610                           DELIMITERS => [ '[@--', '--@]' ],
8611                         )
8612     or die "can't create new Text::Template object: Text::Template::ERROR";
8613
8614   $letter_template->compile()
8615     or die "can't compile template: Text::Template::ERROR";
8616
8617   my %letter_data = map { $_ => $self->$_ } $self->fields;
8618   $letter_data{payinfo} = $self->mask_payinfo;
8619
8620   #my $paydate = $self->paydate || '2037-12-31';
8621   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8622
8623   my $payby = $self->payby;
8624   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8625   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8626
8627   #credit cards expire at the end of the month/year of their exp date
8628   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8629     $letter_data{payby} = 'credit card';
8630     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8631     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8632     $expire_time--;
8633   }elsif ($payby eq 'COMP') {
8634     $letter_data{payby} = 'complimentary account';
8635   }else{
8636     $letter_data{payby} = 'current method';
8637   }
8638   $letter_data{expdate} = $expire_time;
8639
8640   for (keys %{$options{extra_fields}}){
8641     $letter_data{$_} = $options{extra_fields}->{$_};
8642   }
8643
8644   unless(exists($letter_data{returnaddress})){
8645     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8646                                                   $self->agent_template)
8647                      );
8648     if ( length($retadd) ) {
8649       $letter_data{returnaddress} = $retadd;
8650     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8651       $letter_data{returnaddress} =
8652         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8653                           $conf->config('company_address', $self->agentnum)
8654         );
8655     } else {
8656       $letter_data{returnaddress} = '~';
8657     }
8658   }
8659
8660   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8661
8662   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8663
8664   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8665   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8666                            DIR      => $dir,
8667                            SUFFIX   => '.tex',
8668                            UNLINK   => 0,
8669                          ) or die "can't open temp file: $!\n";
8670
8671   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8672   close $fh;
8673   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8674   return $1;
8675 }
8676
8677 =item print_ps TEMPLATE
8678
8679 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8680
8681 =cut
8682
8683 sub print_ps {
8684   my $self = shift;
8685   my $file = $self->generate_letter(@_);
8686   FS::Misc::generate_ps($file);
8687 }
8688
8689 =item print TEMPLATE
8690
8691 Prints the filled in template.
8692
8693 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8694
8695 =cut
8696
8697 sub queueable_print {
8698   my %opt = @_;
8699
8700   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8701     or die "invalid customer number: " . $opt{custvnum};
8702
8703   my $error = $self->print( $opt{template} );
8704   die $error if $error;
8705 }
8706
8707 sub print {
8708   my ($self, $template) = (shift, shift);
8709   do_print [ $self->print_ps($template) ];
8710 }
8711
8712 #these three subs should just go away once agent stuff is all config overrides
8713
8714 sub agent_template {
8715   my $self = shift;
8716   $self->_agent_plandata('agent_templatename');
8717 }
8718
8719 sub agent_invoice_from {
8720   my $self = shift;
8721   $self->_agent_plandata('agent_invoice_from');
8722 }
8723
8724 sub _agent_plandata {
8725   my( $self, $option ) = @_;
8726
8727   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
8728   #agent-specific Conf
8729
8730   use FS::part_event::Condition;
8731
8732   my $agentnum = $self->agentnum;
8733
8734   my $regexp = '';
8735   if ( driver_name =~ /^Pg/i ) {
8736     $regexp = '~';
8737   } elsif ( driver_name =~ /^mysql/i ) {
8738     $regexp = 'REGEXP';
8739   } else {
8740     die "don't know how to use regular expressions in ". driver_name. " databases";
8741   }
8742
8743   my $part_event_option =
8744     qsearchs({
8745       'select'    => 'part_event_option.*',
8746       'table'     => 'part_event_option',
8747       'addl_from' => q{
8748         LEFT JOIN part_event USING ( eventpart )
8749         LEFT JOIN part_event_option AS peo_agentnum
8750           ON ( part_event.eventpart = peo_agentnum.eventpart
8751                AND peo_agentnum.optionname = 'agentnum'
8752                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8753              )
8754         LEFT JOIN part_event_condition
8755           ON ( part_event.eventpart = part_event_condition.eventpart
8756                AND part_event_condition.conditionname = 'cust_bill_age'
8757              )
8758         LEFT JOIN part_event_condition_option
8759           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8760                AND part_event_condition_option.optionname = 'age'
8761              )
8762       },
8763       #'hashref'   => { 'optionname' => $option },
8764       #'hashref'   => { 'part_event_option.optionname' => $option },
8765       'extra_sql' =>
8766         " WHERE part_event_option.optionname = ". dbh->quote($option).
8767         " AND action = 'cust_bill_send_agent' ".
8768         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8769         " AND peo_agentnum.optionname = 'agentnum' ".
8770         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8771         " ORDER BY
8772            CASE WHEN part_event_condition_option.optionname IS NULL
8773            THEN -1
8774            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8775         " END
8776           , part_event.weight".
8777         " LIMIT 1"
8778     });
8779
8780   unless ( $part_event_option ) {
8781     return $self->agent->invoice_template || ''
8782       if $option eq 'agent_templatename';
8783     return '';
8784   }
8785
8786   $part_event_option->optionvalue;
8787
8788 }
8789
8790 sub queued_bill {
8791   ## actual sub, not a method, designed to be called from the queue.
8792   ## sets up the customer, and calls the bill_and_collect
8793   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8794   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8795       $cust_main->bill_and_collect(
8796         %args,
8797       );
8798 }
8799
8800 sub _upgrade_data { #class method
8801   my ($class, %opts) = @_;
8802
8803   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8804   my $sth = dbh->prepare($sql) or die dbh->errstr;
8805   $sth->execute or die $sth->errstr;
8806
8807 }
8808
8809 =back
8810
8811 =head1 BUGS
8812
8813 The delete method.
8814
8815 The delete method should possibly take an FS::cust_main object reference
8816 instead of a scalar customer number.
8817
8818 Bill and collect options should probably be passed as references instead of a
8819 list.
8820
8821 There should probably be a configuration file with a list of allowed credit
8822 card types.
8823
8824 No multiple currency support (probably a larger project than just this module).
8825
8826 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8827
8828 Birthdates rely on negative epoch values.
8829
8830 The payby for card/check batches is broken.  With mixed batching, bad
8831 things will happen.
8832
8833 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8834
8835 =head1 SEE ALSO
8836
8837 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8838 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8839 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
8840
8841 =cut
8842
8843 1;
8844