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