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 Optional terms to be printed on this invoice.  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( state county 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 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 the value defined by the business-onlinepayment-description configuration
3856 option, or "Internet services" if that is unset.
3857
3858 If an I<invnum> is specified, this payment (if successful) is applied to the
3859 specified invoice.  If you don't specify an I<invnum> you might want to
3860 call the B<apply_payments> method or set the I<apply> option.
3861
3862 I<apply> can be set to true to apply a resulting payment.
3863
3864 I<quiet> can be set true to surpress email decline notices.
3865
3866 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3867 resulting paynum, if any.
3868
3869 I<payunique> is a unique identifier for this payment.
3870
3871 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3872
3873 =cut
3874
3875 sub realtime_bop {
3876   my $self = shift;
3877
3878   return $self->_new_realtime_bop(@_)
3879     if $self->_new_bop_required();
3880
3881   my($method, $amount);
3882   my %options = ();
3883   if (ref($_[0]) eq 'HASH') {
3884     %options = %{$_[0]};
3885     $method = $options{method};
3886     $amount = $options{amount};
3887   } else {
3888     ( $method, $amount ) = ( shift, shift );
3889     %options = @_;
3890   }
3891   if ( $DEBUG ) {
3892     warn "$me realtime_bop: $method $amount\n";
3893     warn "  $_ => $options{$_}\n" foreach keys %options;
3894   }
3895
3896   unless ( $options{'description'} ) {
3897     if ( $conf->exists('business-onlinepayment-description') ) {
3898       my $dtempl = $conf->config('business-onlinepayment-description');
3899
3900       my $agent = $self->agent->agent;
3901       #$pkgs... not here
3902       $options{'description'} = eval qq("$dtempl");
3903     } else {
3904       $options{'description'} = 'Internet services';
3905     }
3906   }
3907
3908   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3909
3910   eval "use Business::OnlinePayment";
3911   die $@ if $@;
3912
3913   my $payinfo = exists($options{'payinfo'})
3914                   ? $options{'payinfo'}
3915                   : $self->payinfo;
3916
3917   my %method2payby = (
3918     'CC'     => 'CARD',
3919     'ECHECK' => 'CHEK',
3920     'LEC'    => 'LECB',
3921   );
3922
3923   ###
3924   # check for banned credit card/ACH
3925   ###
3926
3927   my $ban = qsearchs('banned_pay', {
3928     'payby'   => $method2payby{$method},
3929     'payinfo' => md5_base64($payinfo),
3930   } );
3931   return "Banned credit card" if $ban;
3932
3933   ###
3934   # set taxclass and trans_is_recur based on invnum if there is one
3935   ###
3936
3937   my $taxclass = '';
3938   my $trans_is_recur = 0;
3939   if ( $options{'invnum'} ) {
3940
3941     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3942     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3943
3944     my @part_pkg =
3945       map  { $_->part_pkg }
3946       grep { $_ }
3947       map  { $_->cust_pkg }
3948       $cust_bill->cust_bill_pkg;
3949
3950     my @taxclasses = map $_->taxclass, @part_pkg;
3951     $taxclass = $taxclasses[0]
3952       unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
3953                                                         #different taxclasses
3954     $trans_is_recur = 1
3955       if grep { $_->freq ne '0' } @part_pkg;
3956
3957   }
3958
3959   ###
3960   # select a gateway
3961   ###
3962
3963   #look for an agent gateway override first
3964   my $cardtype;
3965   if ( $method eq 'CC' ) {
3966     $cardtype = cardtype($payinfo);
3967   } elsif ( $method eq 'ECHECK' ) {
3968     $cardtype = 'ACH';
3969   } else {
3970     $cardtype = $method;
3971   }
3972
3973   my $override =
3974        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3975                                            cardtype => $cardtype,
3976                                            taxclass => $taxclass,       } )
3977     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3978                                            cardtype => '',
3979                                            taxclass => $taxclass,       } )
3980     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3981                                            cardtype => $cardtype,
3982                                            taxclass => '',              } )
3983     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3984                                            cardtype => '',
3985                                            taxclass => '',              } );
3986
3987   my $payment_gateway = '';
3988   my( $processor, $login, $password, $action, @bop_options );
3989   if ( $override ) { #use a payment gateway override
3990
3991     $payment_gateway = $override->payment_gateway;
3992
3993     $processor   = $payment_gateway->gateway_module;
3994     $login       = $payment_gateway->gateway_username;
3995     $password    = $payment_gateway->gateway_password;
3996     $action      = $payment_gateway->gateway_action;
3997     @bop_options = $payment_gateway->options;
3998
3999   } else { #use the standard settings from the config
4000
4001     ( $processor, $login, $password, $action, @bop_options ) =
4002       $self->default_payment_gateway($method);
4003
4004   }
4005
4006   ###
4007   # massage data
4008   ###
4009
4010   my $address = exists($options{'address1'})
4011                     ? $options{'address1'}
4012                     : $self->address1;
4013   my $address2 = exists($options{'address2'})
4014                     ? $options{'address2'}
4015                     : $self->address2;
4016   $address .= ", ". $address2 if length($address2);
4017
4018   my $o_payname = exists($options{'payname'})
4019                     ? $options{'payname'}
4020                     : $self->payname;
4021   my($payname, $payfirst, $paylast);
4022   if ( $o_payname && $method ne 'ECHECK' ) {
4023     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4024       or return "Illegal payname $payname";
4025     ($payfirst, $paylast) = ($1, $2);
4026   } else {
4027     $payfirst = $self->getfield('first');
4028     $paylast = $self->getfield('last');
4029     $payname =  "$payfirst $paylast";
4030   }
4031
4032   my @invoicing_list = $self->invoicing_list_emailonly;
4033   if ( $conf->exists('emailinvoiceautoalways')
4034        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4035        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4036     push @invoicing_list, $self->all_emails;
4037   }
4038
4039   my $email = ($conf->exists('business-onlinepayment-email-override'))
4040               ? $conf->config('business-onlinepayment-email-override')
4041               : $invoicing_list[0];
4042
4043   my %content = ();
4044
4045   my $payip = exists($options{'payip'})
4046                 ? $options{'payip'}
4047                 : $self->payip;
4048   $content{customer_ip} = $payip
4049     if length($payip);
4050
4051   $content{invoice_number} = $options{'invnum'}
4052     if exists($options{'invnum'}) && length($options{'invnum'});
4053
4054   $content{email_customer} =
4055     (    $conf->exists('business-onlinepayment-email_customer')
4056       || $conf->exists('business-onlinepayment-email-override') );
4057
4058   my $paydate = '';
4059   if ( $method eq 'CC' ) {
4060
4061     $content{card_number} = $payinfo;
4062     $paydate = exists($options{'paydate'})
4063                     ? $options{'paydate'}
4064                     : $self->paydate;
4065     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4066     $content{expiration} = "$2/$1";
4067
4068     my $paycvv = exists($options{'paycvv'})
4069                    ? $options{'paycvv'}
4070                    : $self->paycvv;
4071     $content{cvv2} = $paycvv
4072       if length($paycvv);
4073
4074     my $paystart_month = exists($options{'paystart_month'})
4075                            ? $options{'paystart_month'}
4076                            : $self->paystart_month;
4077
4078     my $paystart_year  = exists($options{'paystart_year'})
4079                            ? $options{'paystart_year'}
4080                            : $self->paystart_year;
4081
4082     $content{card_start} = "$paystart_month/$paystart_year"
4083       if $paystart_month && $paystart_year;
4084
4085     my $payissue       = exists($options{'payissue'})
4086                            ? $options{'payissue'}
4087                            : $self->payissue;
4088     $content{issue_number} = $payissue if $payissue;
4089
4090     if ( $self->_bop_recurring_billing( 'payinfo'        => $payinfo,
4091                                         'trans_is_recur' => $trans_is_recur,
4092                                       )
4093        )
4094     {
4095       $content{recurring_billing} = 'YES';
4096       $content{acct_code} = 'rebill'
4097         if $conf->exists('credit_card-recurring_billing_acct_code');
4098     }
4099
4100   } elsif ( $method eq 'ECHECK' ) {
4101     ( $content{account_number}, $content{routing_code} ) =
4102       split('@', $payinfo);
4103     $content{bank_name} = $o_payname;
4104     $content{bank_state} = exists($options{'paystate'})
4105                              ? $options{'paystate'}
4106                              : $self->getfield('paystate');
4107     $content{account_type} = exists($options{'paytype'})
4108                                ? uc($options{'paytype'}) || 'CHECKING'
4109                                : uc($self->getfield('paytype')) || 'CHECKING';
4110     $content{account_name} = $payname;
4111     $content{customer_org} = $self->company ? 'B' : 'I';
4112     $content{state_id}       = exists($options{'stateid'})
4113                                  ? $options{'stateid'}
4114                                  : $self->getfield('stateid');
4115     $content{state_id_state} = exists($options{'stateid_state'})
4116                                  ? $options{'stateid_state'}
4117                                  : $self->getfield('stateid_state');
4118     $content{customer_ssn} = exists($options{'ss'})
4119                                ? $options{'ss'}
4120                                : $self->ss;
4121   } elsif ( $method eq 'LEC' ) {
4122     $content{phone} = $payinfo;
4123   }
4124
4125   ###
4126   # run transaction(s)
4127   ###
4128
4129   my $balance = exists( $options{'balance'} )
4130                   ? $options{'balance'}
4131                   : $self->balance;
4132
4133   $self->select_for_update; #mutex ... just until we get our pending record in
4134
4135   #the checks here are intended to catch concurrent payments
4136   #double-form-submission prevention is taken care of in cust_pay_pending::check
4137
4138   #check the balance
4139   return "The customer's balance has changed; $method transaction aborted."
4140     if $self->balance < $balance;
4141     #&& $self->balance < $amount; #might as well anyway?
4142
4143   #also check and make sure there aren't *other* pending payments for this cust
4144
4145   my @pending = qsearch('cust_pay_pending', {
4146     'custnum' => $self->custnum,
4147     'status'  => { op=>'!=', value=>'done' }
4148   });
4149   return "A payment is already being processed for this customer (".
4150          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4151          "); $method transaction aborted."
4152     if scalar(@pending);
4153
4154   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4155
4156   my $cust_pay_pending = new FS::cust_pay_pending {
4157     'custnum'           => $self->custnum,
4158     #'invnum'            => $options{'invnum'},
4159     'paid'              => $amount,
4160     '_date'             => '',
4161     'payby'             => $method2payby{$method},
4162     'payinfo'           => $payinfo,
4163     'paydate'           => $paydate,
4164     'recurring_billing' => $content{recurring_billing},
4165     'pkgnum'            => $options{'pkgnum'},
4166     'status'            => 'new',
4167     'gatewaynum'        => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
4168   };
4169   $cust_pay_pending->payunique( $options{payunique} )
4170     if defined($options{payunique}) && length($options{payunique});
4171   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4172   return $cpp_new_err if $cpp_new_err;
4173
4174   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
4175
4176   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
4177   $transaction->content(
4178     'type'           => $method,
4179     'login'          => $login,
4180     'password'       => $password,
4181     'action'         => $action1,
4182     'description'    => $options{'description'},
4183     'amount'         => $amount,
4184     #'invoice_number' => $options{'invnum'},
4185     'customer_id'    => $self->custnum,
4186     'last_name'      => $paylast,
4187     'first_name'     => $payfirst,
4188     'name'           => $payname,
4189     'address'        => $address,
4190     'city'           => ( exists($options{'city'})
4191                             ? $options{'city'}
4192                             : $self->city          ),
4193     'state'          => ( exists($options{'state'})
4194                             ? $options{'state'}
4195                             : $self->state          ),
4196     'zip'            => ( exists($options{'zip'})
4197                             ? $options{'zip'}
4198                             : $self->zip          ),
4199     'country'        => ( exists($options{'country'})
4200                             ? $options{'country'}
4201                             : $self->country          ),
4202     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4203     'email'          => $email,
4204     'phone'          => $self->daytime || $self->night,
4205     %content, #after
4206   );
4207
4208   $cust_pay_pending->status('pending');
4209   my $cpp_pending_err = $cust_pay_pending->replace;
4210   return $cpp_pending_err if $cpp_pending_err;
4211
4212   #config?
4213   my $BOP_TESTING = 0;
4214   my $BOP_TESTING_SUCCESS = 1;
4215
4216   unless ( $BOP_TESTING ) {
4217     $transaction->submit();
4218   } else {
4219     if ( $BOP_TESTING_SUCCESS ) {
4220       $transaction->is_success(1);
4221       $transaction->authorization('fake auth');
4222     } else {
4223       $transaction->is_success(0);
4224       $transaction->error_message('fake failure');
4225     }
4226   }
4227
4228   if ( $transaction->is_success() && $action2 ) {
4229
4230     $cust_pay_pending->status('authorized');
4231     my $cpp_authorized_err = $cust_pay_pending->replace;
4232     return $cpp_authorized_err if $cpp_authorized_err;
4233
4234     my $auth = $transaction->authorization;
4235     my $ordernum = $transaction->can('order_number')
4236                    ? $transaction->order_number
4237                    : '';
4238
4239     my $capture =
4240       new Business::OnlinePayment( $processor, @bop_options );
4241
4242     my %capture = (
4243       %content,
4244       type           => $method,
4245       action         => $action2,
4246       login          => $login,
4247       password       => $password,
4248       order_number   => $ordernum,
4249       amount         => $amount,
4250       authorization  => $auth,
4251       description    => $options{'description'},
4252     );
4253
4254     foreach my $field (qw( authorization_source_code returned_ACI
4255                            transaction_identifier validation_code
4256                            transaction_sequence_num local_transaction_date
4257                            local_transaction_time AVS_result_code          )) {
4258       $capture{$field} = $transaction->$field() if $transaction->can($field);
4259     }
4260
4261     $capture->content( %capture );
4262
4263     $capture->submit();
4264
4265     unless ( $capture->is_success ) {
4266       my $e = "Authorization successful but capture failed, custnum #".
4267               $self->custnum. ': '.  $capture->result_code.
4268               ": ". $capture->error_message;
4269       warn $e;
4270       return $e;
4271     }
4272
4273   }
4274
4275   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4276   my $cpp_captured_err = $cust_pay_pending->replace;
4277   return $cpp_captured_err if $cpp_captured_err;
4278
4279   ###
4280   # remove paycvv after initial transaction
4281   ###
4282
4283   #false laziness w/misc/process/payment.cgi - check both to make sure working
4284   # correctly
4285   if ( defined $self->dbdef_table->column('paycvv')
4286        && length($self->paycvv)
4287        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
4288   ) {
4289     my $error = $self->remove_cvv;
4290     if ( $error ) {
4291       warn "WARNING: error removing cvv: $error\n";
4292     }
4293   }
4294
4295   ###
4296   # result handling
4297   ###
4298
4299   if ( $transaction->is_success() ) {
4300
4301     my $paybatch = '';
4302     if ( $payment_gateway ) { # agent override
4303       $paybatch = $payment_gateway->gatewaynum. '-';
4304     }
4305
4306     $paybatch .= "$processor:". $transaction->authorization;
4307
4308     $paybatch .= ':'. $transaction->order_number
4309       if $transaction->can('order_number')
4310       && length($transaction->order_number);
4311
4312     my $cust_pay = new FS::cust_pay ( {
4313        'custnum'  => $self->custnum,
4314        'invnum'   => $options{'invnum'},
4315        'paid'     => $amount,
4316        '_date'    => '',
4317        'payby'    => $method2payby{$method},
4318        'payinfo'  => $payinfo,
4319        'paybatch' => $paybatch,
4320        'paydate'  => $paydate,
4321        'pkgnum'   => $options{'pkgnum'},
4322     } );
4323     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4324     $cust_pay->payunique( $options{payunique} )
4325       if defined($options{payunique}) && length($options{payunique});
4326
4327     my $oldAutoCommit = $FS::UID::AutoCommit;
4328     local $FS::UID::AutoCommit = 0;
4329     my $dbh = dbh;
4330
4331     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4332
4333     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4334
4335     if ( $error ) {
4336       $cust_pay->invnum(''); #try again with no specific invnum
4337       my $error2 = $cust_pay->insert( $options{'manual'} ?
4338                                       ( 'manual' => 1 ) : ()
4339                                     );
4340       if ( $error2 ) {
4341         # gah.  but at least we have a record of the state we had to abort in
4342         # from cust_pay_pending now.
4343         my $e = "WARNING: $method captured but payment not recorded - ".
4344                 "error inserting payment ($processor): $error2".
4345                 " (previously tried insert with invnum #$options{'invnum'}" .
4346                 ": $error ) - pending payment saved as paypendingnum ".
4347                 $cust_pay_pending->paypendingnum. "\n";
4348         warn $e;
4349         return $e;
4350       }
4351     }
4352
4353     if ( $options{'paynum_ref'} ) {
4354       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4355     }
4356
4357     $cust_pay_pending->status('done');
4358     $cust_pay_pending->statustext('captured');
4359     $cust_pay_pending->paynum($cust_pay->paynum);
4360     my $cpp_done_err = $cust_pay_pending->replace;
4361
4362     if ( $cpp_done_err ) {
4363
4364       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4365       my $e = "WARNING: $method captured but payment not recorded - ".
4366               "error updating status for paypendingnum ".
4367               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4368       warn $e;
4369       return $e;
4370
4371     } else {
4372
4373       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4374
4375       if ( $options{'apply'} ) {
4376         my $apply_error = $self->apply_payments_and_credits;
4377         if ( $apply_error ) {
4378           warn "WARNING: error applying payment: $apply_error\n";
4379           #but we still should return no error cause the payment otherwise went
4380           #through...
4381         }
4382       }
4383
4384       return ''; #no error
4385
4386     }
4387
4388   } else {
4389
4390     my $perror = "$processor error: ". $transaction->error_message;
4391
4392     unless ( $transaction->error_message ) {
4393
4394       my $t_response;
4395       if ( $transaction->can('response_page') ) {
4396         $t_response = {
4397                         'page'    => ( $transaction->can('response_page')
4398                                          ? $transaction->response_page
4399                                          : ''
4400                                      ),
4401                         'code'    => ( $transaction->can('response_code')
4402                                          ? $transaction->response_code
4403                                          : ''
4404                                      ),
4405                         'headers' => ( $transaction->can('response_headers')
4406                                          ? $transaction->response_headers
4407                                          : ''
4408                                      ),
4409                       };
4410       } else {
4411         $t_response .=
4412           "No additional debugging information available for $processor";
4413       }
4414
4415       $perror .= "No error_message returned from $processor -- ".
4416                  ( ref($t_response) ? Dumper($t_response) : $t_response );
4417
4418     }
4419
4420     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4421          && $conf->exists('emaildecline')
4422          && grep { $_ ne 'POST' } $self->invoicing_list
4423          && ! grep { $transaction->error_message =~ /$_/ }
4424                    $conf->config('emaildecline-exclude')
4425     ) {
4426       my @templ = $conf->config('declinetemplate');
4427       my $template = new Text::Template (
4428         TYPE   => 'ARRAY',
4429         SOURCE => [ map "$_\n", @templ ],
4430       ) or return "($perror) can't create template: $Text::Template::ERROR";
4431       $template->compile()
4432         or return "($perror) can't compile template: $Text::Template::ERROR";
4433
4434       my $templ_hash = {
4435         'company_name'    =>
4436           scalar( $conf->config('company_name', $self->agentnum ) ),
4437         'company_address' =>
4438           join("\n", $conf->config('company_address', $self->agentnum ) ),
4439         'error'           => $transaction->error_message,
4440       };
4441
4442       my $error = send_email(
4443         'from'    => $conf->config('invoice_from', $self->agentnum ),
4444         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4445         'subject' => 'Your payment could not be processed',
4446         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
4447       );
4448
4449       $perror .= " (also received error sending decline notification: $error)"
4450         if $error;
4451
4452     }
4453
4454     $cust_pay_pending->status('done');
4455     $cust_pay_pending->statustext("declined: $perror");
4456     my $cpp_done_err = $cust_pay_pending->replace;
4457     if ( $cpp_done_err ) {
4458       my $e = "WARNING: $method declined but pending payment not resolved - ".
4459               "error updating status for paypendingnum ".
4460               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4461       warn $e;
4462       $perror = "$e ($perror)";
4463     }
4464
4465     return $perror;
4466   }
4467
4468 }
4469
4470 sub _bop_recurring_billing {
4471   my( $self, %opt ) = @_;
4472
4473   my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4474
4475   if ( defined($method) && $method eq 'transaction_is_recur' ) {
4476
4477     return 1 if $opt{'trans_is_recur'};
4478
4479   } else {
4480
4481     my %hash = ( 'custnum' => $self->custnum,
4482                  'payby'   => 'CARD',
4483                );
4484
4485     return 1
4486       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4487       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4488                                                                $opt{'payinfo'} )
4489                              } );
4490
4491   }
4492
4493   return 0;
4494
4495 }
4496
4497
4498 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
4499
4500 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
4501 via a Business::OnlinePayment realtime gateway.  See
4502 L<http://420.am/business-onlinepayment> for supported gateways.
4503
4504 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4505
4506 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
4507
4508 Most gateways require a reference to an original payment transaction to refund,
4509 so you probably need to specify a I<paynum>.
4510
4511 I<amount> defaults to the original amount of the payment if not specified.
4512
4513 I<reason> specifies a reason for the refund.
4514
4515 I<paydate> specifies the expiration date for a credit card overriding the
4516 value from the customer record or the payment record. Specified as yyyy-mm-dd
4517
4518 Implementation note: If I<amount> is unspecified or equal to the amount of the
4519 orignal payment, first an attempt is made to "void" the transaction via
4520 the gateway (to cancel a not-yet settled transaction) and then if that fails,
4521 the normal attempt is made to "refund" ("credit") the transaction via the
4522 gateway is attempted.
4523
4524 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4525 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4526 #if set, will override the value from the customer record.
4527
4528 #If an I<invnum> is specified, this payment (if successful) is applied to the
4529 #specified invoice.  If you don't specify an I<invnum> you might want to
4530 #call the B<apply_payments> method.
4531
4532 =cut
4533
4534 #some false laziness w/realtime_bop, not enough to make it worth merging
4535 #but some useful small subs should be pulled out
4536 sub realtime_refund_bop {
4537   my $self = shift;
4538
4539   return $self->_new_realtime_refund_bop(@_)
4540     if $self->_new_bop_required();
4541
4542   my( $method, %options ) = @_;
4543   if ( $DEBUG ) {
4544     warn "$me realtime_refund_bop: $method refund\n";
4545     warn "  $_ => $options{$_}\n" foreach keys %options;
4546   }
4547
4548   eval "use Business::OnlinePayment";
4549   die $@ if $@;
4550
4551   ###
4552   # look up the original payment and optionally a gateway for that payment
4553   ###
4554
4555   my $cust_pay = '';
4556   my $amount = $options{'amount'};
4557
4558   my( $processor, $login, $password, @bop_options ) ;
4559   my( $auth, $order_number ) = ( '', '', '' );
4560
4561   if ( $options{'paynum'} ) {
4562
4563     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
4564     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
4565       or return "Unknown paynum $options{'paynum'}";
4566     $amount ||= $cust_pay->paid;
4567
4568     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
4569       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
4570                 $cust_pay->paybatch;
4571     my $gatewaynum = '';
4572     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
4573
4574     if ( $gatewaynum ) { #gateway for the payment to be refunded
4575
4576       my $payment_gateway =
4577         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
4578       die "payment gateway $gatewaynum not found"
4579         unless $payment_gateway;
4580
4581       $processor   = $payment_gateway->gateway_module;
4582       $login       = $payment_gateway->gateway_username;
4583       $password    = $payment_gateway->gateway_password;
4584       @bop_options = $payment_gateway->options;
4585
4586     } else { #try the default gateway
4587
4588       my( $conf_processor, $unused_action );
4589       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
4590         $self->default_payment_gateway($method);
4591
4592       return "processor of payment $options{'paynum'} $processor does not".
4593              " match default processor $conf_processor"
4594         unless $processor eq $conf_processor;
4595
4596     }
4597
4598
4599   } else { # didn't specify a paynum, so look for agent gateway overrides
4600            # like a normal transaction
4601
4602     my $cardtype;
4603     if ( $method eq 'CC' ) {
4604       $cardtype = cardtype($self->payinfo);
4605     } elsif ( $method eq 'ECHECK' ) {
4606       $cardtype = 'ACH';
4607     } else {
4608       $cardtype = $method;
4609     }
4610     my $override =
4611            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4612                                                cardtype => $cardtype,
4613                                                taxclass => '',              } )
4614         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
4615                                                cardtype => '',
4616                                                taxclass => '',              } );
4617
4618     if ( $override ) { #use a payment gateway override
4619
4620       my $payment_gateway = $override->payment_gateway;
4621
4622       $processor   = $payment_gateway->gateway_module;
4623       $login       = $payment_gateway->gateway_username;
4624       $password    = $payment_gateway->gateway_password;
4625       #$action      = $payment_gateway->gateway_action;
4626       @bop_options = $payment_gateway->options;
4627
4628     } else { #use the standard settings from the config
4629
4630       my $unused_action;
4631       ( $processor, $login, $password, $unused_action, @bop_options ) =
4632         $self->default_payment_gateway($method);
4633
4634     }
4635
4636   }
4637   return "neither amount nor paynum specified" unless $amount;
4638
4639   my %content = (
4640     'type'           => $method,
4641     'login'          => $login,
4642     'password'       => $password,
4643     'order_number'   => $order_number,
4644     'amount'         => $amount,
4645     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
4646   );
4647   $content{authorization} = $auth
4648     if length($auth); #echeck/ACH transactions have an order # but no auth
4649                       #(at least with authorize.net)
4650
4651   my $disable_void_after;
4652   if ($conf->exists('disable_void_after')
4653       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
4654     $disable_void_after = $1;
4655   }
4656
4657   #first try void if applicable
4658   if ( $cust_pay && $cust_pay->paid == $amount
4659     && (
4660       ( not defined($disable_void_after) )
4661       || ( time < ($cust_pay->_date + $disable_void_after ) )
4662     )
4663   ) {
4664     warn "  attempting void\n" if $DEBUG > 1;
4665     my $void = new Business::OnlinePayment( $processor, @bop_options );
4666     $content{'card_number'} = $cust_pay->payinfo
4667       if $cust_pay->payby eq 'CARD'
4668       && $void->can('info') && $void->info('CC_void_requires_card');
4669     $void->content( 'action' => 'void', %content );
4670     $void->submit();
4671     if ( $void->is_success ) {
4672       my $error = $cust_pay->void($options{'reason'});
4673       if ( $error ) {
4674         # gah, even with transactions.
4675         my $e = 'WARNING: Card/ACH voided but database not updated - '.
4676                 "error voiding payment: $error";
4677         warn $e;
4678         return $e;
4679       }
4680       warn "  void successful\n" if $DEBUG > 1;
4681       return '';
4682     }
4683   }
4684
4685   warn "  void unsuccessful, trying refund\n"
4686     if $DEBUG > 1;
4687
4688   #massage data
4689   my $address = $self->address1;
4690   $address .= ", ". $self->address2 if $self->address2;
4691
4692   my($payname, $payfirst, $paylast);
4693   if ( $self->payname && $method ne 'ECHECK' ) {
4694     $payname = $self->payname;
4695     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4696       or return "Illegal payname $payname";
4697     ($payfirst, $paylast) = ($1, $2);
4698   } else {
4699     $payfirst = $self->getfield('first');
4700     $paylast = $self->getfield('last');
4701     $payname =  "$payfirst $paylast";
4702   }
4703
4704   my @invoicing_list = $self->invoicing_list_emailonly;
4705   if ( $conf->exists('emailinvoiceautoalways')
4706        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4707        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4708     push @invoicing_list, $self->all_emails;
4709   }
4710
4711   my $email = ($conf->exists('business-onlinepayment-email-override'))
4712               ? $conf->config('business-onlinepayment-email-override')
4713               : $invoicing_list[0];
4714
4715   my $payip = exists($options{'payip'})
4716                 ? $options{'payip'}
4717                 : $self->payip;
4718   $content{customer_ip} = $payip
4719     if length($payip);
4720
4721   my $payinfo = '';
4722   if ( $method eq 'CC' ) {
4723
4724     if ( $cust_pay ) {
4725       $content{card_number} = $payinfo = $cust_pay->payinfo;
4726       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4727         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4728         ($content{expiration} = "$2/$1");  # where available
4729     } else {
4730       $content{card_number} = $payinfo = $self->payinfo;
4731       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4732         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4733       $content{expiration} = "$2/$1";
4734     }
4735
4736   } elsif ( $method eq 'ECHECK' ) {
4737
4738     if ( $cust_pay ) {
4739       $payinfo = $cust_pay->payinfo;
4740     } else {
4741       $payinfo = $self->payinfo;
4742     }
4743     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4744     $content{bank_name} = $self->payname;
4745     $content{account_type} = 'CHECKING';
4746     $content{account_name} = $payname;
4747     $content{customer_org} = $self->company ? 'B' : 'I';
4748     $content{customer_ssn} = $self->ss;
4749   } elsif ( $method eq 'LEC' ) {
4750     $content{phone} = $payinfo = $self->payinfo;
4751   }
4752
4753   #then try refund
4754   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4755   my %sub_content = $refund->content(
4756     'action'         => 'credit',
4757     'customer_id'    => $self->custnum,
4758     'last_name'      => $paylast,
4759     'first_name'     => $payfirst,
4760     'name'           => $payname,
4761     'address'        => $address,
4762     'city'           => $self->city,
4763     'state'          => $self->state,
4764     'zip'            => $self->zip,
4765     'country'        => $self->country,
4766     'email'          => $email,
4767     'phone'          => $self->daytime || $self->night,
4768     %content, #after
4769   );
4770   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4771     if $DEBUG > 1;
4772   $refund->submit();
4773
4774   return "$processor error: ". $refund->error_message
4775     unless $refund->is_success();
4776
4777   my %method2payby = (
4778     'CC'     => 'CARD',
4779     'ECHECK' => 'CHEK',
4780     'LEC'    => 'LECB',
4781   );
4782
4783   my $paybatch = "$processor:". $refund->authorization;
4784   $paybatch .= ':'. $refund->order_number
4785     if $refund->can('order_number') && $refund->order_number;
4786
4787   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4788     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4789     last unless @cust_bill_pay;
4790     my $cust_bill_pay = pop @cust_bill_pay;
4791     my $error = $cust_bill_pay->delete;
4792     last if $error;
4793   }
4794
4795   my $cust_refund = new FS::cust_refund ( {
4796     'custnum'  => $self->custnum,
4797     'paynum'   => $options{'paynum'},
4798     'refund'   => $amount,
4799     '_date'    => '',
4800     'payby'    => $method2payby{$method},
4801     'payinfo'  => $payinfo,
4802     'paybatch' => $paybatch,
4803     'reason'   => $options{'reason'} || 'card or ACH refund',
4804   } );
4805   my $error = $cust_refund->insert;
4806   if ( $error ) {
4807     $cust_refund->paynum(''); #try again with no specific paynum
4808     my $error2 = $cust_refund->insert;
4809     if ( $error2 ) {
4810       # gah, even with transactions.
4811       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4812               "error inserting refund ($processor): $error2".
4813               " (previously tried insert with paynum #$options{'paynum'}" .
4814               ": $error )";
4815       warn $e;
4816       return $e;
4817     }
4818   }
4819
4820   ''; #no error
4821
4822 }
4823
4824 # does the configuration indicate the new bop routines are required?
4825
4826 sub _new_bop_required {
4827   my $self = shift;
4828
4829   my $botpp = 'Business::OnlineThirdPartyPayment';
4830
4831   return 1
4832     if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4833          scalar( grep { $_->gateway_namespace eq $botpp }
4834                  qsearch( 'payment_gateway', { 'disabled' => '' } )
4835                )
4836        )
4837   ;
4838
4839   '';
4840 }
4841
4842 =item realtime_collect [ OPTION => VALUE ... ]
4843
4844 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4845 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4846 gateway.  See L<http://420.am/business-onlinepayment> and
4847 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4848
4849 On failure returns an error message.
4850
4851 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.
4852
4853 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4854
4855 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4856 then it is deduced from the customer record.
4857
4858 If no I<amount> is specified, then the customer balance is used.
4859
4860 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4861 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4862 if set, will override the value from the customer record.
4863
4864 I<description> is a free-text field passed to the gateway.  It defaults to
4865 the value defined by the business-onlinepayment-description configuration
4866 option, or "Internet services" if that is unset.
4867
4868 If an I<invnum> is specified, this payment (if successful) is applied to the
4869 specified invoice.  If you don't specify an I<invnum> you might want to
4870 call the B<apply_payments> method or set the I<apply> option.
4871
4872 I<apply> can be set to true to apply a resulting payment.
4873
4874 I<quiet> can be set true to surpress email decline notices.
4875
4876 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4877 resulting paynum, if any.
4878
4879 I<payunique> is a unique identifier for this payment.
4880
4881 I<session_id> is a session identifier associated with this payment.
4882
4883 I<depend_jobnum> allows payment capture to unlock export jobs
4884
4885 =cut
4886
4887 sub realtime_collect {
4888   my( $self, %options ) = @_;
4889
4890   if ( $DEBUG ) {
4891     warn "$me realtime_collect:\n";
4892     warn "  $_ => $options{$_}\n" foreach keys %options;
4893   }
4894
4895   $options{amount} = $self->balance unless exists( $options{amount} );
4896   $options{method} = FS::payby->payby2bop($self->payby)
4897     unless exists( $options{method} );
4898
4899   return $self->realtime_bop({%options});
4900
4901 }
4902
4903 =item _realtime_bop { [ ARG => VALUE ... ] }
4904
4905 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4906 via a Business::OnlinePayment realtime gateway.  See
4907 L<http://420.am/business-onlinepayment> for supported gateways.
4908
4909 Required arguments in the hashref are I<method>, and I<amount>
4910
4911 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4912
4913 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4914
4915 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4916 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4917 if set, will override the value from the customer record.
4918
4919 I<description> is a free-text field passed to the gateway.  It defaults to
4920 the value defined by the business-onlinepayment-description configuration
4921 option, or "Internet services" if that is unset.
4922
4923 If an I<invnum> is specified, this payment (if successful) is applied to the
4924 specified invoice.  If you don't specify an I<invnum> you might want to
4925 call the B<apply_payments> method.
4926
4927 I<quiet> can be set true to surpress email decline notices.
4928
4929 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4930 resulting paynum, if any.
4931
4932 I<payunique> is a unique identifier for this payment.
4933
4934 I<session_id> is a session identifier associated with this payment.
4935
4936 I<depend_jobnum> allows payment capture to unlock export jobs
4937
4938 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4939
4940 =cut
4941
4942 # some helper routines
4943 sub _payment_gateway {
4944   my ($self, $options) = @_;
4945
4946   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4947     unless exists($options->{payment_gateway});
4948
4949   $options->{payment_gateway};
4950 }
4951
4952 sub _bop_auth {
4953   my ($self, $options) = @_;
4954
4955   (
4956     'login'    => $options->{payment_gateway}->gateway_username,
4957     'password' => $options->{payment_gateway}->gateway_password,
4958   );
4959 }
4960
4961 sub _bop_options {
4962   my ($self, $options) = @_;
4963
4964   $options->{payment_gateway}->gatewaynum
4965     ? $options->{payment_gateway}->options
4966     : @{ $options->{payment_gateway}->get('options') };
4967 }
4968
4969 sub _bop_defaults {
4970   my ($self, $options) = @_;
4971
4972   unless ( $options->{'description'} ) {
4973     if ( $conf->exists('business-onlinepayment-description') ) {
4974       my $dtempl = $conf->config('business-onlinepayment-description');
4975
4976       my $agent = $self->agent->agent;
4977       #$pkgs... not here
4978       $options->{'description'} = eval qq("$dtempl");
4979     } else {
4980       $options->{'description'} = 'Internet services';
4981     }
4982   }
4983
4984   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4985   $options->{invnum} ||= '';
4986   $options->{payname} = $self->payname unless exists( $options->{payname} );
4987 }
4988
4989 sub _bop_content {
4990   my ($self, $options) = @_;
4991   my %content = ();
4992
4993   $content{address} = exists($options->{'address1'})
4994                         ? $options->{'address1'}
4995                         : $self->address1;
4996   my $address2 = exists($options->{'address2'})
4997                    ? $options->{'address2'}
4998                    : $self->address2;
4999   $content{address} .= ", ". $address2 if length($address2);
5000
5001   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
5002   $content{customer_ip} = $payip if length($payip);
5003
5004   $content{invoice_number} = $options->{'invnum'}
5005     if exists($options->{'invnum'}) && length($options->{'invnum'});
5006
5007   $content{email_customer} =
5008     (    $conf->exists('business-onlinepayment-email_customer')
5009       || $conf->exists('business-onlinepayment-email-override') );
5010
5011   $content{payfirst} = $self->getfield('first');
5012   $content{paylast} = $self->getfield('last');
5013
5014   $content{account_name} = "$content{payfirst} $content{paylast}"
5015     if $options->{method} eq 'ECHECK';
5016
5017   $content{name} = $options->{payname};
5018   $content{name} = $content{account_name} if exists($content{account_name});
5019
5020   $content{city} = exists($options->{city})
5021                      ? $options->{city}
5022                      : $self->city;
5023   $content{state} = exists($options->{state})
5024                       ? $options->{state}
5025                       : $self->state;
5026   $content{zip} = exists($options->{zip})
5027                     ? $options->{'zip'}
5028                     : $self->zip;
5029   $content{country} = exists($options->{country})
5030                         ? $options->{country}
5031                         : $self->country;
5032   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
5033   $content{phone} = $self->daytime || $self->night;
5034
5035   (%content);
5036 }
5037
5038 my %bop_method2payby = (
5039   'CC'     => 'CARD',
5040   'ECHECK' => 'CHEK',
5041   'LEC'    => 'LECB',
5042 );
5043
5044 sub _new_realtime_bop {
5045   my $self = shift;
5046
5047   my %options = ();
5048   if (ref($_[0]) eq 'HASH') {
5049     %options = %{$_[0]};
5050   } else {
5051     my ( $method, $amount ) = ( shift, shift );
5052     %options = @_;
5053     $options{method} = $method;
5054     $options{amount} = $amount;
5055   }
5056
5057   if ( $DEBUG ) {
5058     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
5059     warn "  $_ => $options{$_}\n" foreach keys %options;
5060   }
5061
5062   return $self->fake_bop(%options) if $options{'fake'};
5063
5064   $self->_bop_defaults(\%options);
5065
5066   ###
5067   # set trans_is_recur based on invnum if there is one
5068   ###
5069
5070   my $trans_is_recur = 0;
5071   if ( $options{'invnum'} ) {
5072
5073     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
5074     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
5075
5076     my @part_pkg =
5077       map  { $_->part_pkg }
5078       grep { $_ }
5079       map  { $_->cust_pkg }
5080       $cust_bill->cust_bill_pkg;
5081
5082     $trans_is_recur = 1
5083       if grep { $_->freq ne '0' } @part_pkg;
5084
5085   }
5086
5087   ###
5088   # select a gateway
5089   ###
5090
5091   my $payment_gateway =  $self->_payment_gateway( \%options );
5092   my $namespace = $payment_gateway->gateway_namespace;
5093
5094   eval "use $namespace";
5095   die $@ if $@;
5096
5097   ###
5098   # check for banned credit card/ACH
5099   ###
5100
5101   my $ban = qsearchs('banned_pay', {
5102     'payby'   => $bop_method2payby{$options{method}},
5103     'payinfo' => md5_base64($options{payinfo}),
5104   } );
5105   return "Banned credit card" if $ban;
5106
5107   ###
5108   # massage data
5109   ###
5110
5111   my (%bop_content) = $self->_bop_content(\%options);
5112
5113   if ( $options{method} ne 'ECHECK' ) {
5114     $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5115       or return "Illegal payname $options{payname}";
5116     ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
5117   }
5118
5119   my @invoicing_list = $self->invoicing_list_emailonly;
5120   if ( $conf->exists('emailinvoiceautoalways')
5121        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5122        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5123     push @invoicing_list, $self->all_emails;
5124   }
5125
5126   my $email = ($conf->exists('business-onlinepayment-email-override'))
5127               ? $conf->config('business-onlinepayment-email-override')
5128               : $invoicing_list[0];
5129
5130   my $paydate = '';
5131   my %content = ();
5132   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
5133
5134     $content{card_number} = $options{payinfo};
5135     $paydate = exists($options{'paydate'})
5136                     ? $options{'paydate'}
5137                     : $self->paydate;
5138     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5139     $content{expiration} = "$2/$1";
5140
5141     my $paycvv = exists($options{'paycvv'})
5142                    ? $options{'paycvv'}
5143                    : $self->paycvv;
5144     $content{cvv2} = $paycvv
5145       if length($paycvv);
5146
5147     my $paystart_month = exists($options{'paystart_month'})
5148                            ? $options{'paystart_month'}
5149                            : $self->paystart_month;
5150
5151     my $paystart_year  = exists($options{'paystart_year'})
5152                            ? $options{'paystart_year'}
5153                            : $self->paystart_year;
5154
5155     $content{card_start} = "$paystart_month/$paystart_year"
5156       if $paystart_month && $paystart_year;
5157
5158     my $payissue       = exists($options{'payissue'})
5159                            ? $options{'payissue'}
5160                            : $self->payissue;
5161     $content{issue_number} = $payissue if $payissue;
5162
5163     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
5164                                         'trans_is_recur' => $trans_is_recur,
5165                                       )
5166        )
5167     {
5168       $content{recurring_billing} = 'YES';
5169       $content{acct_code} = 'rebill'
5170         if $conf->exists('credit_card-recurring_billing_acct_code');
5171     }
5172
5173   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
5174     ( $content{account_number}, $content{routing_code} ) =
5175       split('@', $options{payinfo});
5176     $content{bank_name} = $options{payname};
5177     $content{bank_state} = exists($options{'paystate'})
5178                              ? $options{'paystate'}
5179                              : $self->getfield('paystate');
5180     $content{account_type} = exists($options{'paytype'})
5181                                ? uc($options{'paytype'}) || 'CHECKING'
5182                                : uc($self->getfield('paytype')) || 'CHECKING';
5183     $content{customer_org} = $self->company ? 'B' : 'I';
5184     $content{state_id}       = exists($options{'stateid'})
5185                                  ? $options{'stateid'}
5186                                  : $self->getfield('stateid');
5187     $content{state_id_state} = exists($options{'stateid_state'})
5188                                  ? $options{'stateid_state'}
5189                                  : $self->getfield('stateid_state');
5190     $content{customer_ssn} = exists($options{'ss'})
5191                                ? $options{'ss'}
5192                                : $self->ss;
5193   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
5194     $content{phone} = $options{payinfo};
5195   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5196     #move along
5197   } else {
5198     #die an evil death
5199   }
5200
5201   ###
5202   # run transaction(s)
5203   ###
5204
5205   my $balance = exists( $options{'balance'} )
5206                   ? $options{'balance'}
5207                   : $self->balance;
5208
5209   $self->select_for_update; #mutex ... just until we get our pending record in
5210
5211   #the checks here are intended to catch concurrent payments
5212   #double-form-submission prevention is taken care of in cust_pay_pending::check
5213
5214   #check the balance
5215   return "The customer's balance has changed; $options{method} transaction aborted."
5216     if $self->balance < $balance;
5217     #&& $self->balance < $options{amount}; #might as well anyway?
5218
5219   #also check and make sure there aren't *other* pending payments for this cust
5220
5221   my @pending = qsearch('cust_pay_pending', {
5222     'custnum' => $self->custnum,
5223     'status'  => { op=>'!=', value=>'done' }
5224   });
5225   return "A payment is already being processed for this customer (".
5226          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
5227          "); $options{method} transaction aborted."
5228     if scalar(@pending);
5229
5230   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
5231
5232   my $cust_pay_pending = new FS::cust_pay_pending {
5233     'custnum'           => $self->custnum,
5234     #'invnum'            => $options{'invnum'},
5235     'paid'              => $options{amount},
5236     '_date'             => '',
5237     'payby'             => $bop_method2payby{$options{method}},
5238     'payinfo'           => $options{payinfo},
5239     'paydate'           => $paydate,
5240     'recurring_billing' => $content{recurring_billing},
5241     'pkgnum'            => $options{'pkgnum'},
5242     'status'            => 'new',
5243     'gatewaynum'        => $payment_gateway->gatewaynum || '',
5244     'session_id'        => $options{session_id} || '',
5245     'jobnum'            => $options{depend_jobnum} || '',
5246   };
5247   $cust_pay_pending->payunique( $options{payunique} )
5248     if defined($options{payunique}) && length($options{payunique});
5249   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
5250   return $cpp_new_err if $cpp_new_err;
5251
5252   my( $action1, $action2 ) =
5253     split( /\s*\,\s*/, $payment_gateway->gateway_action );
5254
5255   my $transaction = new $namespace( $payment_gateway->gateway_module,
5256                                     $self->_bop_options(\%options),
5257                                   );
5258
5259   $transaction->content(
5260     'type'           => $options{method},
5261     $self->_bop_auth(\%options),
5262     'action'         => $action1,
5263     'description'    => $options{'description'},
5264     'amount'         => $options{amount},
5265     #'invoice_number' => $options{'invnum'},
5266     'customer_id'    => $self->custnum,
5267     %bop_content,
5268     'reference'      => $cust_pay_pending->paypendingnum, #for now
5269     'email'          => $email,
5270     %content, #after
5271   );
5272
5273   $cust_pay_pending->status('pending');
5274   my $cpp_pending_err = $cust_pay_pending->replace;
5275   return $cpp_pending_err if $cpp_pending_err;
5276
5277   #config?
5278   my $BOP_TESTING = 0;
5279   my $BOP_TESTING_SUCCESS = 1;
5280
5281   unless ( $BOP_TESTING ) {
5282     $transaction->submit();
5283   } else {
5284     if ( $BOP_TESTING_SUCCESS ) {
5285       $transaction->is_success(1);
5286       $transaction->authorization('fake auth');
5287     } else {
5288       $transaction->is_success(0);
5289       $transaction->error_message('fake failure');
5290     }
5291   }
5292
5293   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5294
5295     return { reference => $cust_pay_pending->paypendingnum,
5296              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5297
5298   } elsif ( $transaction->is_success() && $action2 ) {
5299
5300     $cust_pay_pending->status('authorized');
5301     my $cpp_authorized_err = $cust_pay_pending->replace;
5302     return $cpp_authorized_err if $cpp_authorized_err;
5303
5304     my $auth = $transaction->authorization;
5305     my $ordernum = $transaction->can('order_number')
5306                    ? $transaction->order_number
5307                    : '';
5308
5309     my $capture =
5310       new Business::OnlinePayment( $payment_gateway->gateway_module,
5311                                    $self->_bop_options(\%options),
5312                                  );
5313
5314     my %capture = (
5315       %content,
5316       type           => $options{method},
5317       action         => $action2,
5318       $self->_bop_auth(\%options),
5319       order_number   => $ordernum,
5320       amount         => $options{amount},
5321       authorization  => $auth,
5322       description    => $options{'description'},
5323     );
5324
5325     foreach my $field (qw( authorization_source_code returned_ACI
5326                            transaction_identifier validation_code
5327                            transaction_sequence_num local_transaction_date
5328                            local_transaction_time AVS_result_code          )) {
5329       $capture{$field} = $transaction->$field() if $transaction->can($field);
5330     }
5331
5332     $capture->content( %capture );
5333
5334     $capture->submit();
5335
5336     unless ( $capture->is_success ) {
5337       my $e = "Authorization successful but capture failed, custnum #".
5338               $self->custnum. ': '.  $capture->result_code.
5339               ": ". $capture->error_message;
5340       warn $e;
5341       return $e;
5342     }
5343
5344   }
5345
5346   ###
5347   # remove paycvv after initial transaction
5348   ###
5349
5350   #false laziness w/misc/process/payment.cgi - check both to make sure working
5351   # correctly
5352   if ( defined $self->dbdef_table->column('paycvv')
5353        && length($self->paycvv)
5354        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5355   ) {
5356     my $error = $self->remove_cvv;
5357     if ( $error ) {
5358       warn "WARNING: error removing cvv: $error\n";
5359     }
5360   }
5361
5362   ###
5363   # result handling
5364   ###
5365
5366   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5367
5368 }
5369
5370 =item fake_bop
5371
5372 =cut
5373
5374 sub fake_bop {
5375   my $self = shift;
5376
5377   my %options = ();
5378   if (ref($_[0]) eq 'HASH') {
5379     %options = %{$_[0]};
5380   } else {
5381     my ( $method, $amount ) = ( shift, shift );
5382     %options = @_;
5383     $options{method} = $method;
5384     $options{amount} = $amount;
5385   }
5386
5387   if ( $options{'fake_failure'} ) {
5388      return "Error: No error; test failure requested with fake_failure";
5389   }
5390
5391   #my $paybatch = '';
5392   #if ( $payment_gateway->gatewaynum ) { # agent override
5393   #  $paybatch = $payment_gateway->gatewaynum. '-';
5394   #}
5395   #
5396   #$paybatch .= "$processor:". $transaction->authorization;
5397   #
5398   #$paybatch .= ':'. $transaction->order_number
5399   #  if $transaction->can('order_number')
5400   #  && length($transaction->order_number);
5401
5402   my $paybatch = 'FakeProcessor:54:32';
5403
5404   my $cust_pay = new FS::cust_pay ( {
5405      'custnum'  => $self->custnum,
5406      'invnum'   => $options{'invnum'},
5407      'paid'     => $options{amount},
5408      '_date'    => '',
5409      'payby'    => $bop_method2payby{$options{method}},
5410      #'payinfo'  => $payinfo,
5411      'payinfo'  => '4111111111111111',
5412      'paybatch' => $paybatch,
5413      #'paydate'  => $paydate,
5414      'paydate'  => '2012-05-01',
5415   } );
5416   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5417
5418   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5419
5420   if ( $error ) {
5421     $cust_pay->invnum(''); #try again with no specific invnum
5422     my $error2 = $cust_pay->insert( $options{'manual'} ?
5423                                     ( 'manual' => 1 ) : ()
5424                                   );
5425     if ( $error2 ) {
5426       # gah, even with transactions.
5427       my $e = 'WARNING: Card/ACH debited but database not updated - '.
5428               "error inserting (fake!) payment: $error2".
5429               " (previously tried insert with invnum #$options{'invnum'}" .
5430               ": $error )";
5431       warn $e;
5432       return $e;
5433     }
5434   }
5435
5436   if ( $options{'paynum_ref'} ) {
5437     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5438   }
5439
5440   return ''; #no error
5441
5442 }
5443
5444
5445 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5446 #
5447 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5448 # phone bill transaction.
5449
5450 sub _realtime_bop_result {
5451   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5452   if ( $DEBUG ) {
5453     warn "$me _realtime_bop_result: pending transaction ".
5454       $cust_pay_pending->paypendingnum. "\n";
5455     warn "  $_ => $options{$_}\n" foreach keys %options;
5456   }
5457
5458   my $payment_gateway = $options{payment_gateway}
5459     or return "no payment gateway in arguments to _realtime_bop_result";
5460
5461   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5462   my $cpp_captured_err = $cust_pay_pending->replace;
5463   return $cpp_captured_err if $cpp_captured_err;
5464
5465   if ( $transaction->is_success() ) {
5466
5467     my $paybatch = '';
5468     if ( $payment_gateway->gatewaynum ) { # agent override
5469       $paybatch = $payment_gateway->gatewaynum. '-';
5470     }
5471
5472     $paybatch .= $payment_gateway->gateway_module. ":".
5473       $transaction->authorization;
5474
5475     $paybatch .= ':'. $transaction->order_number
5476       if $transaction->can('order_number')
5477       && length($transaction->order_number);
5478
5479     my $cust_pay = new FS::cust_pay ( {
5480        'custnum'  => $self->custnum,
5481        'invnum'   => $options{'invnum'},
5482        'paid'     => $cust_pay_pending->paid,
5483        '_date'    => '',
5484        'payby'    => $cust_pay_pending->payby,
5485        #'payinfo'  => $payinfo,
5486        'paybatch' => $paybatch,
5487        'paydate'  => $cust_pay_pending->paydate,
5488        'pkgnum'   => $cust_pay_pending->pkgnum,
5489     } );
5490     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5491     $cust_pay->payunique( $options{payunique} )
5492       if defined($options{payunique}) && length($options{payunique});
5493
5494     my $oldAutoCommit = $FS::UID::AutoCommit;
5495     local $FS::UID::AutoCommit = 0;
5496     my $dbh = dbh;
5497
5498     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5499
5500     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5501
5502     if ( $error ) {
5503       $cust_pay->invnum(''); #try again with no specific invnum
5504       my $error2 = $cust_pay->insert( $options{'manual'} ?
5505                                       ( 'manual' => 1 ) : ()
5506                                     );
5507       if ( $error2 ) {
5508         # gah.  but at least we have a record of the state we had to abort in
5509         # from cust_pay_pending now.
5510         my $e = "WARNING: $options{method} captured but payment not recorded -".
5511                 " error inserting payment (". $payment_gateway->gateway_module.
5512                 "): $error2".
5513                 " (previously tried insert with invnum #$options{'invnum'}" .
5514                 ": $error ) - pending payment saved as paypendingnum ".
5515                 $cust_pay_pending->paypendingnum. "\n";
5516         warn $e;
5517         return $e;
5518       }
5519     }
5520
5521     my $jobnum = $cust_pay_pending->jobnum;
5522     if ( $jobnum ) {
5523        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5524
5525        unless ( $placeholder ) {
5526          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5527          my $e = "WARNING: $options{method} captured but job $jobnum not ".
5528              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5529          warn $e;
5530          return $e;
5531        }
5532
5533        $error = $placeholder->delete;
5534
5535        if ( $error ) {
5536          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5537          my $e = "WARNING: $options{method} captured but could not delete ".
5538               "job $jobnum for paypendingnum ".
5539               $cust_pay_pending->paypendingnum. ": $error\n";
5540          warn $e;
5541          return $e;
5542        }
5543
5544     }
5545
5546     if ( $options{'paynum_ref'} ) {
5547       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5548     }
5549
5550     $cust_pay_pending->status('done');
5551     $cust_pay_pending->statustext('captured');
5552     $cust_pay_pending->paynum($cust_pay->paynum);
5553     my $cpp_done_err = $cust_pay_pending->replace;
5554
5555     if ( $cpp_done_err ) {
5556
5557       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5558       my $e = "WARNING: $options{method} captured but payment not recorded - ".
5559               "error updating status for paypendingnum ".
5560               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5561       warn $e;
5562       return $e;
5563
5564     } else {
5565
5566       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5567
5568       if ( $options{'apply'} ) {
5569         my $apply_error = $self->apply_payments_and_credits;
5570         if ( $apply_error ) {
5571           warn "WARNING: error applying payment: $apply_error\n";
5572           #but we still should return no error cause the payment otherwise went
5573           #through...
5574         }
5575       }
5576
5577       return ''; #no error
5578
5579     }
5580
5581   } else {
5582
5583     my $perror = $payment_gateway->gateway_module. " error: ".
5584       $transaction->error_message;
5585
5586     my $jobnum = $cust_pay_pending->jobnum;
5587     if ( $jobnum ) {
5588        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5589
5590        if ( $placeholder ) {
5591          my $error = $placeholder->depended_delete;
5592          $error ||= $placeholder->delete;
5593          warn "error removing provisioning jobs after declined paypendingnum ".
5594            $cust_pay_pending->paypendingnum. "\n";
5595        } else {
5596          my $e = "error finding job $jobnum for declined paypendingnum ".
5597               $cust_pay_pending->paypendingnum. "\n";
5598          warn $e;
5599        }
5600
5601     }
5602
5603     unless ( $transaction->error_message ) {
5604
5605       my $t_response;
5606       if ( $transaction->can('response_page') ) {
5607         $t_response = {
5608                         'page'    => ( $transaction->can('response_page')
5609                                          ? $transaction->response_page
5610                                          : ''
5611                                      ),
5612                         'code'    => ( $transaction->can('response_code')
5613                                          ? $transaction->response_code
5614                                          : ''
5615                                      ),
5616                         'headers' => ( $transaction->can('response_headers')
5617                                          ? $transaction->response_headers
5618                                          : ''
5619                                      ),
5620                       };
5621       } else {
5622         $t_response .=
5623           "No additional debugging information available for ".
5624             $payment_gateway->gateway_module;
5625       }
5626
5627       $perror .= "No error_message returned from ".
5628                    $payment_gateway->gateway_module. " -- ".
5629                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5630
5631     }
5632
5633     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5634          && $conf->exists('emaildecline')
5635          && grep { $_ ne 'POST' } $self->invoicing_list
5636          && ! grep { $transaction->error_message =~ /$_/ }
5637                    $conf->config('emaildecline-exclude')
5638     ) {
5639       my @templ = $conf->config('declinetemplate');
5640       my $template = new Text::Template (
5641         TYPE   => 'ARRAY',
5642         SOURCE => [ map "$_\n", @templ ],
5643       ) or return "($perror) can't create template: $Text::Template::ERROR";
5644       $template->compile()
5645         or return "($perror) can't compile template: $Text::Template::ERROR";
5646
5647       my $templ_hash = {
5648         'company_name'    =>
5649           scalar( $conf->config('company_name', $self->agentnum ) ),
5650         'company_address' =>
5651           join("\n", $conf->config('company_address', $self->agentnum ) ),
5652         'error'           => $transaction->error_message,
5653       };
5654
5655       my $error = send_email(
5656         'from'    => $conf->config('invoice_from', $self->agentnum ),
5657         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5658         'subject' => 'Your payment could not be processed',
5659         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5660       );
5661
5662       $perror .= " (also received error sending decline notification: $error)"
5663         if $error;
5664
5665     }
5666
5667     $cust_pay_pending->status('done');
5668     $cust_pay_pending->statustext("declined: $perror");
5669     my $cpp_done_err = $cust_pay_pending->replace;
5670     if ( $cpp_done_err ) {
5671       my $e = "WARNING: $options{method} declined but pending payment not ".
5672               "resolved - error updating status for paypendingnum ".
5673               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5674       warn $e;
5675       $perror = "$e ($perror)";
5676     }
5677
5678     return $perror;
5679   }
5680
5681 }
5682
5683 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5684
5685 Verifies successful third party processing of a realtime credit card,
5686 ACH (electronic check) or phone bill transaction via a
5687 Business::OnlineThirdPartyPayment realtime gateway.  See
5688 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5689
5690 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5691
5692 The additional options I<payname>, I<city>, I<state>,
5693 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5694 if set, will override the value from the customer record.
5695
5696 I<description> is a free-text field passed to the gateway.  It defaults to
5697 "Internet services".
5698
5699 If an I<invnum> is specified, this payment (if successful) is applied to the
5700 specified invoice.  If you don't specify an I<invnum> you might want to
5701 call the B<apply_payments> method.
5702
5703 I<quiet> can be set true to surpress email decline notices.
5704
5705 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5706 resulting paynum, if any.
5707
5708 I<payunique> is a unique identifier for this payment.
5709
5710 Returns a hashref containing elements bill_error (which will be undefined
5711 upon success) and session_id of any associated session.
5712
5713 =cut
5714
5715 sub realtime_botpp_capture {
5716   my( $self, $cust_pay_pending, %options ) = @_;
5717   if ( $DEBUG ) {
5718     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5719     warn "  $_ => $options{$_}\n" foreach keys %options;
5720   }
5721
5722   eval "use Business::OnlineThirdPartyPayment";
5723   die $@ if $@;
5724
5725   ###
5726   # select the gateway
5727   ###
5728
5729   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5730
5731   my $payment_gateway = $cust_pay_pending->gatewaynum
5732     ? qsearchs( 'payment_gateway',
5733                 { gatewaynum => $cust_pay_pending->gatewaynum }
5734               )
5735     : $self->agent->payment_gateway( 'method' => $method,
5736                                      # 'invnum'  => $cust_pay_pending->invnum,
5737                                      # 'payinfo' => $cust_pay_pending->payinfo,
5738                                    );
5739
5740   $options{payment_gateway} = $payment_gateway; # for the helper subs
5741
5742   ###
5743   # massage data
5744   ###
5745
5746   my @invoicing_list = $self->invoicing_list_emailonly;
5747   if ( $conf->exists('emailinvoiceautoalways')
5748        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5749        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5750     push @invoicing_list, $self->all_emails;
5751   }
5752
5753   my $email = ($conf->exists('business-onlinepayment-email-override'))
5754               ? $conf->config('business-onlinepayment-email-override')
5755               : $invoicing_list[0];
5756
5757   my %content = ();
5758
5759   $content{email_customer} =
5760     (    $conf->exists('business-onlinepayment-email_customer')
5761       || $conf->exists('business-onlinepayment-email-override') );
5762
5763   ###
5764   # run transaction(s)
5765   ###
5766
5767   my $transaction =
5768     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5769                                            $self->_bop_options(\%options),
5770                                          );
5771
5772   $transaction->reference({ %options });
5773
5774   $transaction->content(
5775     'type'           => $method,
5776     $self->_bop_auth(\%options),
5777     'action'         => 'Post Authorization',
5778     'description'    => $options{'description'},
5779     'amount'         => $cust_pay_pending->paid,
5780     #'invoice_number' => $options{'invnum'},
5781     'customer_id'    => $self->custnum,
5782     'referer'        => 'http://cleanwhisker.420.am/',
5783     'reference'      => $cust_pay_pending->paypendingnum,
5784     'email'          => $email,
5785     'phone'          => $self->daytime || $self->night,
5786     %content, #after
5787     # plus whatever is required for bogus capture avoidance
5788   );
5789
5790   $transaction->submit();
5791
5792   my $error =
5793     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5794
5795   {
5796     bill_error => $error,
5797     session_id => $cust_pay_pending->session_id,
5798   }
5799
5800 }
5801
5802 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5803
5804 =cut
5805
5806 sub default_payment_gateway {
5807   my( $self, $method ) = @_;
5808
5809   die "Real-time processing not enabled\n"
5810     unless $conf->exists('business-onlinepayment');
5811
5812   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5813
5814   #load up config
5815   my $bop_config = 'business-onlinepayment';
5816   $bop_config .= '-ach'
5817     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5818   my ( $processor, $login, $password, $action, @bop_options ) =
5819     $conf->config($bop_config);
5820   $action ||= 'normal authorization';
5821   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5822   die "No real-time processor is enabled - ".
5823       "did you set the business-onlinepayment configuration value?\n"
5824     unless $processor;
5825
5826   ( $processor, $login, $password, $action, @bop_options )
5827 }
5828
5829 =item remove_cvv
5830
5831 Removes the I<paycvv> field from the database directly.
5832
5833 If there is an error, returns the error, otherwise returns false.
5834
5835 =cut
5836
5837 sub remove_cvv {
5838   my $self = shift;
5839   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5840     or return dbh->errstr;
5841   $sth->execute($self->custnum)
5842     or return $sth->errstr;
5843   $self->paycvv('');
5844   '';
5845 }
5846
5847 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5848
5849 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5850 via a Business::OnlinePayment realtime gateway.  See
5851 L<http://420.am/business-onlinepayment> for supported gateways.
5852
5853 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5854
5855 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5856
5857 Most gateways require a reference to an original payment transaction to refund,
5858 so you probably need to specify a I<paynum>.
5859
5860 I<amount> defaults to the original amount of the payment if not specified.
5861
5862 I<reason> specifies a reason for the refund.
5863
5864 I<paydate> specifies the expiration date for a credit card overriding the
5865 value from the customer record or the payment record. Specified as yyyy-mm-dd
5866
5867 Implementation note: If I<amount> is unspecified or equal to the amount of the
5868 orignal payment, first an attempt is made to "void" the transaction via
5869 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5870 the normal attempt is made to "refund" ("credit") the transaction via the
5871 gateway is attempted.
5872
5873 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5874 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5875 #if set, will override the value from the customer record.
5876
5877 #If an I<invnum> is specified, this payment (if successful) is applied to the
5878 #specified invoice.  If you don't specify an I<invnum> you might want to
5879 #call the B<apply_payments> method.
5880
5881 =cut
5882
5883 #some false laziness w/realtime_bop, not enough to make it worth merging
5884 #but some useful small subs should be pulled out
5885 sub _new_realtime_refund_bop {
5886   my $self = shift;
5887
5888   my %options = ();
5889   if (ref($_[0]) ne 'HASH') {
5890     %options = %{$_[0]};
5891   } else {
5892     my $method = shift;
5893     %options = @_;
5894     $options{method} = $method;
5895   }
5896
5897   if ( $DEBUG ) {
5898     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5899     warn "  $_ => $options{$_}\n" foreach keys %options;
5900   }
5901
5902   ###
5903   # look up the original payment and optionally a gateway for that payment
5904   ###
5905
5906   my $cust_pay = '';
5907   my $amount = $options{'amount'};
5908
5909   my( $processor, $login, $password, @bop_options, $namespace ) ;
5910   my( $auth, $order_number ) = ( '', '', '' );
5911
5912   if ( $options{'paynum'} ) {
5913
5914     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5915     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5916       or return "Unknown paynum $options{'paynum'}";
5917     $amount ||= $cust_pay->paid;
5918
5919     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5920       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5921                 $cust_pay->paybatch;
5922     my $gatewaynum = '';
5923     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5924
5925     if ( $gatewaynum ) { #gateway for the payment to be refunded
5926
5927       my $payment_gateway =
5928         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5929       die "payment gateway $gatewaynum not found"
5930         unless $payment_gateway;
5931
5932       $processor   = $payment_gateway->gateway_module;
5933       $login       = $payment_gateway->gateway_username;
5934       $password    = $payment_gateway->gateway_password;
5935       $namespace   = $payment_gateway->gateway_namespace;
5936       @bop_options = $payment_gateway->options;
5937
5938     } else { #try the default gateway
5939
5940       my $conf_processor;
5941       my $payment_gateway =
5942         $self->agent->payment_gateway('method' => $options{method});
5943
5944       ( $conf_processor, $login, $password, $namespace ) =
5945         map { my $method = "gateway_$_"; $payment_gateway->$method }
5946           qw( module username password namespace );
5947
5948       @bop_options = $payment_gateway->gatewaynum
5949                        ? $payment_gateway->options
5950                        : @{ $payment_gateway->get('options') };
5951
5952       return "processor of payment $options{'paynum'} $processor does not".
5953              " match default processor $conf_processor"
5954         unless $processor eq $conf_processor;
5955
5956     }
5957
5958
5959   } else { # didn't specify a paynum, so look for agent gateway overrides
5960            # like a normal transaction
5961
5962     my $payment_gateway =
5963       $self->agent->payment_gateway( 'method'  => $options{method},
5964                                      #'payinfo' => $payinfo,
5965                                    );
5966     my( $processor, $login, $password, $namespace ) =
5967       map { my $method = "gateway_$_"; $payment_gateway->$method }
5968         qw( module username password namespace );
5969
5970     my @bop_options = $payment_gateway->gatewaynum
5971                         ? $payment_gateway->options
5972                         : @{ $payment_gateway->get('options') };
5973
5974   }
5975   return "neither amount nor paynum specified" unless $amount;
5976
5977   eval "use $namespace";
5978   die $@ if $@;
5979
5980   my %content = (
5981     'type'           => $options{method},
5982     'login'          => $login,
5983     'password'       => $password,
5984     'order_number'   => $order_number,
5985     'amount'         => $amount,
5986     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5987   );
5988   $content{authorization} = $auth
5989     if length($auth); #echeck/ACH transactions have an order # but no auth
5990                       #(at least with authorize.net)
5991
5992   my $disable_void_after;
5993   if ($conf->exists('disable_void_after')
5994       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5995     $disable_void_after = $1;
5996   }
5997
5998   #first try void if applicable
5999   if ( $cust_pay && $cust_pay->paid == $amount
6000     && (
6001       ( not defined($disable_void_after) )
6002       || ( time < ($cust_pay->_date + $disable_void_after ) )
6003     )
6004   ) {
6005     warn "  attempting void\n" if $DEBUG > 1;
6006     my $void = new Business::OnlinePayment( $processor, @bop_options );
6007     $content{'card_number'} = $cust_pay->payinfo
6008       if $cust_pay->payby eq 'CARD'
6009       && $void->can('info') && $void->info('CC_void_requires_card');
6010     $void->content( 'action' => 'void', %content );
6011     $void->submit();
6012     if ( $void->is_success ) {
6013       my $error = $cust_pay->void($options{'reason'});
6014       if ( $error ) {
6015         # gah, even with transactions.
6016         my $e = 'WARNING: Card/ACH voided but database not updated - '.
6017                 "error voiding payment: $error";
6018         warn $e;
6019         return $e;
6020       }
6021       warn "  void successful\n" if $DEBUG > 1;
6022       return '';
6023     }
6024   }
6025
6026   warn "  void unsuccessful, trying refund\n"
6027     if $DEBUG > 1;
6028
6029   #massage data
6030   my $address = $self->address1;
6031   $address .= ", ". $self->address2 if $self->address2;
6032
6033   my($payname, $payfirst, $paylast);
6034   if ( $self->payname && $options{method} ne 'ECHECK' ) {
6035     $payname = $self->payname;
6036     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
6037       or return "Illegal payname $payname";
6038     ($payfirst, $paylast) = ($1, $2);
6039   } else {
6040     $payfirst = $self->getfield('first');
6041     $paylast = $self->getfield('last');
6042     $payname =  "$payfirst $paylast";
6043   }
6044
6045   my @invoicing_list = $self->invoicing_list_emailonly;
6046   if ( $conf->exists('emailinvoiceautoalways')
6047        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
6048        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
6049     push @invoicing_list, $self->all_emails;
6050   }
6051
6052   my $email = ($conf->exists('business-onlinepayment-email-override'))
6053               ? $conf->config('business-onlinepayment-email-override')
6054               : $invoicing_list[0];
6055
6056   my $payip = exists($options{'payip'})
6057                 ? $options{'payip'}
6058                 : $self->payip;
6059   $content{customer_ip} = $payip
6060     if length($payip);
6061
6062   my $payinfo = '';
6063   if ( $options{method} eq 'CC' ) {
6064
6065     if ( $cust_pay ) {
6066       $content{card_number} = $payinfo = $cust_pay->payinfo;
6067       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
6068         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
6069         ($content{expiration} = "$2/$1");  # where available
6070     } else {
6071       $content{card_number} = $payinfo = $self->payinfo;
6072       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
6073         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
6074       $content{expiration} = "$2/$1";
6075     }
6076
6077   } elsif ( $options{method} eq 'ECHECK' ) {
6078
6079     if ( $cust_pay ) {
6080       $payinfo = $cust_pay->payinfo;
6081     } else {
6082       $payinfo = $self->payinfo;
6083     }
6084     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
6085     $content{bank_name} = $self->payname;
6086     $content{account_type} = 'CHECKING';
6087     $content{account_name} = $payname;
6088     $content{customer_org} = $self->company ? 'B' : 'I';
6089     $content{customer_ssn} = $self->ss;
6090   } elsif ( $options{method} eq 'LEC' ) {
6091     $content{phone} = $payinfo = $self->payinfo;
6092   }
6093
6094   #then try refund
6095   my $refund = new Business::OnlinePayment( $processor, @bop_options );
6096   my %sub_content = $refund->content(
6097     'action'         => 'credit',
6098     'customer_id'    => $self->custnum,
6099     'last_name'      => $paylast,
6100     'first_name'     => $payfirst,
6101     'name'           => $payname,
6102     'address'        => $address,
6103     'city'           => $self->city,
6104     'state'          => $self->state,
6105     'zip'            => $self->zip,
6106     'country'        => $self->country,
6107     'email'          => $email,
6108     'phone'          => $self->daytime || $self->night,
6109     %content, #after
6110   );
6111   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
6112     if $DEBUG > 1;
6113   $refund->submit();
6114
6115   return "$processor error: ". $refund->error_message
6116     unless $refund->is_success();
6117
6118   my $paybatch = "$processor:". $refund->authorization;
6119   $paybatch .= ':'. $refund->order_number
6120     if $refund->can('order_number') && $refund->order_number;
6121
6122   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
6123     my @cust_bill_pay = $cust_pay->cust_bill_pay;
6124     last unless @cust_bill_pay;
6125     my $cust_bill_pay = pop @cust_bill_pay;
6126     my $error = $cust_bill_pay->delete;
6127     last if $error;
6128   }
6129
6130   my $cust_refund = new FS::cust_refund ( {
6131     'custnum'  => $self->custnum,
6132     'paynum'   => $options{'paynum'},
6133     'refund'   => $amount,
6134     '_date'    => '',
6135     'payby'    => $bop_method2payby{$options{method}},
6136     'payinfo'  => $payinfo,
6137     'paybatch' => $paybatch,
6138     'reason'   => $options{'reason'} || 'card or ACH refund',
6139   } );
6140   my $error = $cust_refund->insert;
6141   if ( $error ) {
6142     $cust_refund->paynum(''); #try again with no specific paynum
6143     my $error2 = $cust_refund->insert;
6144     if ( $error2 ) {
6145       # gah, even with transactions.
6146       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
6147               "error inserting refund ($processor): $error2".
6148               " (previously tried insert with paynum #$options{'paynum'}" .
6149               ": $error )";
6150       warn $e;
6151       return $e;
6152     }
6153   }
6154
6155   ''; #no error
6156
6157 }
6158
6159 =item batch_card OPTION => VALUE...
6160
6161 Adds a payment for this invoice to the pending credit card batch (see
6162 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
6163 runs the payment using a realtime gateway.
6164
6165 =cut
6166
6167 sub batch_card {
6168   my ($self, %options) = @_;
6169
6170   my $amount;
6171   if (exists($options{amount})) {
6172     $amount = $options{amount};
6173   }else{
6174     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
6175   }
6176   return '' unless $amount > 0;
6177
6178   my $invnum = delete $options{invnum};
6179   my $payby = $options{invnum} || $self->payby;  #dubious
6180
6181   if ($options{'realtime'}) {
6182     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
6183                                 $amount,
6184                                 %options,
6185                               );
6186   }
6187
6188   my $oldAutoCommit = $FS::UID::AutoCommit;
6189   local $FS::UID::AutoCommit = 0;
6190   my $dbh = dbh;
6191
6192   #this needs to handle mysql as well as Pg, like svc_acct.pm
6193   #(make it into a common function if folks need to do batching with mysql)
6194   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
6195     or return "Cannot lock pay_batch: " . $dbh->errstr;
6196
6197   my %pay_batch = (
6198     'status' => 'O',
6199     'payby'  => FS::payby->payby2payment($payby),
6200   );
6201
6202   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
6203
6204   unless ( $pay_batch ) {
6205     $pay_batch = new FS::pay_batch \%pay_batch;
6206     my $error = $pay_batch->insert;
6207     if ( $error ) {
6208       $dbh->rollback if $oldAutoCommit;
6209       die "error creating new batch: $error\n";
6210     }
6211   }
6212
6213   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
6214       'batchnum' => $pay_batch->batchnum,
6215       'custnum'  => $self->custnum,
6216   } );
6217
6218   foreach (qw( address1 address2 city state zip country payby payinfo paydate
6219                payname )) {
6220     $options{$_} = '' unless exists($options{$_});
6221   }
6222
6223   my $cust_pay_batch = new FS::cust_pay_batch ( {
6224     'batchnum' => $pay_batch->batchnum,
6225     'invnum'   => $invnum || 0,                    # is there a better value?
6226                                                    # this field should be
6227                                                    # removed...
6228                                                    # cust_bill_pay_batch now
6229     'custnum'  => $self->custnum,
6230     'last'     => $self->getfield('last'),
6231     'first'    => $self->getfield('first'),
6232     'address1' => $options{address1} || $self->address1,
6233     'address2' => $options{address2} || $self->address2,
6234     'city'     => $options{city}     || $self->city,
6235     'state'    => $options{state}    || $self->state,
6236     'zip'      => $options{zip}      || $self->zip,
6237     'country'  => $options{country}  || $self->country,
6238     'payby'    => $options{payby}    || $self->payby,
6239     'payinfo'  => $options{payinfo}  || $self->payinfo,
6240     'exp'      => $options{paydate}  || $self->paydate,
6241     'payname'  => $options{payname}  || $self->payname,
6242     'amount'   => $amount,                         # consolidating
6243   } );
6244
6245   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
6246     if $old_cust_pay_batch;
6247
6248   my $error;
6249   if ($old_cust_pay_batch) {
6250     $error = $cust_pay_batch->replace($old_cust_pay_batch)
6251   } else {
6252     $error = $cust_pay_batch->insert;
6253   }
6254
6255   if ( $error ) {
6256     $dbh->rollback if $oldAutoCommit;
6257     die $error;
6258   }
6259
6260   my $unapplied =   $self->total_unapplied_credits
6261                   + $self->total_unapplied_payments
6262                   + $self->in_transit_payments;
6263   foreach my $cust_bill ($self->open_cust_bill) {
6264     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
6265     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
6266       'invnum' => $cust_bill->invnum,
6267       'paybatchnum' => $cust_pay_batch->paybatchnum,
6268       'amount' => $cust_bill->owed,
6269       '_date' => time,
6270     };
6271     if ($unapplied >= $cust_bill_pay_batch->amount){
6272       $unapplied -= $cust_bill_pay_batch->amount;
6273       next;
6274     }else{
6275       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
6276                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
6277     }
6278     $error = $cust_bill_pay_batch->insert;
6279     if ( $error ) {
6280       $dbh->rollback if $oldAutoCommit;
6281       die $error;
6282     }
6283   }
6284
6285   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6286   '';
6287 }
6288
6289 =item apply_payments_and_credits [ OPTION => VALUE ... ]
6290
6291 Applies unapplied payments and credits.
6292
6293 In most cases, this new method should be used in place of sequential
6294 apply_payments and apply_credits methods.
6295
6296 A hash of optional arguments may be passed.  Currently "manual" is supported.
6297 If true, a payment receipt is sent instead of a statement when
6298 'payment_receipt_email' configuration option is set.
6299
6300 If there is an error, returns the error, otherwise returns false.
6301
6302 =cut
6303
6304 sub apply_payments_and_credits {
6305   my( $self, %options ) = @_;
6306
6307   local $SIG{HUP} = 'IGNORE';
6308   local $SIG{INT} = 'IGNORE';
6309   local $SIG{QUIT} = 'IGNORE';
6310   local $SIG{TERM} = 'IGNORE';
6311   local $SIG{TSTP} = 'IGNORE';
6312   local $SIG{PIPE} = 'IGNORE';
6313
6314   my $oldAutoCommit = $FS::UID::AutoCommit;
6315   local $FS::UID::AutoCommit = 0;
6316   my $dbh = dbh;
6317
6318   $self->select_for_update; #mutex
6319
6320   foreach my $cust_bill ( $self->open_cust_bill ) {
6321     my $error = $cust_bill->apply_payments_and_credits(%options);
6322     if ( $error ) {
6323       $dbh->rollback if $oldAutoCommit;
6324       return "Error applying: $error";
6325     }
6326   }
6327
6328   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6329   ''; #no error
6330
6331 }
6332
6333 =item apply_credits OPTION => VALUE ...
6334
6335 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6336 to outstanding invoice balances in chronological order (or reverse
6337 chronological order if the I<order> option is set to B<newest>) and returns the
6338 value of any remaining unapplied credits available for refund (see
6339 L<FS::cust_refund>).
6340
6341 Dies if there is an error.
6342
6343 =cut
6344
6345 sub apply_credits {
6346   my $self = shift;
6347   my %opt = @_;
6348
6349   local $SIG{HUP} = 'IGNORE';
6350   local $SIG{INT} = 'IGNORE';
6351   local $SIG{QUIT} = 'IGNORE';
6352   local $SIG{TERM} = 'IGNORE';
6353   local $SIG{TSTP} = 'IGNORE';
6354   local $SIG{PIPE} = 'IGNORE';
6355
6356   my $oldAutoCommit = $FS::UID::AutoCommit;
6357   local $FS::UID::AutoCommit = 0;
6358   my $dbh = dbh;
6359
6360   $self->select_for_update; #mutex
6361
6362   unless ( $self->total_unapplied_credits ) {
6363     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6364     return 0;
6365   }
6366
6367   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6368       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6369
6370   my @invoices = $self->open_cust_bill;
6371   @invoices = sort { $b->_date <=> $a->_date } @invoices
6372     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6373
6374   if ( $conf->exists('pkg-balances') ) {
6375     # limit @credits to those w/ a pkgnum grepped from $self
6376     my %pkgnums = ();
6377     foreach my $i (@invoices) {
6378       foreach my $li ( $i->cust_bill_pkg ) {
6379         $pkgnums{$li->pkgnum} = 1;
6380       }
6381     }
6382     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6383   }
6384
6385   my $credit;
6386
6387   foreach my $cust_bill ( @invoices ) {
6388
6389     if ( !defined($credit) || $credit->credited == 0) {
6390       $credit = pop @credits or last;
6391     }
6392
6393     my $owed;
6394     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6395       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6396     } else {
6397       $owed = $cust_bill->owed;
6398     }
6399     unless ( $owed > 0 ) {
6400       push @credits, $credit;
6401       next;
6402     }
6403
6404     my $amount = min( $credit->credited, $owed );
6405
6406     my $cust_credit_bill = new FS::cust_credit_bill ( {
6407       'crednum' => $credit->crednum,
6408       'invnum'  => $cust_bill->invnum,
6409       'amount'  => $amount,
6410     } );
6411     $cust_credit_bill->pkgnum( $credit->pkgnum )
6412       if $conf->exists('pkg-balances') && $credit->pkgnum;
6413     my $error = $cust_credit_bill->insert;
6414     if ( $error ) {
6415       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6416       die $error;
6417     }
6418
6419     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6420
6421   }
6422
6423   my $total_unapplied_credits = $self->total_unapplied_credits;
6424
6425   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6426
6427   return $total_unapplied_credits;
6428 }
6429
6430 =item apply_payments  [ OPTION => VALUE ... ]
6431
6432 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6433 to outstanding invoice balances in chronological order.
6434
6435  #and returns the value of any remaining unapplied payments.
6436
6437 A hash of optional arguments may be passed.  Currently "manual" is supported.
6438 If true, a payment receipt is sent instead of a statement when
6439 'payment_receipt_email' configuration option is set.
6440
6441 Dies if there is an error.
6442
6443 =cut
6444
6445 sub apply_payments {
6446   my( $self, %options ) = @_;
6447
6448   local $SIG{HUP} = 'IGNORE';
6449   local $SIG{INT} = 'IGNORE';
6450   local $SIG{QUIT} = 'IGNORE';
6451   local $SIG{TERM} = 'IGNORE';
6452   local $SIG{TSTP} = 'IGNORE';
6453   local $SIG{PIPE} = 'IGNORE';
6454
6455   my $oldAutoCommit = $FS::UID::AutoCommit;
6456   local $FS::UID::AutoCommit = 0;
6457   my $dbh = dbh;
6458
6459   $self->select_for_update; #mutex
6460
6461   #return 0 unless
6462
6463   my @payments = sort { $b->_date <=> $a->_date }
6464                  grep { $_->unapplied > 0 }
6465                  $self->cust_pay;
6466
6467   my @invoices = sort { $a->_date <=> $b->_date}
6468                  grep { $_->owed > 0 }
6469                  $self->cust_bill;
6470
6471   if ( $conf->exists('pkg-balances') ) {
6472     # limit @payments to those w/ a pkgnum grepped from $self
6473     my %pkgnums = ();
6474     foreach my $i (@invoices) {
6475       foreach my $li ( $i->cust_bill_pkg ) {
6476         $pkgnums{$li->pkgnum} = 1;
6477       }
6478     }
6479     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6480   }
6481
6482   my $payment;
6483
6484   foreach my $cust_bill ( @invoices ) {
6485
6486     if ( !defined($payment) || $payment->unapplied == 0 ) {
6487       $payment = pop @payments or last;
6488     }
6489
6490     my $owed;
6491     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6492       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6493     } else {
6494       $owed = $cust_bill->owed;
6495     }
6496     unless ( $owed > 0 ) {
6497       push @payments, $payment;
6498       next;
6499     }
6500
6501     my $amount = min( $payment->unapplied, $owed );
6502
6503     my $cust_bill_pay = new FS::cust_bill_pay ( {
6504       'paynum' => $payment->paynum,
6505       'invnum' => $cust_bill->invnum,
6506       'amount' => $amount,
6507     } );
6508     $cust_bill_pay->pkgnum( $payment->pkgnum )
6509       if $conf->exists('pkg-balances') && $payment->pkgnum;
6510     my $error = $cust_bill_pay->insert(%options);
6511     if ( $error ) {
6512       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6513       die $error;
6514     }
6515
6516     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6517
6518   }
6519
6520   my $total_unapplied_payments = $self->total_unapplied_payments;
6521
6522   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6523
6524   return $total_unapplied_payments;
6525 }
6526
6527 =item total_owed
6528
6529 Returns the total owed for this customer on all invoices
6530 (see L<FS::cust_bill/owed>).
6531
6532 =cut
6533
6534 sub total_owed {
6535   my $self = shift;
6536   $self->total_owed_date(2145859200); #12/31/2037
6537 }
6538
6539 =item total_owed_date TIME
6540
6541 Returns the total owed for this customer on all invoices with date earlier than
6542 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6543 see L<Time::Local> and L<Date::Parse> for conversion functions.
6544
6545 =cut
6546
6547 sub total_owed_date {
6548   my $self = shift;
6549   my $time = shift;
6550
6551 #  my $custnum = $self->custnum;
6552 #
6553 #  my $owed_sql = FS::cust_bill->owed_sql;
6554 #
6555 #  my $sql = "
6556 #    SELECT SUM($owed_sql) FROM cust_bill
6557 #      WHERE custnum = $custnum
6558 #        AND _date <= $time
6559 #  ";
6560 #
6561 #  my $sth = dbh->prepare($sql) or die dbh->errstr;
6562 #  $sth->execute() or die $sth->errstr;
6563 #
6564 #  return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6565
6566   my $total_bill = 0;
6567   foreach my $cust_bill (
6568     grep { $_->_date <= $time }
6569       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6570   ) {
6571     $total_bill += $cust_bill->owed;
6572   }
6573   sprintf( "%.2f", $total_bill );
6574
6575 }
6576
6577 =item total_owed_pkgnum PKGNUM
6578
6579 Returns the total owed on all invoices for this customer's specific package
6580 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6581
6582 =cut
6583
6584 sub total_owed_pkgnum {
6585   my( $self, $pkgnum ) = @_;
6586   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6587 }
6588
6589 =item total_owed_date_pkgnum TIME PKGNUM
6590
6591 Returns the total owed for this customer's specific package when using
6592 experimental package balances on all invoices with date earlier than
6593 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6594 see L<Time::Local> and L<Date::Parse> for conversion functions.
6595
6596 =cut
6597
6598 sub total_owed_date_pkgnum {
6599   my( $self, $time, $pkgnum ) = @_;
6600
6601   my $total_bill = 0;
6602   foreach my $cust_bill (
6603     grep { $_->_date <= $time }
6604       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6605   ) {
6606     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6607   }
6608   sprintf( "%.2f", $total_bill );
6609
6610 }
6611
6612 =item total_paid
6613
6614 Returns the total amount of all payments.
6615
6616 =cut
6617
6618 sub total_paid {
6619   my $self = shift;
6620   my $total = 0;
6621   $total += $_->paid foreach $self->cust_pay;
6622   sprintf( "%.2f", $total );
6623 }
6624
6625 =item total_unapplied_credits
6626
6627 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6628 customer.  See L<FS::cust_credit/credited>.
6629
6630 =item total_credited
6631
6632 Old name for total_unapplied_credits.  Don't use.
6633
6634 =cut
6635
6636 sub total_credited {
6637   #carp "total_credited deprecated, use total_unapplied_credits";
6638   shift->total_unapplied_credits(@_);
6639 }
6640
6641 sub total_unapplied_credits {
6642   my $self = shift;
6643   my $total_credit = 0;
6644   $total_credit += $_->credited foreach $self->cust_credit;
6645   sprintf( "%.2f", $total_credit );
6646 }
6647
6648 =item total_unapplied_credits_pkgnum PKGNUM
6649
6650 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6651 customer.  See L<FS::cust_credit/credited>.
6652
6653 =cut
6654
6655 sub total_unapplied_credits_pkgnum {
6656   my( $self, $pkgnum ) = @_;
6657   my $total_credit = 0;
6658   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6659   sprintf( "%.2f", $total_credit );
6660 }
6661
6662
6663 =item total_unapplied_payments
6664
6665 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6666 See L<FS::cust_pay/unapplied>.
6667
6668 =cut
6669
6670 sub total_unapplied_payments {
6671   my $self = shift;
6672   my $total_unapplied = 0;
6673   $total_unapplied += $_->unapplied foreach $self->cust_pay;
6674   sprintf( "%.2f", $total_unapplied );
6675 }
6676
6677 =item total_unapplied_payments_pkgnum PKGNUM
6678
6679 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6680 specific package when using experimental package balances.  See
6681 L<FS::cust_pay/unapplied>.
6682
6683 =cut
6684
6685 sub total_unapplied_payments_pkgnum {
6686   my( $self, $pkgnum ) = @_;
6687   my $total_unapplied = 0;
6688   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6689   sprintf( "%.2f", $total_unapplied );
6690 }
6691
6692
6693 =item total_unapplied_refunds
6694
6695 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6696 customer.  See L<FS::cust_refund/unapplied>.
6697
6698 =cut
6699
6700 sub total_unapplied_refunds {
6701   my $self = shift;
6702   my $total_unapplied = 0;
6703   $total_unapplied += $_->unapplied foreach $self->cust_refund;
6704   sprintf( "%.2f", $total_unapplied );
6705 }
6706
6707 =item balance
6708
6709 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6710 total_unapplied_credits minus total_unapplied_payments).
6711
6712 =cut
6713
6714 sub balance {
6715   my $self = shift;
6716   sprintf( "%.2f",
6717       $self->total_owed
6718     + $self->total_unapplied_refunds
6719     - $self->total_unapplied_credits
6720     - $self->total_unapplied_payments
6721   );
6722 }
6723
6724 =item balance_date TIME
6725
6726 Returns the balance for this customer, only considering invoices with date
6727 earlier than TIME (total_owed_date minus total_credited minus
6728 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6729 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6730 functions.
6731
6732 =cut
6733
6734 sub balance_date {
6735   my $self = shift;
6736   my $time = shift;
6737   sprintf( "%.2f",
6738         $self->total_owed_date($time)
6739       + $self->total_unapplied_refunds
6740       - $self->total_unapplied_credits
6741       - $self->total_unapplied_payments
6742   );
6743 }
6744
6745 =item balance_pkgnum PKGNUM
6746
6747 Returns the balance for this customer's specific package when using
6748 experimental package balances (total_owed plus total_unrefunded, minus
6749 total_unapplied_credits minus total_unapplied_payments)
6750
6751 =cut
6752
6753 sub balance_pkgnum {
6754   my( $self, $pkgnum ) = @_;
6755
6756   sprintf( "%.2f",
6757       $self->total_owed_pkgnum($pkgnum)
6758 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6759 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6760     - $self->total_unapplied_credits_pkgnum($pkgnum)
6761     - $self->total_unapplied_payments_pkgnum($pkgnum)
6762   );
6763 }
6764
6765 =item in_transit_payments
6766
6767 Returns the total of requests for payments for this customer pending in
6768 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6769
6770 =cut
6771
6772 sub in_transit_payments {
6773   my $self = shift;
6774   my $in_transit_payments = 0;
6775   foreach my $pay_batch ( qsearch('pay_batch', {
6776     'status' => 'I',
6777   } ) ) {
6778     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6779       'batchnum' => $pay_batch->batchnum,
6780       'custnum' => $self->custnum,
6781     } ) ) {
6782       $in_transit_payments += $cust_pay_batch->amount;
6783     }
6784   }
6785   sprintf( "%.2f", $in_transit_payments );
6786 }
6787
6788 =item payment_info
6789
6790 Returns a hash of useful information for making a payment.
6791
6792 =over 4
6793
6794 =item balance
6795
6796 Current balance.
6797
6798 =item payby
6799
6800 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6801 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6802 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6803
6804 =back
6805
6806 For credit card transactions:
6807
6808 =over 4
6809
6810 =item card_type 1
6811
6812 =item payname
6813
6814 Exact name on card
6815
6816 =back
6817
6818 For electronic check transactions:
6819
6820 =over 4
6821
6822 =item stateid_state
6823
6824 =back
6825
6826 =cut
6827
6828 sub payment_info {
6829   my $self = shift;
6830
6831   my %return = ();
6832
6833   $return{balance} = $self->balance;
6834
6835   $return{payname} = $self->payname
6836                      || ( $self->first. ' '. $self->get('last') );
6837
6838   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6839
6840   $return{payby} = $self->payby;
6841   $return{stateid_state} = $self->stateid_state;
6842
6843   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6844     $return{card_type} = cardtype($self->payinfo);
6845     $return{payinfo} = $self->paymask;
6846
6847     @return{'month', 'year'} = $self->paydate_monthyear;
6848
6849   }
6850
6851   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6852     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6853     $return{payinfo1} = $payinfo1;
6854     $return{payinfo2} = $payinfo2;
6855     $return{paytype}  = $self->paytype;
6856     $return{paystate} = $self->paystate;
6857
6858   }
6859
6860   #doubleclick protection
6861   my $_date = time;
6862   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6863
6864   %return;
6865
6866 }
6867
6868 =item paydate_monthyear
6869
6870 Returns a two-element list consisting of the month and year of this customer's
6871 paydate (credit card expiration date for CARD customers)
6872
6873 =cut
6874
6875 sub paydate_monthyear {
6876   my $self = shift;
6877   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6878     ( $2, $1 );
6879   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6880     ( $1, $3 );
6881   } else {
6882     ('', '');
6883   }
6884 }
6885
6886 =item tax_exemption TAXNAME
6887
6888 =cut
6889
6890 sub tax_exemption {
6891   my( $self, $taxname ) = @_;
6892
6893   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6894                                      'taxname' => $taxname,
6895                                    },
6896           );
6897 }
6898
6899 =item cust_main_exemption
6900
6901 =cut
6902
6903 sub cust_main_exemption {
6904   my $self = shift;
6905   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6906 }
6907
6908 =item invoicing_list [ ARRAYREF ]
6909
6910 If an arguement is given, sets these email addresses as invoice recipients
6911 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6912 (except as warnings), so use check_invoicing_list first.
6913
6914 Returns a list of email addresses (with svcnum entries expanded).
6915
6916 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6917 check it without disturbing anything by passing nothing.
6918
6919 This interface may change in the future.
6920
6921 =cut
6922
6923 sub invoicing_list {
6924   my( $self, $arrayref ) = @_;
6925
6926   if ( $arrayref ) {
6927     my @cust_main_invoice;
6928     if ( $self->custnum ) {
6929       @cust_main_invoice =
6930         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6931     } else {
6932       @cust_main_invoice = ();
6933     }
6934     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6935       #warn $cust_main_invoice->destnum;
6936       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6937         #warn $cust_main_invoice->destnum;
6938         my $error = $cust_main_invoice->delete;
6939         warn $error if $error;
6940       }
6941     }
6942     if ( $self->custnum ) {
6943       @cust_main_invoice =
6944         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6945     } else {
6946       @cust_main_invoice = ();
6947     }
6948     my %seen = map { $_->address => 1 } @cust_main_invoice;
6949     foreach my $address ( @{$arrayref} ) {
6950       next if exists $seen{$address} && $seen{$address};
6951       $seen{$address} = 1;
6952       my $cust_main_invoice = new FS::cust_main_invoice ( {
6953         'custnum' => $self->custnum,
6954         'dest'    => $address,
6955       } );
6956       my $error = $cust_main_invoice->insert;
6957       warn $error if $error;
6958     }
6959   }
6960
6961   if ( $self->custnum ) {
6962     map { $_->address }
6963       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6964   } else {
6965     ();
6966   }
6967
6968 }
6969
6970 =item check_invoicing_list ARRAYREF
6971
6972 Checks these arguements as valid input for the invoicing_list method.  If there
6973 is an error, returns the error, otherwise returns false.
6974
6975 =cut
6976
6977 sub check_invoicing_list {
6978   my( $self, $arrayref ) = @_;
6979
6980   foreach my $address ( @$arrayref ) {
6981
6982     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6983       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6984     }
6985
6986     my $cust_main_invoice = new FS::cust_main_invoice ( {
6987       'custnum' => $self->custnum,
6988       'dest'    => $address,
6989     } );
6990     my $error = $self->custnum
6991                 ? $cust_main_invoice->check
6992                 : $cust_main_invoice->checkdest
6993     ;
6994     return $error if $error;
6995
6996   }
6997
6998   return "Email address required"
6999     if $conf->exists('cust_main-require_invoicing_list_email')
7000     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
7001
7002   '';
7003 }
7004
7005 =item set_default_invoicing_list
7006
7007 Sets the invoicing list to all accounts associated with this customer,
7008 overwriting any previous invoicing list.
7009
7010 =cut
7011
7012 sub set_default_invoicing_list {
7013   my $self = shift;
7014   $self->invoicing_list($self->all_emails);
7015 }
7016
7017 =item all_emails
7018
7019 Returns the email addresses of all accounts provisioned for this customer.
7020
7021 =cut
7022
7023 sub all_emails {
7024   my $self = shift;
7025   my %list;
7026   foreach my $cust_pkg ( $self->all_pkgs ) {
7027     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
7028     my @svc_acct =
7029       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7030         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7031           @cust_svc;
7032     $list{$_}=1 foreach map { $_->email } @svc_acct;
7033   }
7034   keys %list;
7035 }
7036
7037 =item invoicing_list_addpost
7038
7039 Adds postal invoicing to this customer.  If this customer is already configured
7040 to receive postal invoices, does nothing.
7041
7042 =cut
7043
7044 sub invoicing_list_addpost {
7045   my $self = shift;
7046   return if grep { $_ eq 'POST' } $self->invoicing_list;
7047   my @invoicing_list = $self->invoicing_list;
7048   push @invoicing_list, 'POST';
7049   $self->invoicing_list(\@invoicing_list);
7050 }
7051
7052 =item invoicing_list_emailonly
7053
7054 Returns the list of email invoice recipients (invoicing_list without non-email
7055 destinations such as POST and FAX).
7056
7057 =cut
7058
7059 sub invoicing_list_emailonly {
7060   my $self = shift;
7061   warn "$me invoicing_list_emailonly called"
7062     if $DEBUG;
7063   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
7064 }
7065
7066 =item invoicing_list_emailonly_scalar
7067
7068 Returns the list of email invoice recipients (invoicing_list without non-email
7069 destinations such as POST and FAX) as a comma-separated scalar.
7070
7071 =cut
7072
7073 sub invoicing_list_emailonly_scalar {
7074   my $self = shift;
7075   warn "$me invoicing_list_emailonly_scalar called"
7076     if $DEBUG;
7077   join(', ', $self->invoicing_list_emailonly);
7078 }
7079
7080 =item referral_custnum_cust_main
7081
7082 Returns the customer who referred this customer (or the empty string, if
7083 this customer was not referred).
7084
7085 Note the difference with referral_cust_main method: This method,
7086 referral_custnum_cust_main returns the single customer (if any) who referred
7087 this customer, while referral_cust_main returns an array of customers referred
7088 BY this customer.
7089
7090 =cut
7091
7092 sub referral_custnum_cust_main {
7093   my $self = shift;
7094   return '' unless $self->referral_custnum;
7095   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7096 }
7097
7098 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
7099
7100 Returns an array of customers referred by this customer (referral_custnum set
7101 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
7102 customers referred by customers referred by this customer and so on, inclusive.
7103 The default behavior is DEPTH 1 (no recursion).
7104
7105 Note the difference with referral_custnum_cust_main method: This method,
7106 referral_cust_main, returns an array of customers referred BY this customer,
7107 while referral_custnum_cust_main returns the single customer (if any) who
7108 referred this customer.
7109
7110 =cut
7111
7112 sub referral_cust_main {
7113   my $self = shift;
7114   my $depth = @_ ? shift : 1;
7115   my $exclude = @_ ? shift : {};
7116
7117   my @cust_main =
7118     map { $exclude->{$_->custnum}++; $_; }
7119       grep { ! $exclude->{ $_->custnum } }
7120         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
7121
7122   if ( $depth > 1 ) {
7123     push @cust_main,
7124       map { $_->referral_cust_main($depth-1, $exclude) }
7125         @cust_main;
7126   }
7127
7128   @cust_main;
7129 }
7130
7131 =item referral_cust_main_ncancelled
7132
7133 Same as referral_cust_main, except only returns customers with uncancelled
7134 packages.
7135
7136 =cut
7137
7138 sub referral_cust_main_ncancelled {
7139   my $self = shift;
7140   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
7141 }
7142
7143 =item referral_cust_pkg [ DEPTH ]
7144
7145 Like referral_cust_main, except returns a flat list of all unsuspended (and
7146 uncancelled) packages for each customer.  The number of items in this list may
7147 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
7148
7149 =cut
7150
7151 sub referral_cust_pkg {
7152   my $self = shift;
7153   my $depth = @_ ? shift : 1;
7154
7155   map { $_->unsuspended_pkgs }
7156     grep { $_->unsuspended_pkgs }
7157       $self->referral_cust_main($depth);
7158 }
7159
7160 =item referring_cust_main
7161
7162 Returns the single cust_main record for the customer who referred this customer
7163 (referral_custnum), or false.
7164
7165 =cut
7166
7167 sub referring_cust_main {
7168   my $self = shift;
7169   return '' unless $self->referral_custnum;
7170   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7171 }
7172
7173 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
7174
7175 Applies a credit to this customer.  If there is an error, returns the error,
7176 otherwise returns false.
7177
7178 REASON can be a text string, an FS::reason object, or a scalar reference to
7179 a reasonnum.  If a text string, it will be automatically inserted as a new
7180 reason, and a 'reason_type' option must be passed to indicate the
7181 FS::reason_type for the new reason.
7182
7183 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
7184
7185 Any other options are passed to FS::cust_credit::insert.
7186
7187 =cut
7188
7189 sub credit {
7190   my( $self, $amount, $reason, %options ) = @_;
7191
7192   my $cust_credit = new FS::cust_credit {
7193     'custnum' => $self->custnum,
7194     'amount'  => $amount,
7195   };
7196
7197   if ( ref($reason) ) {
7198
7199     if ( ref($reason) eq 'SCALAR' ) {
7200       $cust_credit->reasonnum( $$reason );
7201     } else {
7202       $cust_credit->reasonnum( $reason->reasonnum );
7203     }
7204
7205   } else {
7206     $cust_credit->set('reason', $reason)
7207   }
7208
7209   $cust_credit->addlinfo( delete $options{'addlinfo'} )
7210     if exists($options{'addlinfo'});
7211
7212   $cust_credit->insert(%options);
7213
7214 }
7215
7216 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
7217
7218 Creates a one-time charge for this customer.  If there is an error, returns
7219 the error, otherwise returns false.
7220
7221 New-style, with a hashref of options:
7222
7223   my $error = $cust_main->charge(
7224                                   {
7225                                     'amount'     => 54.32,
7226                                     'quantity'   => 1,
7227                                     'start_date' => str2time('7/4/2009'),
7228                                     'pkg'        => 'Description',
7229                                     'comment'    => 'Comment',
7230                                     'additional' => [], #extra invoice detail
7231                                     'classnum'   => 1,  #pkg_class
7232
7233                                     'setuptax'   => '', # or 'Y' for tax exempt
7234
7235                                     #internal taxation
7236                                     'taxclass'   => 'Tax class',
7237
7238                                     #vendor taxation
7239                                     'taxproduct' => 2,  #part_pkg_taxproduct
7240                                     'override'   => {}, #XXX describe
7241
7242                                     #will be filled in with the new object
7243                                     'cust_pkg_ref' => \$cust_pkg,
7244
7245                                     #generate an invoice immediately
7246                                     'bill_now' => 0,
7247                                     'invoice_terms' => '', #with these terms
7248                                   }
7249                                 );
7250
7251 Old-style:
7252
7253   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
7254
7255 =cut
7256
7257 sub charge {
7258   my $self = shift;
7259   my ( $amount, $quantity, $start_date, $classnum );
7260   my ( $pkg, $comment, $additional );
7261   my ( $setuptax, $taxclass );   #internal taxes
7262   my ( $taxproduct, $override ); #vendor (CCH) taxes
7263   my $cust_pkg_ref = '';
7264   my ( $bill_now, $invoice_terms ) = ( 0, '' );
7265   if ( ref( $_[0] ) ) {
7266     $amount     = $_[0]->{amount};
7267     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
7268     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
7269     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
7270     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
7271                                            : '$'. sprintf("%.2f",$amount);
7272     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
7273     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
7274     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
7275     $additional = $_[0]->{additional} || [];
7276     $taxproduct = $_[0]->{taxproductnum};
7277     $override   = { '' => $_[0]->{tax_override} };
7278     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
7279     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
7280     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
7281   } else {
7282     $amount     = shift;
7283     $quantity   = 1;
7284     $start_date = '';
7285     $pkg        = @_ ? shift : 'One-time charge';
7286     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
7287     $setuptax   = '';
7288     $taxclass   = @_ ? shift : '';
7289     $additional = [];
7290   }
7291
7292   local $SIG{HUP} = 'IGNORE';
7293   local $SIG{INT} = 'IGNORE';
7294   local $SIG{QUIT} = 'IGNORE';
7295   local $SIG{TERM} = 'IGNORE';
7296   local $SIG{TSTP} = 'IGNORE';
7297   local $SIG{PIPE} = 'IGNORE';
7298
7299   my $oldAutoCommit = $FS::UID::AutoCommit;
7300   local $FS::UID::AutoCommit = 0;
7301   my $dbh = dbh;
7302
7303   my $part_pkg = new FS::part_pkg ( {
7304     'pkg'           => $pkg,
7305     'comment'       => $comment,
7306     'plan'          => 'flat',
7307     'freq'          => 0,
7308     'disabled'      => 'Y',
7309     'classnum'      => $classnum ? $classnum : '',
7310     'setuptax'      => $setuptax,
7311     'taxclass'      => $taxclass,
7312     'taxproductnum' => $taxproduct,
7313   } );
7314
7315   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
7316                         ( 0 .. @$additional - 1 )
7317                   ),
7318                   'additional_count' => scalar(@$additional),
7319                   'setup_fee' => $amount,
7320                 );
7321
7322   my $error = $part_pkg->insert( options       => \%options,
7323                                  tax_overrides => $override,
7324                                );
7325   if ( $error ) {
7326     $dbh->rollback if $oldAutoCommit;
7327     return $error;
7328   }
7329
7330   my $pkgpart = $part_pkg->pkgpart;
7331   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
7332   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
7333     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
7334     $error = $type_pkgs->insert;
7335     if ( $error ) {
7336       $dbh->rollback if $oldAutoCommit;
7337       return $error;
7338     }
7339   }
7340
7341   my $cust_pkg = new FS::cust_pkg ( {
7342     'custnum'    => $self->custnum,
7343     'pkgpart'    => $pkgpart,
7344     'quantity'   => $quantity,
7345     'start_date' => $start_date,
7346   } );
7347
7348   $error = $cust_pkg->insert;
7349   if ( $error ) {
7350     $dbh->rollback if $oldAutoCommit;
7351     return $error;
7352   } elsif ( $cust_pkg_ref ) {
7353     ${$cust_pkg_ref} = $cust_pkg;
7354   }
7355
7356   if ( $bill_now ) {
7357     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7358                              'pkg_list'      => [ $cust_pkg ],
7359                            );
7360     if ( $error ) {
7361       $dbh->rollback if $oldAutoCommit;
7362       return $error;
7363     }
7364   }
7365
7366   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7367   return '';
7368
7369 }
7370
7371 #=item charge_postal_fee
7372 #
7373 #Applies a one time charge this customer.  If there is an error,
7374 #returns the error, returns the cust_pkg charge object or false
7375 #if there was no charge.
7376 #
7377 #=cut
7378 #
7379 # This should be a customer event.  For that to work requires that bill
7380 # also be a customer event.
7381
7382 sub charge_postal_fee {
7383   my $self = shift;
7384
7385   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7386   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7387
7388   my $cust_pkg = new FS::cust_pkg ( {
7389     'custnum'  => $self->custnum,
7390     'pkgpart'  => $pkgpart,
7391     'quantity' => 1,
7392   } );
7393
7394   my $error = $cust_pkg->insert;
7395   $error ? $error : $cust_pkg;
7396 }
7397
7398 =item cust_bill
7399
7400 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7401
7402 =cut
7403
7404 sub cust_bill {
7405   my $self = shift;
7406   map { $_ } #return $self->num_cust_bill unless wantarray;
7407   sort { $a->_date <=> $b->_date }
7408     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7409 }
7410
7411 =item open_cust_bill
7412
7413 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7414 customer.
7415
7416 =cut
7417
7418 sub open_cust_bill {
7419   my $self = shift;
7420
7421   qsearch({
7422     'table'     => 'cust_bill',
7423     'hashref'   => { 'custnum' => $self->custnum, },
7424     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7425     'order_by'  => 'ORDER BY _date ASC',
7426   });
7427
7428 }
7429
7430 =item cust_statements
7431
7432 Returns all the statements (see L<FS::cust_statement>) for this customer.
7433
7434 =cut
7435
7436 sub cust_statement {
7437   my $self = shift;
7438   map { $_ } #return $self->num_cust_statement unless wantarray;
7439   sort { $a->_date <=> $b->_date }
7440     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7441 }
7442
7443 =item cust_credit
7444
7445 Returns all the credits (see L<FS::cust_credit>) for this customer.
7446
7447 =cut
7448
7449 sub cust_credit {
7450   my $self = shift;
7451   map { $_ } #return $self->num_cust_credit unless wantarray;
7452   sort { $a->_date <=> $b->_date }
7453     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7454 }
7455
7456 =item cust_credit_pkgnum
7457
7458 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7459 package when using experimental package balances.
7460
7461 =cut
7462
7463 sub cust_credit_pkgnum {
7464   my( $self, $pkgnum ) = @_;
7465   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7466   sort { $a->_date <=> $b->_date }
7467     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7468                               'pkgnum'  => $pkgnum,
7469                             }
7470     );
7471 }
7472
7473 =item cust_pay
7474
7475 Returns all the payments (see L<FS::cust_pay>) for this customer.
7476
7477 =cut
7478
7479 sub cust_pay {
7480   my $self = shift;
7481   return $self->num_cust_pay unless wantarray;
7482   sort { $a->_date <=> $b->_date }
7483     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7484 }
7485
7486 =item num_cust_pay
7487
7488 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
7489 called automatically when the cust_pay method is used in a scalar context.
7490
7491 =cut
7492
7493 sub num_cust_pay {
7494   my $self = shift;
7495   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7496   my $sth = dbh->prepare($sql) or die dbh->errstr;
7497   $sth->execute($self->custnum) or die $sth->errstr;
7498   $sth->fetchrow_arrayref->[0];
7499 }
7500
7501 =item cust_pay_pkgnum
7502
7503 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7504 package when using experimental package balances.
7505
7506 =cut
7507
7508 sub cust_pay_pkgnum {
7509   my( $self, $pkgnum ) = @_;
7510   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7511   sort { $a->_date <=> $b->_date }
7512     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7513                            'pkgnum'  => $pkgnum,
7514                          }
7515     );
7516 }
7517
7518 =item cust_pay_void
7519
7520 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7521
7522 =cut
7523
7524 sub cust_pay_void {
7525   my $self = shift;
7526   map { $_ } #return $self->num_cust_pay_void unless wantarray;
7527   sort { $a->_date <=> $b->_date }
7528     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7529 }
7530
7531 =item cust_pay_batch
7532
7533 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7534
7535 =cut
7536
7537 sub cust_pay_batch {
7538   my $self = shift;
7539   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7540   sort { $a->paybatchnum <=> $b->paybatchnum }
7541     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7542 }
7543
7544 =item cust_pay_pending
7545
7546 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7547 (without status "done").
7548
7549 =cut
7550
7551 sub cust_pay_pending {
7552   my $self = shift;
7553   return $self->num_cust_pay_pending unless wantarray;
7554   sort { $a->_date <=> $b->_date }
7555     qsearch( 'cust_pay_pending', {
7556                                    'custnum' => $self->custnum,
7557                                    'status'  => { op=>'!=', value=>'done' },
7558                                  },
7559            );
7560 }
7561
7562 =item num_cust_pay_pending
7563
7564 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7565 customer (without status "done").  Also called automatically when the
7566 cust_pay_pending method is used in a scalar context.
7567
7568 =cut
7569
7570 sub num_cust_pay_pending {
7571   my $self = shift;
7572   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7573             "   WHERE custnum = ? AND status != 'done' ";
7574   my $sth = dbh->prepare($sql) or die dbh->errstr;
7575   $sth->execute($self->custnum) or die $sth->errstr;
7576   $sth->fetchrow_arrayref->[0];
7577 }
7578
7579 =item cust_refund
7580
7581 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7582
7583 =cut
7584
7585 sub cust_refund {
7586   my $self = shift;
7587   map { $_ } #return $self->num_cust_refund unless wantarray;
7588   sort { $a->_date <=> $b->_date }
7589     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7590 }
7591
7592 =item display_custnum
7593
7594 Returns the displayed customer number for this customer: agent_custid if
7595 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7596
7597 =cut
7598
7599 sub display_custnum {
7600   my $self = shift;
7601   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7602     return $self->agent_custid;
7603   } else {
7604     return $self->custnum;
7605   }
7606 }
7607
7608 =item name
7609
7610 Returns a name string for this customer, either "Company (Last, First)" or
7611 "Last, First".
7612
7613 =cut
7614
7615 sub name {
7616   my $self = shift;
7617   my $name = $self->contact;
7618   $name = $self->company. " ($name)" if $self->company;
7619   $name;
7620 }
7621
7622 =item ship_name
7623
7624 Returns a name string for this (service/shipping) contact, either
7625 "Company (Last, First)" or "Last, First".
7626
7627 =cut
7628
7629 sub ship_name {
7630   my $self = shift;
7631   if ( $self->get('ship_last') ) {
7632     my $name = $self->ship_contact;
7633     $name = $self->ship_company. " ($name)" if $self->ship_company;
7634     $name;
7635   } else {
7636     $self->name;
7637   }
7638 }
7639
7640 =item name_short
7641
7642 Returns a name string for this customer, either "Company" or "First Last".
7643
7644 =cut
7645
7646 sub name_short {
7647   my $self = shift;
7648   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7649 }
7650
7651 =item ship_name_short
7652
7653 Returns a name string for this (service/shipping) contact, either "Company"
7654 or "First Last".
7655
7656 =cut
7657
7658 sub ship_name_short {
7659   my $self = shift;
7660   if ( $self->get('ship_last') ) {
7661     $self->ship_company !~ /^\s*$/
7662       ? $self->ship_company
7663       : $self->ship_contact_firstlast;
7664   } else {
7665     $self->name_company_or_firstlast;
7666   }
7667 }
7668
7669 =item contact
7670
7671 Returns this customer's full (billing) contact name only, "Last, First"
7672
7673 =cut
7674
7675 sub contact {
7676   my $self = shift;
7677   $self->get('last'). ', '. $self->first;
7678 }
7679
7680 =item ship_contact
7681
7682 Returns this customer's full (shipping) contact name only, "Last, First"
7683
7684 =cut
7685
7686 sub ship_contact {
7687   my $self = shift;
7688   $self->get('ship_last')
7689     ? $self->get('ship_last'). ', '. $self->ship_first
7690     : $self->contact;
7691 }
7692
7693 =item contact_firstlast
7694
7695 Returns this customers full (billing) contact name only, "First Last".
7696
7697 =cut
7698
7699 sub contact_firstlast {
7700   my $self = shift;
7701   $self->first. ' '. $self->get('last');
7702 }
7703
7704 =item ship_contact_firstlast
7705
7706 Returns this customer's full (shipping) contact name only, "First Last".
7707
7708 =cut
7709
7710 sub ship_contact_firstlast {
7711   my $self = shift;
7712   $self->get('ship_last')
7713     ? $self->first. ' '. $self->get('ship_last')
7714     : $self->contact_firstlast;
7715 }
7716
7717 =item country_full
7718
7719 Returns this customer's full country name
7720
7721 =cut
7722
7723 sub country_full {
7724   my $self = shift;
7725   code2country($self->country);
7726 }
7727
7728 =item geocode DATA_VENDOR
7729
7730 Returns a value for the customer location as encoded by DATA_VENDOR.
7731 Currently this only makes sense for "CCH" as DATA_VENDOR.
7732
7733 =cut
7734
7735 sub geocode {
7736   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7737
7738   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7739   return $geocode if $geocode;
7740
7741   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7742                ? 'ship_'
7743                : '';
7744
7745   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7746     if $self->country eq 'US';
7747
7748   #CCH specific location stuff
7749   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7750
7751   my @cust_tax_location =
7752     qsearch( {
7753                'table'     => 'cust_tax_location',
7754                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7755                'extra_sql' => $extra_sql,
7756                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7757              }
7758            );
7759   $geocode = $cust_tax_location[0]->geocode
7760     if scalar(@cust_tax_location);
7761
7762   $geocode;
7763 }
7764
7765 =item cust_status
7766
7767 =item status
7768
7769 Returns a status string for this customer, currently:
7770
7771 =over 4
7772
7773 =item prospect - No packages have ever been ordered
7774
7775 =item active - One or more recurring packages is active
7776
7777 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7778
7779 =item suspended - All non-cancelled recurring packages are suspended
7780
7781 =item cancelled - All recurring packages are cancelled
7782
7783 =back
7784
7785 =cut
7786
7787 sub status { shift->cust_status(@_); }
7788
7789 sub cust_status {
7790   my $self = shift;
7791   for my $status (qw( prospect active inactive suspended cancelled )) {
7792     my $method = $status.'_sql';
7793     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7794     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7795     $sth->execute( ($self->custnum) x $numnum )
7796       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7797     return $status if $sth->fetchrow_arrayref->[0];
7798   }
7799 }
7800
7801 =item ucfirst_cust_status
7802
7803 =item ucfirst_status
7804
7805 Returns the status with the first character capitalized.
7806
7807 =cut
7808
7809 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7810
7811 sub ucfirst_cust_status {
7812   my $self = shift;
7813   ucfirst($self->cust_status);
7814 }
7815
7816 =item statuscolor
7817
7818 Returns a hex triplet color string for this customer's status.
7819
7820 =cut
7821
7822 use vars qw(%statuscolor);
7823 tie %statuscolor, 'Tie::IxHash',
7824   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7825   'active'    => '00CC00', #green
7826   'inactive'  => '0000CC', #blue
7827   'suspended' => 'FF9900', #yellow
7828   'cancelled' => 'FF0000', #red
7829 ;
7830
7831 sub statuscolor { shift->cust_statuscolor(@_); }
7832
7833 sub cust_statuscolor {
7834   my $self = shift;
7835   $statuscolor{$self->cust_status};
7836 }
7837
7838 =item tickets
7839
7840 Returns an array of hashes representing the customer's RT tickets.
7841
7842 =cut
7843
7844 sub tickets {
7845   my $self = shift;
7846
7847   my $num = $conf->config('cust_main-max_tickets') || 10;
7848   my @tickets = ();
7849
7850   if ( $conf->config('ticket_system') ) {
7851     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7852
7853       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7854
7855     } else {
7856
7857       foreach my $priority (
7858         $conf->config('ticket_system-custom_priority_field-values'), ''
7859       ) {
7860         last if scalar(@tickets) >= $num;
7861         push @tickets,
7862           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7863                                                  $num - scalar(@tickets),
7864                                                  $priority,
7865                                                )
7866            };
7867       }
7868     }
7869   }
7870   (@tickets);
7871 }
7872
7873 # Return services representing svc_accts in customer support packages
7874 sub support_services {
7875   my $self = shift;
7876   my %packages = map { $_ => 1 } $conf->config('support_packages');
7877
7878   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7879     grep { $_->part_svc->svcdb eq 'svc_acct' }
7880     map { $_->cust_svc }
7881     grep { exists $packages{ $_->pkgpart } }
7882     $self->ncancelled_pkgs;
7883
7884 }
7885
7886 # Return a list of latitude/longitude for one of the services (if any)
7887 sub service_coordinates {
7888   my $self = shift;
7889
7890   my @svc_X =
7891     grep { $_->latitude && $_->longitude }
7892     map { $_->svc_x }
7893     map { $_->cust_svc }
7894     $self->ncancelled_pkgs;
7895
7896   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7897 }
7898
7899 =back
7900
7901 =head1 CLASS METHODS
7902
7903 =over 4
7904
7905 =item statuses
7906
7907 Class method that returns the list of possible status strings for customers
7908 (see L<the status method|/status>).  For example:
7909
7910   @statuses = FS::cust_main->statuses();
7911
7912 =cut
7913
7914 sub statuses {
7915   #my $self = shift; #could be class...
7916   keys %statuscolor;
7917 }
7918
7919 =item prospect_sql
7920
7921 Returns an SQL expression identifying prospective cust_main records (customers
7922 with no packages ever ordered)
7923
7924 =cut
7925
7926 use vars qw($select_count_pkgs);
7927 $select_count_pkgs =
7928   "SELECT COUNT(*) FROM cust_pkg
7929     WHERE cust_pkg.custnum = cust_main.custnum";
7930
7931 sub select_count_pkgs_sql {
7932   $select_count_pkgs;
7933 }
7934
7935 sub prospect_sql { "
7936   0 = ( $select_count_pkgs )
7937 "; }
7938
7939 =item active_sql
7940
7941 Returns an SQL expression identifying active cust_main records (customers with
7942 active recurring packages).
7943
7944 =cut
7945
7946 sub active_sql { "
7947   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7948       )
7949 "; }
7950
7951 =item inactive_sql
7952
7953 Returns an SQL expression identifying inactive cust_main records (customers with
7954 no active recurring packages, but otherwise unsuspended/uncancelled).
7955
7956 =cut
7957
7958 sub inactive_sql { "
7959   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7960   AND
7961   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7962 "; }
7963
7964 =item susp_sql
7965 =item suspended_sql
7966
7967 Returns an SQL expression identifying suspended cust_main records.
7968
7969 =cut
7970
7971
7972 sub suspended_sql { susp_sql(@_); }
7973 sub susp_sql { "
7974     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7975     AND
7976     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7977 "; }
7978
7979 =item cancel_sql
7980 =item cancelled_sql
7981
7982 Returns an SQL expression identifying cancelled cust_main records.
7983
7984 =cut
7985
7986 sub cancelled_sql { cancel_sql(@_); }
7987 sub cancel_sql {
7988
7989   my $recurring_sql = FS::cust_pkg->recurring_sql;
7990   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7991
7992   "
7993         0 < ( $select_count_pkgs )
7994     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7995     AND 0 = ( $select_count_pkgs AND $recurring_sql
7996                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7997             )
7998     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7999   ";
8000
8001 }
8002
8003 =item uncancel_sql
8004 =item uncancelled_sql
8005
8006 Returns an SQL expression identifying un-cancelled cust_main records.
8007
8008 =cut
8009
8010 sub uncancelled_sql { uncancel_sql(@_); }
8011 sub uncancel_sql { "
8012   ( 0 < ( $select_count_pkgs
8013                    AND ( cust_pkg.cancel IS NULL
8014                          OR cust_pkg.cancel = 0
8015                        )
8016         )
8017     OR 0 = ( $select_count_pkgs )
8018   )
8019 "; }
8020
8021 =item balance_sql
8022
8023 Returns an SQL fragment to retreive the balance.
8024
8025 =cut
8026
8027 sub balance_sql { "
8028     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
8029         WHERE cust_bill.custnum   = cust_main.custnum     )
8030   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
8031         WHERE cust_pay.custnum    = cust_main.custnum     )
8032   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
8033         WHERE cust_credit.custnum = cust_main.custnum     )
8034   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
8035         WHERE cust_refund.custnum = cust_main.custnum     )
8036 "; }
8037
8038 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8039
8040 Returns an SQL fragment to retreive the balance for this customer, only
8041 considering invoices with date earlier than START_TIME, and optionally not
8042 later than END_TIME (total_owed_date minus total_unapplied_credits minus
8043 total_unapplied_payments).
8044
8045 Times are specified as SQL fragments or numeric
8046 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
8047 L<Date::Parse> for conversion functions.  The empty string can be passed
8048 to disable that time constraint completely.
8049
8050 Available options are:
8051
8052 =over 4
8053
8054 =item unapplied_date
8055
8056 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)
8057
8058 =item total
8059
8060 (unused.  obsolete?)
8061 set to true to remove all customer comparison clauses, for totals
8062
8063 =item where
8064
8065 (unused.  obsolete?)
8066 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
8067
8068 =item join
8069
8070 (unused.  obsolete?)
8071 JOIN clause (typically used with the total option)
8072
8073 =back
8074
8075 =cut
8076
8077 sub balance_date_sql {
8078   my( $class, $start, $end, %opt ) = @_;
8079
8080   my $owed         = FS::cust_bill->owed_sql;
8081   my $unapp_refund = FS::cust_refund->unapplied_sql;
8082   my $unapp_credit = FS::cust_credit->unapplied_sql;
8083   my $unapp_pay    = FS::cust_pay->unapplied_sql;
8084
8085   my $j = $opt{'join'} || '';
8086
8087   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
8088   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
8089   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
8090   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
8091
8092   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
8093     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
8094     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
8095     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
8096   ";
8097
8098 }
8099
8100 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
8101
8102 Returns an SQL fragment to retreive the total unapplied payments for this
8103 customer, only considering invoices with date earlier than START_TIME, and
8104 optionally not later than END_TIME.
8105
8106 Times are specified as SQL fragments or numeric
8107 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
8108 L<Date::Parse> for conversion functions.  The empty string can be passed
8109 to disable that time constraint completely.
8110
8111 Available options are:
8112
8113 =cut
8114
8115 sub unapplied_payments_date_sql {
8116   my( $class, $start, $end, ) = @_;
8117
8118   my $unapp_pay    = FS::cust_pay->unapplied_sql;
8119
8120   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
8121                                                           'unapplied_date'=>1 );
8122
8123   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
8124 }
8125
8126 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8127
8128 Helper method for balance_date_sql; name (and usage) subject to change
8129 (suggestions welcome).
8130
8131 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
8132 cust_refund, cust_credit or cust_pay).
8133
8134 If TABLE is "cust_bill" or the unapplied_date option is true, only
8135 considers records with date earlier than START_TIME, and optionally not
8136 later than END_TIME .
8137
8138 =cut
8139
8140 sub _money_table_where {
8141   my( $class, $table, $start, $end, %opt ) = @_;
8142
8143   my @where = ();
8144   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
8145   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
8146     push @where, "$table._date <= $start" if defined($start) && length($start);
8147     push @where, "$table._date >  $end"   if defined($end)   && length($end);
8148   }
8149   push @where, @{$opt{'where'}} if $opt{'where'};
8150   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
8151
8152   $where;
8153
8154 }
8155
8156 =item search_sql HASHREF
8157
8158 (Class method)
8159
8160 Returns a qsearch hash expression to search for parameters specified in HREF.
8161 Valid parameters are
8162
8163 =over 4
8164
8165 =item agentnum
8166
8167 =item status
8168
8169 =item cancelled_pkgs
8170
8171 bool
8172
8173 =item signupdate
8174
8175 listref of start date, end date
8176
8177 =item payby
8178
8179 listref
8180
8181 =item paydate_year
8182
8183 =item paydate_month
8184
8185 =item current_balance
8186
8187 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
8188
8189 =item cust_fields
8190
8191 =item flattened_pkgs
8192
8193 bool
8194
8195 =back
8196
8197 =cut
8198
8199 sub search_sql {
8200   my ($class, $params) = @_;
8201
8202   my $dbh = dbh;
8203
8204   my @where = ();
8205   my $orderby;
8206
8207   ##
8208   # parse agent
8209   ##
8210
8211   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
8212     push @where,
8213       "cust_main.agentnum = $1";
8214   }
8215
8216   ##
8217   # parse status
8218   ##
8219
8220   #prospect active inactive suspended cancelled
8221   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
8222     my $method = $params->{'status'}. '_sql';
8223     #push @where, $class->$method();
8224     push @where, FS::cust_main->$method();
8225   }
8226
8227   ##
8228   # parse cancelled package checkbox
8229   ##
8230
8231   my $pkgwhere = "";
8232
8233   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
8234     unless $params->{'cancelled_pkgs'};
8235
8236   ##
8237   # parse without census tract checkbox
8238   ##
8239
8240   push @where, "(censustract = '' or censustract is null)"
8241     if $params->{'no_censustract'};
8242
8243   ##
8244   # dates
8245   ##
8246
8247   foreach my $field (qw( signupdate )) {
8248
8249     next unless exists($params->{$field});
8250
8251     my($beginning, $ending) = @{$params->{$field}};
8252
8253     push @where,
8254       "cust_main.$field IS NOT NULL",
8255       "cust_main.$field >= $beginning",
8256       "cust_main.$field <= $ending";
8257
8258     $orderby ||= "ORDER BY cust_main.$field";
8259
8260   }
8261
8262   ###
8263   # payby
8264   ###
8265
8266   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8267   if ( @payby ) {
8268     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
8269   }
8270
8271   ###
8272   # paydate_year / paydate_month
8273   ###
8274
8275   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8276     my $year = $1;
8277     $params->{'paydate_month'} =~ /^(\d\d?)$/
8278       or die "paydate_year without paydate_month?";
8279     my $month = $1;
8280
8281     push @where,
8282       'paydate IS NOT NULL',
8283       "paydate != ''",
8284       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8285 ;
8286   }
8287
8288   ###
8289   # invoice terms
8290   ###
8291
8292   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8293     my $terms = $1;
8294     if ( $1 eq 'NULL' ) {
8295       push @where,
8296         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8297     } else {
8298       push @where,
8299         "cust_main.invoice_terms IS NOT NULL",
8300         "cust_main.invoice_terms = '$1'";
8301     }
8302   }
8303
8304   ##
8305   # amounts
8306   ##
8307
8308   if ( $params->{'current_balance'} ) {
8309
8310     #my $balance_sql = $class->balance_sql();
8311     my $balance_sql = FS::cust_main->balance_sql();
8312
8313     my @current_balance =
8314       ref( $params->{'current_balance'} )
8315       ? @{ $params->{'current_balance'} }
8316       :  ( $params->{'current_balance'} );
8317
8318     push @where, map { s/current_balance/$balance_sql/; $_ }
8319                      @current_balance;
8320
8321   }
8322
8323   ##
8324   # custbatch
8325   ##
8326
8327   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8328     push @where,
8329       "cust_main.custbatch = '$1'";
8330   }
8331
8332   ##
8333   # setup queries, subs, etc. for the search
8334   ##
8335
8336   $orderby ||= 'ORDER BY custnum';
8337
8338   # here is the agent virtualization
8339   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8340
8341   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8342
8343   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
8344
8345   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8346
8347   my $select = join(', ',
8348                  'cust_main.custnum',
8349                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8350                );
8351
8352   my(@extra_headers) = ();
8353   my(@extra_fields)  = ();
8354
8355   if ($params->{'flattened_pkgs'}) {
8356
8357     if ($dbh->{Driver}->{Name} eq 'Pg') {
8358
8359       $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";
8360
8361     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8362       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8363       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8364     }else{
8365       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8366            "omitting packing information from report.";
8367     }
8368
8369     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";
8370
8371     my $sth = dbh->prepare($header_query) or die dbh->errstr;
8372     $sth->execute() or die $sth->errstr;
8373     my $headerrow = $sth->fetchrow_arrayref;
8374     my $headercount = $headerrow ? $headerrow->[0] : 0;
8375     while($headercount) {
8376       unshift @extra_headers, "Package ". $headercount;
8377       unshift @extra_fields, eval q!sub {my $c = shift;
8378                                          my @a = split '\|', $c->magic;
8379                                          my $p = $a[!.--$headercount. q!];
8380                                          $p;
8381                                         };!;
8382     }
8383
8384   }
8385
8386   my $sql_query = {
8387     'table'         => 'cust_main',
8388     'select'        => $select,
8389     'hashref'       => {},
8390     'extra_sql'     => $extra_sql,
8391     'order_by'      => $orderby,
8392     'count_query'   => $count_query,
8393     'extra_headers' => \@extra_headers,
8394     'extra_fields'  => \@extra_fields,
8395   };
8396
8397 }
8398
8399 =item email_search_sql HASHREF
8400
8401 (Class method)
8402
8403 Emails a notice to the specified customers.
8404
8405 Valid parameters are those of the L<search_sql> method, plus the following:
8406
8407 =over 4
8408
8409 =item from
8410
8411 From: address
8412
8413 =item subject
8414
8415 Email Subject:
8416
8417 =item html_body
8418
8419 HTML body
8420
8421 =item text_body
8422
8423 Text body
8424
8425 =item job
8426
8427 Optional job queue job for status updates.
8428
8429 =back
8430
8431 Returns an error message, or false for success.
8432
8433 If an error occurs during any email, stops the enture send and returns that
8434 error.  Presumably if you're getting SMTP errors aborting is better than
8435 retrying everything.
8436
8437 =cut
8438
8439 sub email_search_sql {
8440   my($class, $params) = @_;
8441
8442   my $from = delete $params->{from};
8443   my $subject = delete $params->{subject};
8444   my $html_body = delete $params->{html_body};
8445   my $text_body = delete $params->{text_body};
8446
8447   my $job = delete $params->{'job'};
8448
8449   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8450     unless ref($params->{'payby'});
8451
8452   my $sql_query = $class->search_sql($params);
8453
8454   my $count_query   = delete($sql_query->{'count_query'});
8455   my $count_sth = dbh->prepare($count_query)
8456     or die "Error preparing $count_query: ". dbh->errstr;
8457   $count_sth->execute
8458     or die "Error executing $count_query: ". $count_sth->errstr;
8459   my $count_arrayref = $count_sth->fetchrow_arrayref;
8460   my $num_cust = $count_arrayref->[0];
8461
8462   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8463   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
8464
8465
8466   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8467
8468   #eventually order+limit magic to reduce memory use?
8469   foreach my $cust_main ( qsearch($sql_query) ) {
8470
8471     my $to = $cust_main->invoicing_list_emailonly_scalar;
8472     next unless $to;
8473
8474     my $error = send_email(
8475       generate_email(
8476         'from'      => $from,
8477         'to'        => $to,
8478         'subject'   => $subject,
8479         'html_body' => $html_body,
8480         'text_body' => $text_body,
8481       )
8482     );
8483     return $error if $error;
8484
8485     if ( $job ) { #progressbar foo
8486       $num++;
8487       if ( time - $min_sec > $last ) {
8488         my $error = $job->update_statustext(
8489           int( 100 * $num / $num_cust )
8490         );
8491         die $error if $error;
8492         $last = time;
8493       }
8494     }
8495
8496   }
8497
8498   return '';
8499 }
8500
8501 use Storable qw(thaw);
8502 use Data::Dumper;
8503 use MIME::Base64;
8504 sub process_email_search_sql {
8505   my $job = shift;
8506   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8507
8508   my $param = thaw(decode_base64(shift));
8509   warn Dumper($param) if $DEBUG;
8510
8511   $param->{'job'} = $job;
8512
8513   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8514     unless ref($param->{'payby'});
8515
8516   my $error = FS::cust_main->email_search_sql( $param );
8517   die $error if $error;
8518
8519 }
8520
8521 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8522
8523 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8524 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8525 specified (the appropriate ship_ field is also searched).
8526
8527 Additional options are the same as FS::Record::qsearch
8528
8529 =cut
8530
8531 sub fuzzy_search {
8532   my( $self, $fuzzy, $hash, @opt) = @_;
8533   #$self
8534   $hash ||= {};
8535   my @cust_main = ();
8536
8537   check_and_rebuild_fuzzyfiles();
8538   foreach my $field ( keys %$fuzzy ) {
8539
8540     my $all = $self->all_X($field);
8541     next unless scalar(@$all);
8542
8543     my %match = ();
8544     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8545
8546     my @fcust = ();
8547     foreach ( keys %match ) {
8548       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8549       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8550     }
8551     my %fsaw = ();
8552     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8553   }
8554
8555   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8556   my %saw = ();
8557   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8558
8559   @cust_main;
8560
8561 }
8562
8563 =item masked FIELD
8564
8565 Returns a masked version of the named field
8566
8567 =cut
8568
8569 sub masked {
8570 my ($self,$field) = @_;
8571
8572 # Show last four
8573
8574 'x'x(length($self->getfield($field))-4).
8575   substr($self->getfield($field), (length($self->getfield($field))-4));
8576
8577 }
8578
8579 =back
8580
8581 =head1 SUBROUTINES
8582
8583 =over 4
8584
8585 =item smart_search OPTION => VALUE ...
8586
8587 Accepts the following options: I<search>, the string to search for.  The string
8588 will be searched for as a customer number, phone number, name or company name,
8589 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8590 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8591 skip fuzzy matching when an exact match is found.
8592
8593 Any additional options are treated as an additional qualifier on the search
8594 (i.e. I<agentnum>).
8595
8596 Returns a (possibly empty) array of FS::cust_main objects.
8597
8598 =cut
8599
8600 sub smart_search {
8601   my %options = @_;
8602
8603   #here is the agent virtualization
8604   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8605
8606   my @cust_main = ();
8607
8608   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8609   my $search = delete $options{'search'};
8610   ( my $alphanum_search = $search ) =~ s/\W//g;
8611
8612   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8613
8614     #false laziness w/Record::ut_phone
8615     my $phonen = "$1-$2-$3";
8616     $phonen .= " x$4" if $4;
8617
8618     push @cust_main, qsearch( {
8619       'table'   => 'cust_main',
8620       'hashref' => { %options },
8621       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8622                      ' ( '.
8623                          join(' OR ', map "$_ = '$phonen'",
8624                                           qw( daytime night fax
8625                                               ship_daytime ship_night ship_fax )
8626                              ).
8627                      ' ) '.
8628                      " AND $agentnums_sql", #agent virtualization
8629     } );
8630
8631     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8632       #try looking for matches with extensions unless one was specified
8633
8634       push @cust_main, qsearch( {
8635         'table'   => 'cust_main',
8636         'hashref' => { %options },
8637         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8638                        ' ( '.
8639                            join(' OR ', map "$_ LIKE '$phonen\%'",
8640                                             qw( daytime night
8641                                                 ship_daytime ship_night )
8642                                ).
8643                        ' ) '.
8644                        " AND $agentnums_sql", #agent virtualization
8645       } );
8646
8647     }
8648
8649   # custnum search (also try agent_custid), with some tweaking options if your
8650   # legacy cust "numbers" have letters
8651   }
8652
8653   if ( $search =~ /^\s*(\d+)\s*$/
8654          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8655               && $search =~ /^\s*(\w\w?\d+)\s*$/
8656             )
8657          || ( $conf->exists('address1-search' )
8658               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8659             )
8660      )
8661   {
8662
8663     my $num = $1;
8664
8665     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8666       push @cust_main, qsearch( {
8667         'table'     => 'cust_main',
8668         'hashref'   => { 'custnum' => $num, %options },
8669         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8670       } );
8671     }
8672
8673     push @cust_main, qsearch( {
8674       'table'     => 'cust_main',
8675       'hashref'   => { 'agent_custid' => $num, %options },
8676       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8677     } );
8678
8679     if ( $conf->exists('address1-search') ) {
8680       my $len = length($num);
8681       $num = lc($num);
8682       foreach my $prefix ( '', 'ship_' ) {
8683         push @cust_main, qsearch( {
8684           'table'     => 'cust_main',
8685           'hashref'   => { %options, },
8686           'extra_sql' =>
8687             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8688             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8689             " AND $agentnums_sql",
8690         } );
8691       }
8692     }
8693
8694   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8695
8696     my($company, $last, $first) = ( $1, $2, $3 );
8697
8698     # "Company (Last, First)"
8699     #this is probably something a browser remembered,
8700     #so just do an exact search (but case-insensitive, so USPS standardization
8701     #doesn't throw a wrench in the works)
8702
8703     foreach my $prefix ( '', 'ship_' ) {
8704       push @cust_main, qsearch( {
8705         'table'     => 'cust_main',
8706         'hashref'   => { %options },
8707         'extra_sql' =>
8708           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8709           join(' AND ',
8710             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8711             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8712             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8713             $agentnums_sql,
8714           ),
8715       } );
8716     }
8717
8718   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8719                                               # try (ship_){last,company}
8720
8721     my $value = lc($1);
8722
8723     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8724     # # full strings the browser remembers won't work
8725     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8726
8727     use Lingua::EN::NameParse;
8728     my $NameParse = new Lingua::EN::NameParse(
8729              auto_clean     => 1,
8730              allow_reversed => 1,
8731     );
8732
8733     my($last, $first) = ( '', '' );
8734     #maybe disable this too and just rely on NameParse?
8735     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8736
8737       ($last, $first) = ( $1, $2 );
8738
8739     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8740     } elsif ( ! $NameParse->parse($value) ) {
8741
8742       my %name = $NameParse->components;
8743       $first = $name{'given_name_1'};
8744       $last  = $name{'surname_1'};
8745
8746     }
8747
8748     if ( $first && $last ) {
8749
8750       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8751
8752       #exact
8753       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8754       $sql .= "
8755         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8756            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8757         )";
8758
8759       push @cust_main, qsearch( {
8760         'table'     => 'cust_main',
8761         'hashref'   => \%options,
8762         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8763       } );
8764
8765       # or it just be something that was typed in... (try that in a sec)
8766
8767     }
8768
8769     my $q_value = dbh->quote($value);
8770
8771     #exact
8772     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8773     $sql .= " (    LOWER(last)          = $q_value
8774                 OR LOWER(company)       = $q_value
8775                 OR LOWER(ship_last)     = $q_value
8776                 OR LOWER(ship_company)  = $q_value
8777             ";
8778     $sql .= "   OR LOWER(address1)      = $q_value
8779                 OR LOWER(ship_address1) = $q_value
8780             "
8781       if $conf->exists('address1-search');
8782     $sql .= " )";
8783
8784     push @cust_main, qsearch( {
8785       'table'     => 'cust_main',
8786       'hashref'   => \%options,
8787       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8788     } );
8789
8790     #no exact match, trying substring/fuzzy
8791     #always do substring & fuzzy (unless they're explicity config'ed off)
8792     #getting complaints searches are not returning enough
8793     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8794
8795       #still some false laziness w/search_sql (was search/cust_main.cgi)
8796
8797       #substring
8798
8799       my @hashrefs = (
8800         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8801         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8802       );
8803
8804       if ( $first && $last ) {
8805
8806         push @hashrefs,
8807           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8808             'last'         => { op=>'ILIKE', value=>"%$last%" },
8809           },
8810           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8811             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8812           },
8813         ;
8814
8815       } else {
8816
8817         push @hashrefs,
8818           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8819           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8820         ;
8821       }
8822
8823       if ( $conf->exists('address1-search') ) {
8824         push @hashrefs,
8825           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8826           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8827         ;
8828       }
8829
8830       foreach my $hashref ( @hashrefs ) {
8831
8832         push @cust_main, qsearch( {
8833           'table'     => 'cust_main',
8834           'hashref'   => { %$hashref,
8835                            %options,
8836                          },
8837           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8838         } );
8839
8840       }
8841
8842       #fuzzy
8843       my @fuzopts = (
8844         \%options,                #hashref
8845         '',                       #select
8846         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8847       );
8848
8849       if ( $first && $last ) {
8850         push @cust_main, FS::cust_main->fuzzy_search(
8851           { 'last'   => $last,    #fuzzy hashref
8852             'first'  => $first }, #
8853           @fuzopts
8854         );
8855       }
8856       foreach my $field ( 'last', 'company' ) {
8857         push @cust_main,
8858           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8859       }
8860       if ( $conf->exists('address1-search') ) {
8861         push @cust_main,
8862           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8863       }
8864
8865     }
8866
8867   }
8868
8869   #eliminate duplicates
8870   my %saw = ();
8871   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8872
8873   @cust_main;
8874
8875 }
8876
8877 =item email_search
8878
8879 Accepts the following options: I<email>, the email address to search for.  The
8880 email address will be searched for as an email invoice destination and as an
8881 svc_acct account.
8882
8883 #Any additional options are treated as an additional qualifier on the search
8884 #(i.e. I<agentnum>).
8885
8886 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8887 none or one).
8888
8889 =cut
8890
8891 sub email_search {
8892   my %options = @_;
8893
8894   local($DEBUG) = 1;
8895
8896   my $email = delete $options{'email'};
8897
8898   #we're only being used by RT at the moment... no agent virtualization yet
8899   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8900
8901   my @cust_main = ();
8902
8903   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8904
8905     my ( $user, $domain ) = ( $1, $2 );
8906
8907     warn "$me smart_search: searching for $user in domain $domain"
8908       if $DEBUG;
8909
8910     push @cust_main,
8911       map $_->cust_main,
8912           qsearch( {
8913                      'table'     => 'cust_main_invoice',
8914                      'hashref'   => { 'dest' => $email },
8915                    }
8916                  );
8917
8918     push @cust_main,
8919       map  $_->cust_main,
8920       grep $_,
8921       map  $_->cust_svc->cust_pkg,
8922           qsearch( {
8923                      'table'     => 'svc_acct',
8924                      'hashref'   => { 'username' => $user, },
8925                      'extra_sql' =>
8926                        'AND ( SELECT domain FROM svc_domain
8927                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8928                             ) = '. dbh->quote($domain),
8929                    }
8930                  );
8931   }
8932
8933   my %saw = ();
8934   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8935
8936   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8937     if $DEBUG;
8938
8939   @cust_main;
8940
8941 }
8942
8943 =item check_and_rebuild_fuzzyfiles
8944
8945 =cut
8946
8947 sub check_and_rebuild_fuzzyfiles {
8948   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8949   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8950 }
8951
8952 =item rebuild_fuzzyfiles
8953
8954 =cut
8955
8956 sub rebuild_fuzzyfiles {
8957
8958   use Fcntl qw(:flock);
8959
8960   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8961   mkdir $dir, 0700 unless -d $dir;
8962
8963   foreach my $fuzzy ( @fuzzyfields ) {
8964
8965     open(LOCK,">>$dir/cust_main.$fuzzy")
8966       or die "can't open $dir/cust_main.$fuzzy: $!";
8967     flock(LOCK,LOCK_EX)
8968       or die "can't lock $dir/cust_main.$fuzzy: $!";
8969
8970     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8971       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8972
8973     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8974       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8975                              " WHERE $field != '' AND $field IS NOT NULL");
8976       $sth->execute or die $sth->errstr;
8977
8978       while ( my $row = $sth->fetchrow_arrayref ) {
8979         print CACHE $row->[0]. "\n";
8980       }
8981
8982     }
8983
8984     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8985
8986     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8987     close LOCK;
8988   }
8989
8990 }
8991
8992 =item all_X
8993
8994 =cut
8995
8996 sub all_X {
8997   my( $self, $field ) = @_;
8998   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8999   open(CACHE,"<$dir/cust_main.$field")
9000     or die "can't open $dir/cust_main.$field: $!";
9001   my @array = map { chomp; $_; } <CACHE>;
9002   close CACHE;
9003   \@array;
9004 }
9005
9006 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
9007
9008 =cut
9009
9010 sub append_fuzzyfiles {
9011   #my( $first, $last, $company ) = @_;
9012
9013   &check_and_rebuild_fuzzyfiles;
9014
9015   use Fcntl qw(:flock);
9016
9017   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
9018
9019   foreach my $field (@fuzzyfields) {
9020     my $value = shift;
9021
9022     if ( $value ) {
9023
9024       open(CACHE,">>$dir/cust_main.$field")
9025         or die "can't open $dir/cust_main.$field: $!";
9026       flock(CACHE,LOCK_EX)
9027         or die "can't lock $dir/cust_main.$field: $!";
9028
9029       print CACHE "$value\n";
9030
9031       flock(CACHE,LOCK_UN)
9032         or die "can't unlock $dir/cust_main.$field: $!";
9033       close CACHE;
9034     }
9035
9036   }
9037
9038   1;
9039 }
9040
9041 =item batch_charge
9042
9043 =cut
9044
9045 sub batch_charge {
9046   my $param = shift;
9047   #warn join('-',keys %$param);
9048   my $fh = $param->{filehandle};
9049   my @fields = @{$param->{fields}};
9050
9051   eval "use Text::CSV_XS;";
9052   die $@ if $@;
9053
9054   my $csv = new Text::CSV_XS;
9055   #warn $csv;
9056   #warn $fh;
9057
9058   my $imported = 0;
9059   #my $columns;
9060
9061   local $SIG{HUP} = 'IGNORE';
9062   local $SIG{INT} = 'IGNORE';
9063   local $SIG{QUIT} = 'IGNORE';
9064   local $SIG{TERM} = 'IGNORE';
9065   local $SIG{TSTP} = 'IGNORE';
9066   local $SIG{PIPE} = 'IGNORE';
9067
9068   my $oldAutoCommit = $FS::UID::AutoCommit;
9069   local $FS::UID::AutoCommit = 0;
9070   my $dbh = dbh;
9071
9072   #while ( $columns = $csv->getline($fh) ) {
9073   my $line;
9074   while ( defined($line=<$fh>) ) {
9075
9076     $csv->parse($line) or do {
9077       $dbh->rollback if $oldAutoCommit;
9078       return "can't parse: ". $csv->error_input();
9079     };
9080
9081     my @columns = $csv->fields();
9082     #warn join('-',@columns);
9083
9084     my %row = ();
9085     foreach my $field ( @fields ) {
9086       $row{$field} = shift @columns;
9087     }
9088
9089     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
9090     unless ( $cust_main ) {
9091       $dbh->rollback if $oldAutoCommit;
9092       return "unknown custnum $row{'custnum'}";
9093     }
9094
9095     if ( $row{'amount'} > 0 ) {
9096       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
9097       if ( $error ) {
9098         $dbh->rollback if $oldAutoCommit;
9099         return $error;
9100       }
9101       $imported++;
9102     } elsif ( $row{'amount'} < 0 ) {
9103       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
9104                                       $row{'pkg'}                         );
9105       if ( $error ) {
9106         $dbh->rollback if $oldAutoCommit;
9107         return $error;
9108       }
9109       $imported++;
9110     } else {
9111       #hmm?
9112     }
9113
9114   }
9115
9116   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
9117
9118   return "Empty file!" unless $imported;
9119
9120   ''; #no error
9121
9122 }
9123
9124 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9125
9126 Sends a templated email notification to the customer (see L<Text::Template>).
9127
9128 OPTIONS is a hash and may include
9129
9130 I<from> - the email sender (default is invoice_from)
9131
9132 I<to> - comma-separated scalar or arrayref of recipients
9133    (default is invoicing_list)
9134
9135 I<subject> - The subject line of the sent email notification
9136    (default is "Notice from company_name")
9137
9138 I<extra_fields> - a hashref of name/value pairs which will be substituted
9139    into the template
9140
9141 The following variables are vavailable in the template.
9142
9143 I<$first> - the customer first name
9144 I<$last> - the customer last name
9145 I<$company> - the customer company
9146 I<$payby> - a description of the method of payment for the customer
9147             # would be nice to use FS::payby::shortname
9148 I<$payinfo> - the account information used to collect for this customer
9149 I<$expdate> - the expiration of the customer payment in seconds from epoch
9150
9151 =cut
9152
9153 sub notify {
9154   my ($self, $template, %options) = @_;
9155
9156   return unless $conf->exists($template);
9157
9158   my $from = $conf->config('invoice_from', $self->agentnum)
9159     if $conf->exists('invoice_from', $self->agentnum);
9160   $from = $options{from} if exists($options{from});
9161
9162   my $to = join(',', $self->invoicing_list_emailonly);
9163   $to = $options{to} if exists($options{to});
9164
9165   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
9166     if $conf->exists('company_name', $self->agentnum);
9167   $subject = $options{subject} if exists($options{subject});
9168
9169   my $notify_template = new Text::Template (TYPE => 'ARRAY',
9170                                             SOURCE => [ map "$_\n",
9171                                               $conf->config($template)]
9172                                            )
9173     or die "can't create new Text::Template object: Text::Template::ERROR";
9174   $notify_template->compile()
9175     or die "can't compile template: Text::Template::ERROR";
9176
9177   $FS::notify_template::_template::company_name =
9178     $conf->config('company_name', $self->agentnum);
9179   $FS::notify_template::_template::company_address =
9180     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9181
9182   my $paydate = $self->paydate || '2037-12-31';
9183   $FS::notify_template::_template::first = $self->first;
9184   $FS::notify_template::_template::last = $self->last;
9185   $FS::notify_template::_template::company = $self->company;
9186   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9187   my $payby = $self->payby;
9188   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9189   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9190
9191   #credit cards expire at the end of the month/year of their exp date
9192   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9193     $FS::notify_template::_template::payby = 'credit card';
9194     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9195     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9196     $expire_time--;
9197   }elsif ($payby eq 'COMP') {
9198     $FS::notify_template::_template::payby = 'complimentary account';
9199   }else{
9200     $FS::notify_template::_template::payby = 'current method';
9201   }
9202   $FS::notify_template::_template::expdate = $expire_time;
9203
9204   for (keys %{$options{extra_fields}}){
9205     no strict "refs";
9206     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9207   }
9208
9209   send_email(from => $from,
9210              to => $to,
9211              subject => $subject,
9212              body => $notify_template->fill_in( PACKAGE =>
9213                                                 'FS::notify_template::_template'                                              ),
9214             );
9215
9216 }
9217
9218 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9219
9220 Generates a templated notification to the customer (see L<Text::Template>).
9221
9222 OPTIONS is a hash and may include
9223
9224 I<extra_fields> - a hashref of name/value pairs which will be substituted
9225    into the template.  These values may override values mentioned below
9226    and those from the customer record.
9227
9228 The following variables are available in the template instead of or in addition
9229 to the fields of the customer record.
9230
9231 I<$payby> - a description of the method of payment for the customer
9232             # would be nice to use FS::payby::shortname
9233 I<$payinfo> - the masked account information used to collect for this customer
9234 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9235 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9236
9237 =cut
9238
9239 sub generate_letter {
9240   my ($self, $template, %options) = @_;
9241
9242   return unless $conf->exists($template);
9243
9244   my $letter_template = new Text::Template
9245                         ( TYPE       => 'ARRAY',
9246                           SOURCE     => [ map "$_\n", $conf->config($template)],
9247                           DELIMITERS => [ '[@--', '--@]' ],
9248                         )
9249     or die "can't create new Text::Template object: Text::Template::ERROR";
9250
9251   $letter_template->compile()
9252     or die "can't compile template: Text::Template::ERROR";
9253
9254   my %letter_data = map { $_ => $self->$_ } $self->fields;
9255   $letter_data{payinfo} = $self->mask_payinfo;
9256
9257   #my $paydate = $self->paydate || '2037-12-31';
9258   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9259
9260   my $payby = $self->payby;
9261   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9262   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9263
9264   #credit cards expire at the end of the month/year of their exp date
9265   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9266     $letter_data{payby} = 'credit card';
9267     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9268     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9269     $expire_time--;
9270   }elsif ($payby eq 'COMP') {
9271     $letter_data{payby} = 'complimentary account';
9272   }else{
9273     $letter_data{payby} = 'current method';
9274   }
9275   $letter_data{expdate} = $expire_time;
9276
9277   for (keys %{$options{extra_fields}}){
9278     $letter_data{$_} = $options{extra_fields}->{$_};
9279   }
9280
9281   unless(exists($letter_data{returnaddress})){
9282     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9283                                                   $self->agent_template)
9284                      );
9285     if ( length($retadd) ) {
9286       $letter_data{returnaddress} = $retadd;
9287     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9288       $letter_data{returnaddress} =
9289         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
9290                           $conf->config('company_address', $self->agentnum)
9291         );
9292     } else {
9293       $letter_data{returnaddress} = '~';
9294     }
9295   }
9296
9297   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9298
9299   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9300
9301   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9302   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9303                            DIR      => $dir,
9304                            SUFFIX   => '.tex',
9305                            UNLINK   => 0,
9306                          ) or die "can't open temp file: $!\n";
9307
9308   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9309   close $fh;
9310   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9311   return $1;
9312 }
9313
9314 =item print_ps TEMPLATE
9315
9316 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9317
9318 =cut
9319
9320 sub print_ps {
9321   my $self = shift;
9322   my $file = $self->generate_letter(@_);
9323   FS::Misc::generate_ps($file);
9324 }
9325
9326 =item print TEMPLATE
9327
9328 Prints the filled in template.
9329
9330 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9331
9332 =cut
9333
9334 sub queueable_print {
9335   my %opt = @_;
9336
9337   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9338     or die "invalid customer number: " . $opt{custvnum};
9339
9340   my $error = $self->print( $opt{template} );
9341   die $error if $error;
9342 }
9343
9344 sub print {
9345   my ($self, $template) = (shift, shift);
9346   do_print [ $self->print_ps($template) ];
9347 }
9348
9349 #these three subs should just go away once agent stuff is all config overrides
9350
9351 sub agent_template {
9352   my $self = shift;
9353   $self->_agent_plandata('agent_templatename');
9354 }
9355
9356 sub agent_invoice_from {
9357   my $self = shift;
9358   $self->_agent_plandata('agent_invoice_from');
9359 }
9360
9361 sub _agent_plandata {
9362   my( $self, $option ) = @_;
9363
9364   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
9365   #agent-specific Conf
9366
9367   use FS::part_event::Condition;
9368
9369   my $agentnum = $self->agentnum;
9370
9371   my $regexp = '';
9372   if ( driver_name =~ /^Pg/i ) {
9373     $regexp = '~';
9374   } elsif ( driver_name =~ /^mysql/i ) {
9375     $regexp = 'REGEXP';
9376   } else {
9377     die "don't know how to use regular expressions in ". driver_name. " databases";
9378   }
9379
9380   my $part_event_option =
9381     qsearchs({
9382       'select'    => 'part_event_option.*',
9383       'table'     => 'part_event_option',
9384       'addl_from' => q{
9385         LEFT JOIN part_event USING ( eventpart )
9386         LEFT JOIN part_event_option AS peo_agentnum
9387           ON ( part_event.eventpart = peo_agentnum.eventpart
9388                AND peo_agentnum.optionname = 'agentnum'
9389                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9390              )
9391         LEFT JOIN part_event_condition
9392           ON ( part_event.eventpart = part_event_condition.eventpart
9393                AND part_event_condition.conditionname = 'cust_bill_age'
9394              )
9395         LEFT JOIN part_event_condition_option
9396           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9397                AND part_event_condition_option.optionname = 'age'
9398              )
9399       },
9400       #'hashref'   => { 'optionname' => $option },
9401       #'hashref'   => { 'part_event_option.optionname' => $option },
9402       'extra_sql' =>
9403         " WHERE part_event_option.optionname = ". dbh->quote($option).
9404         " AND action = 'cust_bill_send_agent' ".
9405         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9406         " AND peo_agentnum.optionname = 'agentnum' ".
9407         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9408         " ORDER BY
9409            CASE WHEN part_event_condition_option.optionname IS NULL
9410            THEN -1
9411            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9412         " END
9413           , part_event.weight".
9414         " LIMIT 1"
9415     });
9416
9417   unless ( $part_event_option ) {
9418     return $self->agent->invoice_template || ''
9419       if $option eq 'agent_templatename';
9420     return '';
9421   }
9422
9423   $part_event_option->optionvalue;
9424
9425 }
9426
9427 sub queued_bill {
9428   ## actual sub, not a method, designed to be called from the queue.
9429   ## sets up the customer, and calls the bill_and_collect
9430   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9431   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9432       $cust_main->bill_and_collect(
9433         %args,
9434       );
9435 }
9436
9437 sub _upgrade_data { #class method
9438   my ($class, %opts) = @_;
9439
9440   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9441   my $sth = dbh->prepare($sql) or die dbh->errstr;
9442   $sth->execute or die $sth->errstr;
9443
9444 }
9445
9446 =back
9447
9448 =head1 BUGS
9449
9450 The delete method.
9451
9452 The delete method should possibly take an FS::cust_main object reference
9453 instead of a scalar customer number.
9454
9455 Bill and collect options should probably be passed as references instead of a
9456 list.
9457
9458 There should probably be a configuration file with a list of allowed credit
9459 card types.
9460
9461 No multiple currency support (probably a larger project than just this module).
9462
9463 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9464
9465 Birthdates rely on negative epoch values.
9466
9467 The payby for card/check batches is broken.  With mixed batching, bad
9468 things will happen.
9469
9470 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9471
9472 =head1 SEE ALSO
9473
9474 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9475 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9476 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
9477
9478 =cut
9479
9480 1;
9481