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