FS/FS/cust_main.pm

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