FS/FS/cust_main.pm

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