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