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