FS/FS/cust_main.pm

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