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