FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
   5              $import $skip_fuzzyfiles $ignore_expired_card @paytypes);
   6 use vars qw( $realtime_bop_decline_quiet ); #ugh
   7 use Safe;
   8 use Carp;
   9 use Exporter;
  10 BEGIN {
  11   eval "use Time::Local;";
  12   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  13     if $] < 5.006 && !defined($Time::Local::VERSION);
  14   #eval "use Time::Local qw(timelocal timelocal_nocheck);";
  15   eval "use Time::Local qw(timelocal_nocheck);";
  16 }
  17 use Digest::MD5 qw(md5_base64);
  18 use Date::Format;
  19 use Date::Parse;
  20 #use Date::Manip;
  21 use String::Approx qw(amatch);
  22 use Business::CreditCard 0.28;
  23 use Locale::Country;
  24 use Data::Dumper;
  25 use FS::UID qw( getotaker dbh driver_name );
  26 use FS::Record qw( qsearchs qsearch dbdef );
  27 use FS::Misc qw( send_email generate_ps do_print );
  28 use FS::Msgcat qw(gettext);
  29 use FS::cust_pkg;
  30 use FS::cust_svc;
  31 use FS::cust_bill;
  32 use FS::cust_bill_pkg;
  33 use FS::cust_pay;
  34 use FS::cust_pay_pending;
  35 use FS::cust_pay_void;
  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_bill_event qw(due_events);
  48 use FS::cust_bill_event;
  49 use FS::cust_tax_exempt;
  50 use FS::cust_tax_exempt_pkg;
  51 use FS::type_pkgs;
  52 use FS::payment_gateway;
  53 use FS::agent_payment_gateway;
  54 use FS::banned_pay;
  55 use FS::payinfo_Mixin;
  56
  57 @ISA = qw( FS::Record FS::payinfo_Mixin );
  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 =back
 229
 230 =head1 METHODS
 231
 232 =over 4
 233
 234 =item new HASHREF
 235
 236 Creates a new customer.  To add the customer to the database, see L<"insert">.
 237
 238 Note that this stores the hash reference, not a distinct copy of the hash it
 239 points to.  You can ask the object for a copy with the I<hash> method.
 240
 241 =cut
 242
 243 sub table { 'cust_main'; }
 244
 245 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 246
 247 Adds this customer to the database.  If there is an error, returns the error,
 248 otherwise returns false.
 249
 250 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 251 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 252 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 253 hash reference is equivalent to not supplying this parameter.  There should be
 254 a better explanation of this, but until then, here's an example:
 255
 256   use Tie::RefHash;
 257   tie %hash, 'Tie::RefHash'; #this part is important
 258   %hash = (
 259     $cust_pkg => [ $svc_acct ],
 260     ...
 261   );
 262   $cust_main->insert( \%hash );
 263
 264 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 265 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 266 expected and rollback the entire transaction; it is not necessary to call
 267 check_invoicing_list first.  The invoicing_list is set after the records in the
 268 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 269 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 270
 271   $cust_main->insert( {}, [ $email, 'POST' ] );
 272
 273 Currently available options are: I<depend_jobnum> and I<noexport>.
 274
 275 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 276 on the supplied jobnum (they will not run until the specific job completes).
 277 This can be used to defer provisioning until some action completes (such
 278 as running the customer's credit card successfully).
 279
 280 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 281 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 282 the B<reexport> method.)
 283
 284 =cut
 285
 286 sub insert {
 287   my $self = shift;
 288   my $cust_pkgs = @_ ? shift : {};
 289   my $invoicing_list = @_ ? shift : '';
 290   my %options = @_;
 291   warn "$me insert called with options ".
 292        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 293     if $DEBUG;
 294
 295   local $SIG{HUP} = 'IGNORE';
 296   local $SIG{INT} = 'IGNORE';
 297   local $SIG{QUIT} = 'IGNORE';
 298   local $SIG{TERM} = 'IGNORE';
 299   local $SIG{TSTP} = 'IGNORE';
 300   local $SIG{PIPE} = 'IGNORE';
 301
 302   my $oldAutoCommit = $FS::UID::AutoCommit;
 303   local $FS::UID::AutoCommit = 0;
 304   my $dbh = dbh;
 305
 306   my $prepay_identifier = '';
 307   my( $amount, $seconds ) = ( 0, 0 );
 308   my $payby = '';
 309   if ( $self->payby eq 'PREPAY' ) {
 310
 311     $self->payby('BILL');
 312     $prepay_identifier = $self->payinfo;
 313     $self->payinfo('');
 314
 315     warn "  looking up prepaid card $prepay_identifier\n"
 316       if $DEBUG > 1;
 317
 318     my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds);
 319     if ( $error ) {
 320       $dbh->rollback if $oldAutoCommit;
 321       #return "error applying prepaid card (transaction rolled back): $error";
 322       return $error;
 323     }
 324
 325     $payby = 'PREP' if $amount;
 326
 327   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 328
 329     $payby = $1;
 330     $self->payby('BILL');
 331     $amount = $self->paid;
 332
 333   }
 334
 335   warn "  inserting $self\n"
 336     if $DEBUG > 1;
 337
 338   $self->signupdate(time) unless $self->signupdate;
 339
 340   my $error = $self->SUPER::insert;
 341   if ( $error ) {
 342     $dbh->rollback if $oldAutoCommit;
 343     #return "inserting cust_main record (transaction rolled back): $error";
 344     return $error;
 345   }
 346
 347   warn "  setting invoicing list\n"
 348     if $DEBUG > 1;
 349
 350   if ( $invoicing_list ) {
 351     $error = $self->check_invoicing_list( $invoicing_list );
 352     if ( $error ) {
 353       $dbh->rollback if $oldAutoCommit;
 354       #return "checking invoicing_list (transaction rolled back): $error";
 355       return $error;
 356     }
 357     $self->invoicing_list( $invoicing_list );
 358   }
 359
 360   if (    $conf->config('cust_main-skeleton_tables')
 361        && $conf->config('cust_main-skeleton_custnum') ) {
 362
 363     warn "  inserting skeleton records\n"
 364       if $DEBUG > 1;
 365
 366     my $error = $self->start_copy_skel;
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371
 372   }
 373
 374   warn "  ordering packages\n"
 375     if $DEBUG > 1;
 376
 377   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 378   if ( $error ) {
 379     $dbh->rollback if $oldAutoCommit;
 380     return $error;
 381   }
 382
 383   if ( $seconds ) {
 384     $dbh->rollback if $oldAutoCommit;
 385     return "No svc_acct record to apply pre-paid time";
 386   }
 387
 388   if ( $amount ) {
 389     warn "  inserting initial $payby payment of $amount\n"
 390       if $DEBUG > 1;
 391     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 392     if ( $error ) {
 393       $dbh->rollback if $oldAutoCommit;
 394       return "inserting payment (transaction rolled back): $error";
 395     }
 396   }
 397
 398   unless ( $import || $skip_fuzzyfiles ) {
 399     warn "  queueing fuzzyfiles update\n"
 400       if $DEBUG > 1;
 401     $error = $self->queue_fuzzyfiles_update;
 402     if ( $error ) {
 403       $dbh->rollback if $oldAutoCommit;
 404       return "updating fuzzy search cache: $error";
 405     }
 406   }
 407
 408   warn "  insert complete; committing transaction\n"
 409     if $DEBUG > 1;
 410
 411   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 412   '';
 413
 414 }
 415
 416 sub start_copy_skel {
 417   my $self = shift;
 418
 419   #'mg_user_preference' => {},
 420   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 421   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 422   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 423   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 424   my @tables = eval($conf->config_binary('cust_main-skeleton_tables'));
 425   die $@ if $@;
 426
 427   _copy_skel( 'cust_main',                                 #tablename
 428               $conf->config('cust_main-skeleton_custnum'), #sourceid
 429               $self->custnum,                              #destid
 430               @tables,                                     #child tables
 431             );
 432 }
 433
 434 #recursive subroutine, not a method
 435 sub _copy_skel {
 436   my( $table, $sourceid, $destid, %child_tables ) = @_;
 437
 438   my $primary_key;
 439   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 440     ( $table, $primary_key ) = ( $1, $2 );
 441   } else {
 442     my $dbdef_table = dbdef->table($table);
 443     $primary_key = $dbdef_table->primary_key
 444       or return "$table has no primary key".
 445                 " (or do you need to run dbdef-create?)";
 446   }
 447
 448   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 449        join (', ', keys %child_tables). "\n"
 450     if $DEBUG > 2;
 451
 452   foreach my $child_table_def ( keys %child_tables ) {
 453
 454     my $child_table;
 455     my $child_pkey = '';
 456     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 457       ( $child_table, $child_pkey ) = ( $1, $2 );
 458     } else {
 459       $child_table = $child_table_def;
 460
 461       $child_pkey = dbdef->table($child_table)->primary_key;
 462       #  or return "$table has no primary key".
 463       #            " (or do you need to run dbdef-create?)\n";
 464     }
 465
 466     my $sequence = '';
 467     if ( keys %{ $child_tables{$child_table_def} } ) {
 468
 469       return "$child_table has no primary key".
 470              " (run dbdef-create or try specifying it?)\n"
 471         unless $child_pkey;
 472
 473       #false laziness w/Record::insert and only works on Pg
 474       #refactor the proper last-inserted-id stuff out of Record::insert if this
 475       # ever gets use for anything besides a quick kludge for one customer
 476       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 477       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 478         or return "can't parse $child_table.$child_pkey default value ".
 479                   " for sequence name: $default";
 480       $sequence = $1;
 481
 482     }
 483
 484     my @sel_columns = grep { $_ ne $primary_key }
 485                            dbdef->table($child_table)->columns;
 486     my $sel_columns = join(', ', @sel_columns );
 487
 488     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 489     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 490     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 491
 492     my $sel_st = "SELECT $sel_columns FROM $child_table".
 493                  " WHERE $primary_key = $sourceid";
 494     warn "    $sel_st\n"
 495       if $DEBUG > 2;
 496     my $sel_sth = dbh->prepare( $sel_st )
 497       or return dbh->errstr;
 498
 499     $sel_sth->execute or return $sel_sth->errstr;
 500
 501     while ( my $row = $sel_sth->fetchrow_hashref ) {
 502
 503       warn "    selected row: ".
 504            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 505         if $DEBUG > 2;
 506
 507       my $statement =
 508         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 509       my $ins_sth =dbh->prepare($statement)
 510           or return dbh->errstr;
 511       my @param = ( $destid, map $row->{$_}, @ins_columns );
 512       warn "    $statement: [ ". join(', ', @param). " ]\n"
 513         if $DEBUG > 2;
 514       $ins_sth->execute( @param )
 515         or return $ins_sth->errstr;
 516
 517       #next unless keys %{ $child_tables{$child_table} };
 518       next unless $sequence;
 519
 520       #another section of that laziness
 521       my $seq_sql = "SELECT currval('$sequence')";
 522       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 523       $seq_sth->execute or return $seq_sth->errstr;
 524       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 525
 526       # don't drink soap!  recurse!  recurse!  okay!
 527       my $error =
 528         _copy_skel( $child_table_def,
 529                     $row->{$child_pkey}, #sourceid
 530                     $insertid, #destid
 531                     %{ $child_tables{$child_table_def} },
 532                   );
 533       return $error if $error;
 534
 535     }
 536
 537   }
 538
 539   return '';
 540
 541 }
 542
 543 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 544
 545 Like the insert method on an existing record, this method orders a package
 546 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 547 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 548 be a better explanation of this, but until then, here's an example:
 549
 550   use Tie::RefHash;
 551   tie %hash, 'Tie::RefHash'; #this part is important
 552   %hash = (
 553     $cust_pkg => [ $svc_acct ],
 554     ...
 555   );
 556   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 557
 558 Services can be new, in which case they are inserted, or existing unaudited
 559 services, in which case they are linked to the newly-created package.
 560
 561 Currently available options are: I<depend_jobnum> and I<noexport>.
 562
 563 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 564 on the supplied jobnum (they will not run until the specific job completes).
 565 This can be used to defer provisioning until some action completes (such
 566 as running the customer's credit card successfully).
 567
 568 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 569 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 570 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 571 on the cust_main object is not recommended, as existing services will also be
 572 reexported.)
 573
 574 =cut
 575
 576 sub order_pkgs {
 577   my $self = shift;
 578   my $cust_pkgs = shift;
 579   my $seconds = shift;
 580   my %options = @_;
 581   my %svc_options = ();
 582   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 583     if exists $options{'depend_jobnum'};
 584   warn "$me order_pkgs called with options ".
 585        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 586     if $DEBUG;
 587
 588   local $SIG{HUP} = 'IGNORE';
 589   local $SIG{INT} = 'IGNORE';
 590   local $SIG{QUIT} = 'IGNORE';
 591   local $SIG{TERM} = 'IGNORE';
 592   local $SIG{TSTP} = 'IGNORE';
 593   local $SIG{PIPE} = 'IGNORE';
 594
 595   my $oldAutoCommit = $FS::UID::AutoCommit;
 596   local $FS::UID::AutoCommit = 0;
 597   my $dbh = dbh;
 598
 599   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 600
 601   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 602     $cust_pkg->custnum( $self->custnum );
 603     my $error = $cust_pkg->insert;
 604     if ( $error ) {
 605       $dbh->rollback if $oldAutoCommit;
 606       return "inserting cust_pkg (transaction rolled back): $error";
 607     }
 608     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 609       if ( $svc_something->svcnum ) {
 610         my $old_cust_svc = $svc_something->cust_svc;
 611         my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 612         $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 613         $error = $new_cust_svc->replace($old_cust_svc);
 614       } else {
 615         $svc_something->pkgnum( $cust_pkg->pkgnum );
 616         if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 617           $svc_something->seconds( $svc_something->seconds + $$seconds );
 618           $$seconds = 0;
 619         }
 620         $error = $svc_something->insert(%svc_options);
 621       }
 622       if ( $error ) {
 623         $dbh->rollback if $oldAutoCommit;
 624         #return "inserting svc_ (transaction rolled back): $error";
 625         return $error;
 626       }
 627     }
 628   }
 629
 630   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 631   ''; #no error
 632 }
 633
 634 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 635
 636 Recharges this (existing) customer with the specified prepaid card (see
 637 L<FS::prepay_credit>), specified either by I<identifier> or as an
 638 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 639 returns false.
 640
 641 Optionally, four scalar references can be passed as well.  They will have their
 642 values filled in with the amount, number of seconds, and number of upload and
 643 download bytes applied by this prepaid
 644 card.
 645
 646 =cut
 647
 648 sub recharge_prepay {
 649   my( $self, $prepay_credit, $amountref, $secondsref,
 650       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 651
 652   local $SIG{HUP} = 'IGNORE';
 653   local $SIG{INT} = 'IGNORE';
 654   local $SIG{QUIT} = 'IGNORE';
 655   local $SIG{TERM} = 'IGNORE';
 656   local $SIG{TSTP} = 'IGNORE';
 657   local $SIG{PIPE} = 'IGNORE';
 658
 659   my $oldAutoCommit = $FS::UID::AutoCommit;
 660   local $FS::UID::AutoCommit = 0;
 661   my $dbh = dbh;
 662
 663   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 664
 665   my $error = $self->get_prepay($prepay_credit, \$amount,
 666                                 \$seconds, \$upbytes, \$downbytes, \$totalbytes)
 667            || $self->increment_seconds($seconds)
 668            || $self->increment_upbytes($upbytes)
 669            || $self->increment_downbytes($downbytes)
 670            || $self->increment_totalbytes($totalbytes)
 671            || $self->insert_cust_pay_prepay( $amount,
 672                                              ref($prepay_credit)
 673                                                ? $prepay_credit->identifier
 674                                                : $prepay_credit
 675                                            );
 676
 677   if ( $error ) {
 678     $dbh->rollback if $oldAutoCommit;
 679     return $error;
 680   }
 681
 682   if ( defined($amountref)  ) { $$amountref  = $amount;  }
 683   if ( defined($secondsref) ) { $$secondsref = $seconds; }
 684   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
 685   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
 686   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
 687
 688   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 689   '';
 690
 691 }
 692
 693 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF
 694
 695 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
 696 specified either by I<identifier> or as an FS::prepay_credit object.
 697
 698 References to I<amount> and I<seconds> scalars should be passed as arguments
 699 and will be incremented by the values of the prepaid card.
 700
 701 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
 702 check or set this customer's I<agentnum>.
 703
 704 If there is an error, returns the error, otherwise returns false.
 705
 706 =cut
 707
 708
 709 sub get_prepay {
 710   my( $self, $prepay_credit, $amountref, $secondsref,
 711       $upref, $downref, $totalref) = @_;
 712
 713   local $SIG{HUP} = 'IGNORE';
 714   local $SIG{INT} = 'IGNORE';
 715   local $SIG{QUIT} = 'IGNORE';
 716   local $SIG{TERM} = 'IGNORE';
 717   local $SIG{TSTP} = 'IGNORE';
 718   local $SIG{PIPE} = 'IGNORE';
 719
 720   my $oldAutoCommit = $FS::UID::AutoCommit;
 721   local $FS::UID::AutoCommit = 0;
 722   my $dbh = dbh;
 723
 724   unless ( ref($prepay_credit) ) {
 725
 726     my $identifier = $prepay_credit;
 727
 728     $prepay_credit = qsearchs(
 729       'prepay_credit',
 730       { 'identifier' => $prepay_credit },
 731       '',
 732       'FOR UPDATE'
 733     );
 734
 735     unless ( $prepay_credit ) {
 736       $dbh->rollback if $oldAutoCommit;
 737       return "Invalid prepaid card: ". $identifier;
 738     }
 739
 740   }
 741
 742   if ( $prepay_credit->agentnum ) {
 743     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 744       $dbh->rollback if $oldAutoCommit;
 745       return "prepaid card not valid for agent ". $self->agentnum;
 746     }
 747     $self->agentnum($prepay_credit->agentnum);
 748   }
 749
 750   my $error = $prepay_credit->delete;
 751   if ( $error ) {
 752     $dbh->rollback if $oldAutoCommit;
 753     return "removing prepay_credit (transaction rolled back): $error";
 754   }
 755
 756   $$amountref  += $prepay_credit->amount;
 757   $$secondsref += $prepay_credit->seconds;
 758   $$upref      += $prepay_credit->upbytes;
 759   $$downref    += $prepay_credit->downbytes;
 760   $$totalref   += $prepay_credit->totalbytes;
 761
 762   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 763   '';
 764
 765 }
 766
 767 =item increment_upbytes SECONDS
 768
 769 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 770 the specified number of upbytes.  If there is an error, returns the error,
 771 otherwise returns false.
 772
 773 =cut
 774
 775 sub increment_upbytes {
 776   _increment_column( shift, 'upbytes', @_);
 777 }
 778
 779 =item increment_downbytes SECONDS
 780
 781 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 782 the specified number of downbytes.  If there is an error, returns the error,
 783 otherwise returns false.
 784
 785 =cut
 786
 787 sub increment_downbytes {
 788   _increment_column( shift, 'downbytes', @_);
 789 }
 790
 791 =item increment_totalbytes SECONDS
 792
 793 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 794 the specified number of totalbytes.  If there is an error, returns the error,
 795 otherwise returns false.
 796
 797 =cut
 798
 799 sub increment_totalbytes {
 800   _increment_column( shift, 'totalbytes', @_);
 801 }
 802
 803 =item increment_seconds SECONDS
 804
 805 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 806 the specified number of seconds.  If there is an error, returns the error,
 807 otherwise returns false.
 808
 809 =cut
 810
 811 sub increment_seconds {
 812   _increment_column( shift, 'seconds', @_);
 813 }
 814
 815 =item _increment_column AMOUNT
 816
 817 Updates this customer's single or primary account (see L<FS::svc_acct>) by
 818 the specified number of seconds or bytes.  If there is an error, returns
 819 the error, otherwise returns false.
 820
 821 =cut
 822
 823 sub _increment_column {
 824   my( $self, $column, $amount ) = @_;
 825   warn "$me increment_column called: $column, $amount\n"
 826     if $DEBUG;
 827
 828   return '' unless $amount;
 829
 830   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
 831                       $self->ncancelled_pkgs;
 832
 833   if ( ! @cust_pkg ) {
 834     return 'No packages with primary or single services found'.
 835            ' to apply pre-paid time';
 836   } elsif ( scalar(@cust_pkg) > 1 ) {
 837     #maybe have a way to specify the package/account?
 838     return 'Multiple packages found to apply pre-paid time';
 839   }
 840
 841   my $cust_pkg = $cust_pkg[0];
 842   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
 843     if $DEBUG > 1;
 844
 845   my @cust_svc =
 846     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
 847
 848   if ( ! @cust_svc ) {
 849     return 'No account found to apply pre-paid time';
 850   } elsif ( scalar(@cust_svc) > 1 ) {
 851     return 'Multiple accounts found to apply pre-paid time';
 852   }
 853
 854   my $svc_acct = $cust_svc[0]->svc_x;
 855   warn "  found service svcnum ". $svc_acct->pkgnum.
 856        ' ('. $svc_acct->email. ")\n"
 857     if $DEBUG > 1;
 858
 859   $column = "increment_$column";
 860   $svc_acct->$column($amount);
 861
 862 }
 863
 864 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
 865
 866 Inserts a prepayment in the specified amount for this customer.  An optional
 867 second argument can specify the prepayment identifier for tracking purposes.
 868 If there is an error, returns the error, otherwise returns false.
 869
 870 =cut
 871
 872 sub insert_cust_pay_prepay {
 873   shift->insert_cust_pay('PREP', @_);
 874 }
 875
 876 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
 877
 878 Inserts a cash payment in the specified amount for this customer.  An optional
 879 second argument can specify the payment identifier for tracking purposes.
 880 If there is an error, returns the error, otherwise returns false.
 881
 882 =cut
 883
 884 sub insert_cust_pay_cash {
 885   shift->insert_cust_pay('CASH', @_);
 886 }
 887
 888 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
 889
 890 Inserts a Western Union payment in the specified amount for this customer.  An
 891 optional second argument can specify the prepayment identifier for tracking
 892 purposes.  If there is an error, returns the error, otherwise returns false.
 893
 894 =cut
 895
 896 sub insert_cust_pay_west {
 897   shift->insert_cust_pay('WEST', @_);
 898 }
 899
 900 sub insert_cust_pay {
 901   my( $self, $payby, $amount ) = splice(@_, 0, 3);
 902   my $payinfo = scalar(@_) ? shift : '';
 903
 904   my $cust_pay = new FS::cust_pay {
 905     'custnum' => $self->custnum,
 906     'paid'    => sprintf('%.2f', $amount),
 907     #'_date'   => #date the prepaid card was purchased???
 908     'payby'   => $payby,
 909     'payinfo' => $payinfo,
 910   };
 911   $cust_pay->insert;
 912
 913 }
 914
 915 =item reexport
 916
 917 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 918 order_pkgs methods for a better way to defer provisioning.
 919
 920 Re-schedules all exports by calling the B<reexport> method of all associated
 921 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 922 otherwise returns false.
 923
 924 =cut
 925
 926 sub reexport {
 927   my $self = shift;
 928
 929   carp "WARNING: FS::cust_main::reexport is deprectated; ".
 930        "use the depend_jobnum option to insert or order_pkgs to delay export";
 931
 932   local $SIG{HUP} = 'IGNORE';
 933   local $SIG{INT} = 'IGNORE';
 934   local $SIG{QUIT} = 'IGNORE';
 935   local $SIG{TERM} = 'IGNORE';
 936   local $SIG{TSTP} = 'IGNORE';
 937   local $SIG{PIPE} = 'IGNORE';
 938
 939   my $oldAutoCommit = $FS::UID::AutoCommit;
 940   local $FS::UID::AutoCommit = 0;
 941   my $dbh = dbh;
 942
 943   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 944     my $error = $cust_pkg->reexport;
 945     if ( $error ) {
 946       $dbh->rollback if $oldAutoCommit;
 947       return $error;
 948     }
 949   }
 950
 951   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 952   '';
 953
 954 }
 955
 956 =item delete NEW_CUSTNUM
 957
 958 This deletes the customer.  If there is an error, returns the error, otherwise
 959 returns false.
 960
 961 This will completely remove all traces of the customer record.  This is not
 962 what you want when a customer cancels service; for that, cancel all of the
 963 customer's packages (see L</cancel>).
 964
 965 If the customer has any uncancelled packages, you need to pass a new (valid)
 966 customer number for those packages to be transferred to.  Cancelled packages
 967 will be deleted.  Did I mention that this is NOT what you want when a customer
 968 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 969
 970 You can't delete a customer with invoices (see L<FS::cust_bill>),
 971 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 972 refunds (see L<FS::cust_refund>).
 973
 974 =cut
 975
 976 sub delete {
 977   my $self = shift;
 978
 979   local $SIG{HUP} = 'IGNORE';
 980   local $SIG{INT} = 'IGNORE';
 981   local $SIG{QUIT} = 'IGNORE';
 982   local $SIG{TERM} = 'IGNORE';
 983   local $SIG{TSTP} = 'IGNORE';
 984   local $SIG{PIPE} = 'IGNORE';
 985
 986   my $oldAutoCommit = $FS::UID::AutoCommit;
 987   local $FS::UID::AutoCommit = 0;
 988   my $dbh = dbh;
 989
 990   if ( $self->cust_bill ) {
 991     $dbh->rollback if $oldAutoCommit;
 992     return "Can't delete a customer with invoices";
 993   }
 994   if ( $self->cust_credit ) {
 995     $dbh->rollback if $oldAutoCommit;
 996     return "Can't delete a customer with credits";
 997   }
 998   if ( $self->cust_pay ) {
 999     $dbh->rollback if $oldAutoCommit;
1000     return "Can't delete a customer with payments";
1001   }
1002   if ( $self->cust_refund ) {
1003     $dbh->rollback if $oldAutoCommit;
1004     return "Can't delete a customer with refunds";
1005   }
1006
1007   my @cust_pkg = $self->ncancelled_pkgs;
1008   if ( @cust_pkg ) {
1009     my $new_custnum = shift;
1010     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1011       $dbh->rollback if $oldAutoCommit;
1012       return "Invalid new customer number: $new_custnum";
1013     }
1014     foreach my $cust_pkg ( @cust_pkg ) {
1015       my %hash = $cust_pkg->hash;
1016       $hash{'custnum'} = $new_custnum;
1017       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1018       my $error = $new_cust_pkg->replace($cust_pkg,
1019                                          options => { $cust_pkg->options },
1020                                         );
1021       if ( $error ) {
1022         $dbh->rollback if $oldAutoCommit;
1023         return $error;
1024       }
1025     }
1026   }
1027   my @cancelled_cust_pkg = $self->all_pkgs;
1028   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1029     my $error = $cust_pkg->delete;
1030     if ( $error ) {
1031       $dbh->rollback if $oldAutoCommit;
1032       return $error;
1033     }
1034   }
1035
1036   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
1037     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
1038   ) {
1039     my $error = $cust_main_invoice->delete;
1040     if ( $error ) {
1041       $dbh->rollback if $oldAutoCommit;
1042       return $error;
1043     }
1044   }
1045
1046   my $error = $self->SUPER::delete;
1047   if ( $error ) {
1048     $dbh->rollback if $oldAutoCommit;
1049     return $error;
1050   }
1051
1052   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1053   '';
1054
1055 }
1056
1057 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
1058
1059 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1060 returns the error, otherwise returns false.
1061
1062 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1063 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1064 expected and rollback the entire transaction; it is not necessary to call
1065 check_invoicing_list first.  Here's an example:
1066
1067   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1068
1069 =cut
1070
1071 sub replace {
1072   my $self = shift;
1073   my $old = shift;
1074   my @param = @_;
1075   warn "$me replace called\n"
1076     if $DEBUG;
1077
1078   local $SIG{HUP} = 'IGNORE';
1079   local $SIG{INT} = 'IGNORE';
1080   local $SIG{QUIT} = 'IGNORE';
1081   local $SIG{TERM} = 'IGNORE';
1082   local $SIG{TSTP} = 'IGNORE';
1083   local $SIG{PIPE} = 'IGNORE';
1084
1085   # We absolutely have to have an old vs. new record to make this work.
1086   if (!defined($old)) {
1087     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1088   }
1089
1090   my $curuser = $FS::CurrentUser::CurrentUser;
1091   if (    $self->payby eq 'COMP'
1092        && $self->payby ne $old->payby
1093        && ! $curuser->access_right('Complimentary customer')
1094      )
1095   {
1096     return "You are not permitted to create complimentary accounts.";
1097   }
1098
1099   local($ignore_expired_card) = 1
1100     if $old->payby  =~ /^(CARD|DCRD)$/
1101     && $self->payby =~ /^(CARD|DCRD)$/
1102     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1103
1104   my $oldAutoCommit = $FS::UID::AutoCommit;
1105   local $FS::UID::AutoCommit = 0;
1106   my $dbh = dbh;
1107
1108   my $error = $self->SUPER::replace($old);
1109
1110   if ( $error ) {
1111     $dbh->rollback if $oldAutoCommit;
1112     return $error;
1113   }
1114
1115   if ( @param ) { # INVOICING_LIST_ARYREF
1116     my $invoicing_list = shift @param;
1117     $error = $self->check_invoicing_list( $invoicing_list );
1118     if ( $error ) {
1119       $dbh->rollback if $oldAutoCommit;
1120       return $error;
1121     }
1122     $self->invoicing_list( $invoicing_list );
1123   }
1124
1125   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
1126        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
1127     # card/check/lec info has changed, want to retry realtime_ invoice events
1128     my $error = $self->retry_realtime;
1129     if ( $error ) {
1130       $dbh->rollback if $oldAutoCommit;
1131       return $error;
1132     }
1133   }
1134
1135   unless ( $import || $skip_fuzzyfiles ) {
1136     $error = $self->queue_fuzzyfiles_update;
1137     if ( $error ) {
1138       $dbh->rollback if $oldAutoCommit;
1139       return "updating fuzzy search cache: $error";
1140     }
1141   }
1142
1143   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1144   '';
1145
1146 }
1147
1148 =item queue_fuzzyfiles_update
1149
1150 Used by insert & replace to update the fuzzy search cache
1151
1152 =cut
1153
1154 sub queue_fuzzyfiles_update {
1155   my $self = shift;
1156
1157   local $SIG{HUP} = 'IGNORE';
1158   local $SIG{INT} = 'IGNORE';
1159   local $SIG{QUIT} = 'IGNORE';
1160   local $SIG{TERM} = 'IGNORE';
1161   local $SIG{TSTP} = 'IGNORE';
1162   local $SIG{PIPE} = 'IGNORE';
1163
1164   my $oldAutoCommit = $FS::UID::AutoCommit;
1165   local $FS::UID::AutoCommit = 0;
1166   my $dbh = dbh;
1167
1168   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1169   my $error = $queue->insert( map $self->getfield($_),
1170                                   qw(first last company)
1171                             );
1172   if ( $error ) {
1173     $dbh->rollback if $oldAutoCommit;
1174     return "queueing job (transaction rolled back): $error";
1175   }
1176
1177   if ( $self->ship_last ) {
1178     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1179     $error = $queue->insert( map $self->getfield("ship_$_"),
1180                                  qw(first last company)
1181                            );
1182     if ( $error ) {
1183       $dbh->rollback if $oldAutoCommit;
1184       return "queueing job (transaction rolled back): $error";
1185     }
1186   }
1187
1188   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1189   '';
1190
1191 }
1192
1193 =item check
1194
1195 Checks all fields to make sure this is a valid customer record.  If there is
1196 an error, returns the error, otherwise returns false.  Called by the insert
1197 and replace methods.
1198
1199 =cut
1200
1201 sub check {
1202   my $self = shift;
1203
1204   warn "$me check BEFORE: \n". $self->_dump
1205     if $DEBUG > 2;
1206
1207   my $error =
1208     $self->ut_numbern('custnum')
1209     || $self->ut_number('agentnum')
1210     || $self->ut_textn('agent_custid')
1211     || $self->ut_number('refnum')
1212     || $self->ut_name('last')
1213     || $self->ut_name('first')
1214     || $self->ut_snumbern('birthdate')
1215     || $self->ut_snumbern('signupdate')
1216     || $self->ut_textn('company')
1217     || $self->ut_text('address1')
1218     || $self->ut_textn('address2')
1219     || $self->ut_text('city')
1220     || $self->ut_textn('county')
1221     || $self->ut_textn('state')
1222     || $self->ut_country('country')
1223     || $self->ut_anything('comments')
1224     || $self->ut_numbern('referral_custnum')
1225     || $self->ut_textn('stateid')
1226     || $self->ut_textn('stateid_state')
1227   ;
1228   #barf.  need message catalogs.  i18n.  etc.
1229   $error .= "Please select an advertising source."
1230     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1231   return $error if $error;
1232
1233   return "Unknown agent"
1234     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1235
1236   return "Unknown refnum"
1237     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1238
1239   return "Unknown referring custnum: ". $self->referral_custnum
1240     unless ! $self->referral_custnum
1241            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1242
1243   if ( $self->ss eq '' ) {
1244     $self->ss('');
1245   } else {
1246     my $ss = $self->ss;
1247     $ss =~ s/\D//g;
1248     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1249       or return "Illegal social security number: ". $self->ss;
1250     $self->ss("$1-$2-$3");
1251   }
1252
1253
1254 # bad idea to disable, causes billing to fail because of no tax rates later
1255 #  unless ( $import ) {
1256     unless ( qsearch('cust_main_county', {
1257       'country' => $self->country,
1258       'state'   => '',
1259      } ) ) {
1260       return "Unknown state/county/country: ".
1261         $self->state. "/". $self->county. "/". $self->country
1262         unless qsearch('cust_main_county',{
1263           'state'   => $self->state,
1264           'county'  => $self->county,
1265           'country' => $self->country,
1266         } );
1267     }
1268 #  }
1269
1270   $error =
1271     $self->ut_phonen('daytime', $self->country)
1272     || $self->ut_phonen('night', $self->country)
1273     || $self->ut_phonen('fax', $self->country)
1274     || $self->ut_zip('zip', $self->country)
1275   ;
1276   return $error if $error;
1277
1278   if ( $conf->exists('cust_main-require_phone')
1279        && ! length($self->daytime) && ! length($self->night)
1280      ) {
1281
1282     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1283                           ? 'Day Phone'
1284                           : FS::Msgcat::_gettext('daytime');
1285     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1286                         ? 'Night Phone'
1287                         : FS::Msgcat::_gettext('night');
1288
1289     return "$daytime_label or $night_label is required"
1290
1291   }
1292
1293   if ( $self->has_ship_address
1294        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1295                         $self->addr_fields )
1296      )
1297   {
1298     my $error =
1299       $self->ut_name('ship_last')
1300       || $self->ut_name('ship_first')
1301       || $self->ut_textn('ship_company')
1302       || $self->ut_text('ship_address1')
1303       || $self->ut_textn('ship_address2')
1304       || $self->ut_text('ship_city')
1305       || $self->ut_textn('ship_county')
1306       || $self->ut_textn('ship_state')
1307       || $self->ut_country('ship_country')
1308     ;
1309     return $error if $error;
1310
1311     #false laziness with above
1312     unless ( qsearchs('cust_main_county', {
1313       'country' => $self->ship_country,
1314       'state'   => '',
1315      } ) ) {
1316       return "Unknown ship_state/ship_county/ship_country: ".
1317         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1318         unless qsearch('cust_main_county',{
1319           'state'   => $self->ship_state,
1320           'county'  => $self->ship_county,
1321           'country' => $self->ship_country,
1322         } );
1323     }
1324     #eofalse
1325
1326     $error =
1327       $self->ut_phonen('ship_daytime', $self->ship_country)
1328       || $self->ut_phonen('ship_night', $self->ship_country)
1329       || $self->ut_phonen('ship_fax', $self->ship_country)
1330       || $self->ut_zip('ship_zip', $self->ship_country)
1331     ;
1332     return $error if $error;
1333
1334     return "Unit # is required."
1335       if $self->ship_address2 =~ /^\s*$/
1336       && $conf->exists('cust_main-require_address2');
1337
1338   } else { # ship_ info eq billing info, so don't store dup info in database
1339
1340     $self->setfield("ship_$_", '')
1341       foreach $self->addr_fields;
1342
1343     return "Unit # is required."
1344       if $self->address2 =~ /^\s*$/
1345       && $conf->exists('cust_main-require_address2');
1346
1347   }
1348
1349   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1350   #  or return "Illegal payby: ". $self->payby;
1351   #$self->payby($1);
1352   FS::payby->can_payby($self->table, $self->payby)
1353     or return "Illegal payby: ". $self->payby;
1354
1355   $error =    $self->ut_numbern('paystart_month')
1356            || $self->ut_numbern('paystart_year')
1357            || $self->ut_numbern('payissue')
1358            || $self->ut_textn('paytype')
1359   ;
1360   return $error if $error;
1361
1362   if ( $self->payip eq '' ) {
1363     $self->payip('');
1364   } else {
1365     $error = $self->ut_ip('payip');
1366     return $error if $error;
1367   }
1368
1369   # If it is encrypted and the private key is not availaible then we can't
1370   # check the credit card.
1371
1372   my $check_payinfo = 1;
1373
1374   if ($self->is_encrypted($self->payinfo)) {
1375     $check_payinfo = 0;
1376   }
1377
1378   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1379
1380     my $payinfo = $self->payinfo;
1381     $payinfo =~ s/\D//g;
1382     $payinfo =~ /^(\d{13,16})$/
1383       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1384     $payinfo = $1;
1385     $self->payinfo($payinfo);
1386     validate($payinfo)
1387       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1388
1389     return gettext('unknown_card_type')
1390       if cardtype($self->payinfo) eq "Unknown";
1391
1392     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1393     if ( $ban ) {
1394       return 'Banned credit card: banned on '.
1395              time2str('%a %h %o at %r', $ban->_date).
1396              ' by '. $ban->otaker.
1397              ' (ban# '. $ban->bannum. ')';
1398     }
1399
1400     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1401       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1402         $self->paycvv =~ /^(\d{4})$/
1403           or return "CVV2 (CID) for American Express cards is four digits.";
1404         $self->paycvv($1);
1405       } else {
1406         $self->paycvv =~ /^(\d{3})$/
1407           or return "CVV2 (CVC2/CID) is three digits.";
1408         $self->paycvv($1);
1409       }
1410     } else {
1411       $self->paycvv('');
1412     }
1413
1414     my $cardtype = cardtype($payinfo);
1415     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1416
1417       return "Start date or issue number is required for $cardtype cards"
1418         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1419
1420       return "Start month must be between 1 and 12"
1421         if $self->paystart_month
1422            and $self->paystart_month < 1 || $self->paystart_month > 12;
1423
1424       return "Start year must be 1990 or later"
1425         if $self->paystart_year
1426            and $self->paystart_year < 1990;
1427
1428       return "Issue number must be beween 1 and 99"
1429         if $self->payissue
1430           and $self->payissue < 1 || $self->payissue > 99;
1431
1432     } else {
1433       $self->paystart_month('');
1434       $self->paystart_year('');
1435       $self->payissue('');
1436     }
1437
1438   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1439
1440     my $payinfo = $self->payinfo;
1441     $payinfo =~ s/[^\d\@]//g;
1442     if ( $conf->exists('echeck-nonus') ) {
1443       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1444       $payinfo = "$1\@$2";
1445     } else {
1446       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1447       $payinfo = "$1\@$2";
1448     }
1449     $self->payinfo($payinfo);
1450     $self->paycvv('');
1451
1452     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1453     if ( $ban ) {
1454       return 'Banned ACH account: banned on '.
1455              time2str('%a %h %o at %r', $ban->_date).
1456              ' by '. $ban->otaker.
1457              ' (ban# '. $ban->bannum. ')';
1458     }
1459
1460   } elsif ( $self->payby eq 'LECB' ) {
1461
1462     my $payinfo = $self->payinfo;
1463     $payinfo =~ s/\D//g;
1464     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1465     $payinfo = $1;
1466     $self->payinfo($payinfo);
1467     $self->paycvv('');
1468
1469   } elsif ( $self->payby eq 'BILL' ) {
1470
1471     $error = $self->ut_textn('payinfo');
1472     return "Illegal P.O. number: ". $self->payinfo if $error;
1473     $self->paycvv('');
1474
1475   } elsif ( $self->payby eq 'COMP' ) {
1476
1477     my $curuser = $FS::CurrentUser::CurrentUser;
1478     if (    ! $self->custnum
1479          && ! $curuser->access_right('Complimentary customer')
1480        )
1481     {
1482       return "You are not permitted to create complimentary accounts."
1483     }
1484
1485     $error = $self->ut_textn('payinfo');
1486     return "Illegal comp account issuer: ". $self->payinfo if $error;
1487     $self->paycvv('');
1488
1489   } elsif ( $self->payby eq 'PREPAY' ) {
1490
1491     my $payinfo = $self->payinfo;
1492     $payinfo =~ s/\W//g; #anything else would just confuse things
1493     $self->payinfo($payinfo);
1494     $error = $self->ut_alpha('payinfo');
1495     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1496     return "Unknown prepayment identifier"
1497       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1498     $self->paycvv('');
1499
1500   }
1501
1502   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1503     return "Expiration date required"
1504       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1505     $self->paydate('');
1506   } else {
1507     my( $m, $y );
1508     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1509       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1510     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1511       ( $m, $y ) = ( $3, "20$2" );
1512     } else {
1513       return "Illegal expiration date: ". $self->paydate;
1514     }
1515     $self->paydate("$y-$m-01");
1516     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1517     return gettext('expired_card')
1518       if !$import
1519       && !$ignore_expired_card
1520       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1521   }
1522
1523   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1524        ( ! $conf->exists('require_cardname')
1525          || $self->payby !~ /^(CARD|DCRD)$/  )
1526   ) {
1527     $self->payname( $self->first. " ". $self->getfield('last') );
1528   } else {
1529     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1530       or return gettext('illegal_name'). " payname: ". $self->payname;
1531     $self->payname($1);
1532   }
1533
1534   foreach my $flag (qw( tax spool_cdr )) {
1535     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1536     $self->$flag($1);
1537   }
1538
1539   $self->otaker(getotaker) unless $self->otaker;
1540
1541   warn "$me check AFTER: \n". $self->_dump
1542     if $DEBUG > 2;
1543
1544   $self->SUPER::check;
1545 }
1546
1547 =item addr_fields
1548
1549 Returns a list of fields which have ship_ duplicates.
1550
1551 =cut
1552
1553 sub addr_fields {
1554   qw( last first company
1555       address1 address2 city county state zip country
1556       daytime night fax
1557     );
1558 }
1559
1560 =item has_ship_address
1561
1562 Returns true if this customer record has a separate shipping address.
1563
1564 =cut
1565
1566 sub has_ship_address {
1567   my $self = shift;
1568   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1569 }
1570
1571 =item all_pkgs
1572
1573 Returns all packages (see L<FS::cust_pkg>) for this customer.
1574
1575 =cut
1576
1577 sub all_pkgs {
1578   my $self = shift;
1579
1580   return $self->num_pkgs unless wantarray;
1581
1582   my @cust_pkg = ();
1583   if ( $self->{'_pkgnum'} ) {
1584     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
1585   } else {
1586     @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1587   }
1588
1589   sort sort_packages @cust_pkg;
1590 }
1591
1592 =item ncancelled_pkgs
1593
1594 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1595
1596 =cut
1597
1598 sub ncancelled_pkgs {
1599   my $self = shift;
1600
1601   return $self->num_ncancelled_pkgs unless wantarray;
1602
1603   my @cust_pkg = ();
1604   if ( $self->{'_pkgnum'} ) {
1605
1606     @cust_pkg = grep { ! $_->getfield('cancel') }
1607                 values %{ $self->{'_pkgnum'}->cache };
1608
1609   } else {
1610
1611     @cust_pkg =
1612       qsearch( 'cust_pkg', {
1613                              'custnum' => $self->custnum,
1614                              'cancel'  => '',
1615                            });
1616     push @cust_pkg,
1617       qsearch( 'cust_pkg', {
1618                              'custnum' => $self->custnum,
1619                              'cancel'  => 0,
1620                            });
1621   }
1622
1623   sort sort_packages @cust_pkg;
1624
1625 }
1626
1627 # This should be generalized to use config options to determine order.
1628 sub sort_packages {
1629   if ( $a->get('cancel') and $b->get('cancel') ) {
1630     $a->pkgnum <=> $b->pkgnum;
1631   } elsif ( $a->get('cancel') or $b->get('cancel') ) {
1632     return -1 if $b->get('cancel');
1633     return  1 if $a->get('cancel');
1634     return 0;
1635   } else {
1636     $a->pkgnum <=> $b->pkgnum;
1637   }
1638 }
1639
1640 =item suspended_pkgs
1641
1642 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1643
1644 =cut
1645
1646 sub suspended_pkgs {
1647   my $self = shift;
1648   grep { $_->susp } $self->ncancelled_pkgs;
1649 }
1650
1651 =item unflagged_suspended_pkgs
1652
1653 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1654 customer (thouse packages without the `manual_flag' set).
1655
1656 =cut
1657
1658 sub unflagged_suspended_pkgs {
1659   my $self = shift;
1660   return $self->suspended_pkgs
1661     unless dbdef->table('cust_pkg')->column('manual_flag');
1662   grep { ! $_->manual_flag } $self->suspended_pkgs;
1663 }
1664
1665 =item unsuspended_pkgs
1666
1667 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1668 this customer.
1669
1670 =cut
1671
1672 sub unsuspended_pkgs {
1673   my $self = shift;
1674   grep { ! $_->susp } $self->ncancelled_pkgs;
1675 }
1676
1677 =item num_cancelled_pkgs
1678
1679 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1680 customer.
1681
1682 =cut
1683
1684 sub num_cancelled_pkgs {
1685   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
1686 }
1687
1688 sub num_ncancelled_pkgs {
1689   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
1690 }
1691
1692 sub num_pkgs {
1693   my( $self ) = shift;
1694   my $sql = scalar(@_) ? shift : '';
1695   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
1696   my $sth = dbh->prepare(
1697     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
1698   ) or die dbh->errstr;
1699   $sth->execute($self->custnum) or die $sth->errstr;
1700   $sth->fetchrow_arrayref->[0];
1701 }
1702
1703 =item unsuspend
1704
1705 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1706 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1707 on success or a list of errors.
1708
1709 =cut
1710
1711 sub unsuspend {
1712   my $self = shift;
1713   grep { $_->unsuspend } $self->suspended_pkgs;
1714 }
1715
1716 =item suspend
1717
1718 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1719
1720 Returns a list: an empty list on success or a list of errors.
1721
1722 =cut
1723
1724 sub suspend {
1725   my $self = shift;
1726   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1727 }
1728
1729 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1730
1731 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1732 PKGPARTs (see L<FS::part_pkg>).
1733
1734 Returns a list: an empty list on success or a list of errors.
1735
1736 =cut
1737
1738 sub suspend_if_pkgpart {
1739   my $self = shift;
1740   my (@pkgparts, %opt);
1741   if (ref($_[0]) eq 'HASH'){
1742     @pkgparts = @{$_[0]{pkgparts}};
1743     %opt      = %{$_[0]};
1744   }else{
1745     @pkgparts = @_;
1746   }
1747   grep { $_->suspend(%opt) }
1748     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1749       $self->unsuspended_pkgs;
1750 }
1751
1752 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1753
1754 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1755 listed PKGPARTs (see L<FS::part_pkg>).
1756
1757 Returns a list: an empty list on success or a list of errors.
1758
1759 =cut
1760
1761 sub suspend_unless_pkgpart {
1762   my $self = shift;
1763   my (@pkgparts, %opt);
1764   if (ref($_[0]) eq 'HASH'){
1765     @pkgparts = @{$_[0]{pkgparts}};
1766     %opt      = %{$_[0]};
1767   }else{
1768     @pkgparts = @_;
1769   }
1770   grep { $_->suspend(%opt) }
1771     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1772       $self->unsuspended_pkgs;
1773 }
1774
1775 =item cancel [ OPTION => VALUE ... ]
1776
1777 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1778
1779 Available options are: I<quiet>, I<reasonnum>, and I<ban>
1780
1781 I<quiet> can be set true to supress email cancellation notices.
1782
1783 # I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>)
1784
1785 I<ban> can be set true to ban this customer's credit card or ACH information,
1786 if present.
1787
1788 Always returns a list: an empty list on success or a list of errors.
1789
1790 =cut
1791
1792 sub cancel {
1793   my $self = shift;
1794   my %opt = @_;
1795
1796   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1797
1798     #should try decryption (we might have the private key)
1799     # and if not maybe queue a job for the server that does?
1800     return ( "Can't (yet) ban encrypted credit cards" )
1801       if $self->is_encrypted($self->payinfo);
1802
1803     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1804     my $error = $ban->insert;
1805     return ( $error ) if $error;
1806
1807   }
1808
1809   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1810 }
1811
1812 sub _banned_pay_hashref {
1813   my $self = shift;
1814
1815   my %payby2ban = (
1816     'CARD' => 'CARD',
1817     'DCRD' => 'CARD',
1818     'CHEK' => 'CHEK',
1819     'DCHK' => 'CHEK'
1820   );
1821
1822   {
1823     'payby'   => $payby2ban{$self->payby},
1824     'payinfo' => md5_base64($self->payinfo),
1825     #don't ever *search* on reason! #'reason'  =>
1826   };
1827 }
1828
1829 =item notes
1830
1831 Returns all notes (see L<FS::cust_main_note>) for this customer.
1832
1833 =cut
1834
1835 sub notes {
1836   my $self = shift;
1837   #order by?
1838   qsearch( 'cust_main_note',
1839            { 'custnum' => $self->custnum },
1840            '',
1841            'ORDER BY _DATE DESC'
1842          );
1843 }
1844
1845 =item agent
1846
1847 Returns the agent (see L<FS::agent>) for this customer.
1848
1849 =cut
1850
1851 sub agent {
1852   my $self = shift;
1853   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1854 }
1855
1856 =item bill OPTIONS
1857
1858 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1859 conjunction with the collect method.
1860
1861 If there is an error, returns the error, otherwise returns false.
1862
1863 Options are passed as name-value pairs.  Currently available options are:
1864
1865 =over 4
1866
1867 =item resetup - if set true, re-charges setup fees.
1868
1869 =item time - 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:
1870
1871  use Date::Parse;
1872  ...
1873  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1874
1875 =item invoice_time - 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.
1876
1877 =back
1878
1879 =cut
1880
1881 sub bill {
1882   my( $self, %options ) = @_;
1883   return '' if $self->payby eq 'COMP';
1884   warn "$me bill customer ". $self->custnum. "\n"
1885     if $DEBUG;
1886
1887   my $time = $options{'time'} || time;
1888
1889   my $error;
1890
1891   #put below somehow?
1892   local $SIG{HUP} = 'IGNORE';
1893   local $SIG{INT} = 'IGNORE';
1894   local $SIG{QUIT} = 'IGNORE';
1895   local $SIG{TERM} = 'IGNORE';
1896   local $SIG{TSTP} = 'IGNORE';
1897   local $SIG{PIPE} = 'IGNORE';
1898
1899   my $oldAutoCommit = $FS::UID::AutoCommit;
1900   local $FS::UID::AutoCommit = 0;
1901   my $dbh = dbh;
1902
1903   $self->select_for_update; #mutex
1904
1905   #create a new invoice
1906   #(we'll remove it later if it doesn't actually need to be generated [contains
1907   # no line items] and we're inside a transaciton so nothing else will see it)
1908   my $cust_bill = new FS::cust_bill ( {
1909     'custnum' => $self->custnum,
1910     '_date'   => ( $options{'invoice_time'} || $time ),
1911     #'charged' => $charged,
1912     'charged' => 0,
1913   } );
1914   $error = $cust_bill->insert;
1915   if ( $error ) {
1916     $dbh->rollback if $oldAutoCommit;
1917     return "can't create invoice for customer #". $self->custnum. ": $error";
1918   }
1919   my $invnum = $cust_bill->invnum;
1920
1921   ###
1922   # find the packages which are due for billing, find out how much they are
1923   # & generate invoice database.
1924   ###
1925
1926   my( $total_setup, $total_recur ) = ( 0, 0 );
1927   my %tax;
1928   my @precommit_hooks = ();
1929
1930   foreach my $cust_pkg (
1931     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1932   ) {
1933
1934     #NO!! next if $cust_pkg->cancel;
1935     next if $cust_pkg->getfield('cancel');
1936
1937     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
1938
1939     #? to avoid use of uninitialized value errors... ?
1940     $cust_pkg->setfield('bill', '')
1941       unless defined($cust_pkg->bill);
1942
1943     my $part_pkg = $cust_pkg->part_pkg;
1944
1945     my %hash = $cust_pkg->hash;
1946     my $old_cust_pkg = new FS::cust_pkg \%hash;
1947
1948     my @details = ();
1949
1950     ###
1951     # bill setup
1952     ###
1953
1954     my $setup = 0;
1955     if ( ! $cust_pkg->setup &&
1956          (
1957            ( $conf->exists('disable_setup_suspended_pkgs') &&
1958             ! $cust_pkg->getfield('susp')
1959           ) || ! $conf->exists('disable_setup_suspended_pkgs')
1960          )
1961       || $options{'resetup'}
1962     ) {
1963
1964       warn "    bill setup\n" if $DEBUG > 1;
1965
1966       $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
1967       if ( $@ ) {
1968         $dbh->rollback if $oldAutoCommit;
1969         return "$@ running calc_setup for $cust_pkg\n";
1970       }
1971
1972       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1973     }
1974
1975     ###
1976     # bill recurring fee
1977     ###
1978
1979     my $recur = 0;
1980     my $sdate;
1981     if ( $part_pkg->getfield('freq') ne '0' &&
1982          ! $cust_pkg->getfield('susp') &&
1983          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1984     ) {
1985
1986       warn "    bill recur\n" if $DEBUG > 1;
1987
1988       # XXX shared with $recur_prog
1989       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1990
1991       #over two params!  lets at least switch to a hashref for the rest...
1992       my %param = ( 'precommit_hooks' => \@precommit_hooks, );
1993
1994       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
1995       if ( $@ ) {
1996         $dbh->rollback if $oldAutoCommit;
1997         return "$@ running calc_recur for $cust_pkg\n";
1998       }
1999
2000       #change this bit to use Date::Manip? CAREFUL with timezones (see
2001       # mailing list archive)
2002       my ($sec,$min,$hour,$mday,$mon,$year) =
2003         (localtime($sdate) )[0,1,2,3,4,5];
2004
2005       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2006       # only for figuring next bill date, nothing else, so, reset $sdate again
2007       # here
2008       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2009       $cust_pkg->last_bill($sdate)
2010         if $cust_pkg->dbdef_table->column('last_bill');
2011
2012       if ( $part_pkg->freq =~ /^\d+$/ ) {
2013         $mon += $part_pkg->freq;
2014         until ( $mon < 12 ) { $mon -= 12; $year++; }
2015       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2016         my $weeks = $1;
2017         $mday += $weeks * 7;
2018       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2019         my $days = $1;
2020         $mday += $days;
2021       } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2022         my $hours = $1;
2023         $hour += $hours;
2024       } else {
2025         $dbh->rollback if $oldAutoCommit;
2026         return "unparsable frequency: ". $part_pkg->freq;
2027       }
2028       $cust_pkg->setfield('bill',
2029         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2030     }
2031
2032     warn "\$setup is undefined" unless defined($setup);
2033     warn "\$recur is undefined" unless defined($recur);
2034     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2035
2036     ###
2037     # If $cust_pkg has been modified, update it and create cust_bill_pkg records
2038     ###
2039
2040     if ( $cust_pkg->modified ) {  # hmmm.. and if the options are modified?
2041
2042       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2043         if $DEBUG >1;
2044
2045       $error=$cust_pkg->replace($old_cust_pkg,
2046                                 options => { $cust_pkg->options },
2047                                );
2048       if ( $error ) { #just in case
2049         $dbh->rollback if $oldAutoCommit;
2050         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
2051       }
2052
2053       $setup = sprintf( "%.2f", $setup );
2054       $recur = sprintf( "%.2f", $recur );
2055       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2056         $dbh->rollback if $oldAutoCommit;
2057         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2058       }
2059       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2060         $dbh->rollback if $oldAutoCommit;
2061         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2062       }
2063
2064       if ( $setup != 0 || $recur != 0 ) {
2065
2066         warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2067           if $DEBUG > 1;
2068         my $cust_bill_pkg = new FS::cust_bill_pkg ({
2069           'invnum'  => $invnum,
2070           'pkgnum'  => $cust_pkg->pkgnum,
2071           'setup'   => $setup,
2072           'recur'   => $recur,
2073           'sdate'   => $sdate,
2074           'edate'   => $cust_pkg->bill,
2075           'details' => \@details,
2076         });
2077         $error = $cust_bill_pkg->insert;
2078         if ( $error ) {
2079           $dbh->rollback if $oldAutoCommit;
2080           return "can't create invoice line item for invoice #$invnum: $error";
2081         }
2082         $total_setup += $setup;
2083         $total_recur += $recur;
2084
2085         ###
2086         # handle taxes
2087         ###
2088
2089         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
2090
2091           my $prefix =
2092             ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2093             ? 'ship_'
2094             : '';
2095           my %taxhash = map { $_ => $self->get("$prefix$_") }
2096                             qw( state county country );
2097
2098           $taxhash{'taxclass'} = $part_pkg->taxclass;
2099
2100           my @taxes = qsearch( 'cust_main_county', \%taxhash );
2101
2102           unless ( @taxes ) {
2103             $taxhash{'taxclass'} = '';
2104             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2105           }
2106
2107           #one more try at a whole-country tax rate
2108           unless ( @taxes ) {
2109             $taxhash{$_} = '' foreach qw( state county );
2110             @taxes =  qsearch( 'cust_main_county', \%taxhash );
2111           }
2112
2113           # maybe eliminate this entirely, along with all the 0% records
2114           unless ( @taxes ) {
2115             $dbh->rollback if $oldAutoCommit;
2116             return
2117               "fatal: can't find tax rate for state/county/country/taxclass ".
2118               join('/', ( map $self->get("$prefix$_"),
2119                               qw(state county country)
2120                         ),
2121                         $part_pkg->taxclass ). "\n";
2122           }
2123
2124           foreach my $tax ( @taxes ) {
2125
2126             my $taxable_charged = 0;
2127             $taxable_charged += $setup
2128               unless $part_pkg->setuptax =~ /^Y$/i
2129                   || $tax->setuptax =~ /^Y$/i;
2130             $taxable_charged += $recur
2131               unless $part_pkg->recurtax =~ /^Y$/i
2132                   || $tax->recurtax =~ /^Y$/i;
2133             next unless $taxable_charged;
2134
2135             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
2136               #my ($mon,$year) = (localtime($sdate) )[4,5];
2137               my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5];
2138               $mon++;
2139               my $freq = $part_pkg->freq || 1;
2140               if ( $freq !~ /(\d+)$/ ) {
2141                 $dbh->rollback if $oldAutoCommit;
2142                 return "daily/weekly package definitions not (yet?)".
2143                        " compatible with monthly tax exemptions";
2144               }
2145               my $taxable_per_month =
2146                 sprintf("%.2f", $taxable_charged / $freq );
2147
2148               #call the whole thing off if this customer has any old
2149               #exemption records...
2150               my @cust_tax_exempt =
2151                 qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } );
2152               if ( @cust_tax_exempt ) {
2153                 $dbh->rollback if $oldAutoCommit;
2154                 return
2155                   'this customer still has old-style tax exemption records; '.
2156                   'run bin/fs-migrate-cust_tax_exempt?';
2157               }
2158
2159               foreach my $which_month ( 1 .. $freq ) {
2160
2161                 #maintain the new exemption table now
2162                 my $sql = "
2163                   SELECT SUM(amount)
2164                     FROM cust_tax_exempt_pkg
2165                       LEFT JOIN cust_bill_pkg USING ( billpkgnum )
2166                       LEFT JOIN cust_bill     USING ( invnum     )
2167                     WHERE custnum = ?
2168                       AND taxnum  = ?
2169                       AND year    = ?
2170                       AND month   = ?
2171                 ";
2172                 my $sth = dbh->prepare($sql) or do {
2173                   $dbh->rollback if $oldAutoCommit;
2174                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2175                 };
2176                 $sth->execute(
2177                   $self->custnum,
2178                   $tax->taxnum,
2179                   1900+$year,
2180                   $mon,
2181                 ) or do {
2182                   $dbh->rollback if $oldAutoCommit;
2183                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
2184                 };
2185                 my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
2186
2187                 my $remaining_exemption =
2188                   $tax->exempt_amount - $existing_exemption;
2189                 if ( $remaining_exemption > 0 ) {
2190                   my $addl = $remaining_exemption > $taxable_per_month
2191                     ? $taxable_per_month
2192                     : $remaining_exemption;
2193                   $taxable_charged -= $addl;
2194
2195                   my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
2196                     'billpkgnum' => $cust_bill_pkg->billpkgnum,
2197                     'taxnum'     => $tax->taxnum,
2198                     'year'       => 1900+$year,
2199                     'month'      => $mon,
2200                     'amount'     => sprintf("%.2f", $addl ),
2201                   } );
2202                   $error = $cust_tax_exempt_pkg->insert;
2203                   if ( $error ) {
2204                     $dbh->rollback if $oldAutoCommit;
2205                     return "fatal: can't insert cust_tax_exempt_pkg: $error";
2206                   }
2207                 } # if $remaining_exemption > 0
2208
2209                 #++
2210                 $mon++;
2211                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
2212                 until ( $mon < 13 ) { $mon -= 12; $year++; }
2213
2214               } #foreach $which_month
2215
2216             } #if $tax->exempt_amount
2217
2218             $taxable_charged = sprintf( "%.2f", $taxable_charged);
2219
2220             #$tax += $taxable_charged * $cust_main_county->tax / 100
2221             $tax{ $tax->taxname || 'Tax' } +=
2222               $taxable_charged * $tax->tax / 100
2223
2224           } #foreach my $tax ( @taxes )
2225
2226         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
2227
2228       } #if $setup != 0 || $recur != 0
2229
2230     } #if $cust_pkg->modified
2231
2232   } #foreach my $cust_pkg
2233
2234   unless ( $cust_bill->cust_bill_pkg ) {
2235     $cust_bill->delete; #don't create an invoice w/o line items
2236     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2237     return '';
2238   }
2239
2240   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
2241
2242   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
2243     my $tax = sprintf("%.2f", $tax{$taxname} );
2244     $charged = sprintf( "%.2f", $charged+$tax );
2245
2246     my $cust_bill_pkg = new FS::cust_bill_pkg ({
2247       'invnum'   => $invnum,
2248       'pkgnum'   => 0,
2249       'setup'    => $tax,
2250       'recur'    => 0,
2251       'sdate'    => '',
2252       'edate'    => '',
2253       'itemdesc' => $taxname,
2254     });
2255     $error = $cust_bill_pkg->insert;
2256     if ( $error ) {
2257       $dbh->rollback if $oldAutoCommit;
2258       return "can't create invoice line item for invoice #$invnum: $error";
2259     }
2260     $total_setup += $tax;
2261
2262   }
2263
2264   $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) );
2265   $error = $cust_bill->replace;
2266   if ( $error ) {
2267     $dbh->rollback if $oldAutoCommit;
2268     return "can't update charged for invoice #$invnum: $error";
2269   }
2270
2271   foreach my $hook ( @precommit_hooks ) {
2272     eval {
2273       &{$hook}; #($self) ?
2274     };
2275     if ( $@ ) {
2276       $dbh->rollback if $oldAutoCommit;
2277       return "$@ running precommit hook $hook\n";
2278     }
2279   }
2280
2281   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2282   ''; #no error
2283 }
2284
2285 =item collect OPTIONS
2286
2287 (Attempt to) collect money for this customer's outstanding invoices (see
2288 L<FS::cust_bill>).  Usually used after the bill method.
2289
2290 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
2291 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
2292 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
2293
2294 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
2295 and the invoice events web interface.
2296
2297 If there is an error, returns the error, otherwise returns false.
2298
2299 Options are passed as name-value pairs.
2300
2301 Currently available options are:
2302
2303 invoice_time - Use this time when deciding when to print invoices and
2304 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>
2305 for conversion functions.
2306
2307 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
2308 events.
2309
2310 quiet - set true to surpress email card/ACH decline notices.
2311
2312 freq - "1d" for the traditional, daily events (the default), or "1m" for the
2313 new monthly events
2314
2315 payby - allows for one time override of normal customer billing method
2316
2317 =cut
2318
2319 sub collect {
2320   my( $self, %options ) = @_;
2321   my $invoice_time = $options{'invoice_time'} || time;
2322
2323   #put below somehow?
2324   local $SIG{HUP} = 'IGNORE';
2325   local $SIG{INT} = 'IGNORE';
2326   local $SIG{QUIT} = 'IGNORE';
2327   local $SIG{TERM} = 'IGNORE';
2328   local $SIG{TSTP} = 'IGNORE';
2329   local $SIG{PIPE} = 'IGNORE';
2330
2331   my $oldAutoCommit = $FS::UID::AutoCommit;
2332   local $FS::UID::AutoCommit = 0;
2333   my $dbh = dbh;
2334
2335   $self->select_for_update; #mutex
2336
2337   my $balance = $self->balance;
2338   warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2339     if $DEBUG;
2340   unless ( $balance > 0 ) { #redundant?????
2341     $dbh->rollback if $oldAutoCommit; #hmm
2342     return '';
2343   }
2344
2345   if ( exists($options{'retry_card'}) ) {
2346     carp 'retry_card option passed to collect is deprecated; use retry';
2347     $options{'retry'} ||= $options{'retry_card'};
2348   }
2349   if ( exists($options{'retry'}) && $options{'retry'} ) {
2350     my $error = $self->retry_realtime;
2351     if ( $error ) {
2352       $dbh->rollback if $oldAutoCommit;
2353       return $error;
2354     }
2355   }
2356
2357   my $extra_sql = '';
2358   if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
2359     $extra_sql = " AND freq = '1m' ";
2360   } else {
2361     $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
2362   }
2363
2364   foreach my $cust_bill ( $self->open_cust_bill ) {
2365
2366     # don't try to charge for the same invoice if it's already in a batch
2367     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
2368
2369     last if $self->balance <= 0;
2370
2371     warn "  invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n"
2372       if $DEBUG > 1;
2373
2374     foreach my $part_bill_event ( due_events ( $cust_bill,
2375                                                exists($options{'payby'})
2376                                                  ? $options{'payby'}
2377                                                  : $self->payby,
2378                                                $invoice_time,
2379                                                $extra_sql ) ) {
2380
2381       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
2382            || $self->balance   <= 0; # or if balance<=0
2383
2384       {
2385         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2386         warn "  do_event " .  $cust_bill . " ". (%options) .  "\n"
2387           if $DEBUG > 1;
2388
2389         if (my $error = $part_bill_event->do_event($cust_bill, %options)) {
2390           # gah, even with transactions.
2391           $dbh->commit if $oldAutoCommit; #well.
2392           return $error;
2393         }
2394       }
2395
2396     }
2397
2398   }
2399
2400   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2401   '';
2402
2403 }
2404
2405 =item retry_realtime
2406
2407 Schedules realtime / batch  credit card / electronic check / LEC billing
2408 events for for retry.  Useful if card information has changed or manual
2409 retry is desired.  The 'collect' method must be called to actually retry
2410 the transaction.
2411
2412 Implementation details: For each of this customer's open invoices, changes
2413 the status of the first "done" (with statustext error) realtime processing
2414 event to "failed".
2415
2416 =cut
2417
2418 sub retry_realtime {
2419   my $self = shift;
2420
2421   local $SIG{HUP} = 'IGNORE';
2422   local $SIG{INT} = 'IGNORE';
2423   local $SIG{QUIT} = 'IGNORE';
2424   local $SIG{TERM} = 'IGNORE';
2425   local $SIG{TSTP} = 'IGNORE';
2426   local $SIG{PIPE} = 'IGNORE';
2427
2428   my $oldAutoCommit = $FS::UID::AutoCommit;
2429   local $FS::UID::AutoCommit = 0;
2430   my $dbh = dbh;
2431
2432   foreach my $cust_bill (
2433     grep { $_->cust_bill_event }
2434       $self->open_cust_bill
2435   ) {
2436     my @cust_bill_event =
2437       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
2438         grep {
2439                #$_->part_bill_event->plan eq 'realtime-card'
2440                $_->part_bill_event->eventcode =~
2441                    /\$cust_bill\->(batch|realtime)_(card|ach|lec)/
2442                  && $_->status eq 'done'
2443                  && $_->statustext
2444              }
2445           $cust_bill->cust_bill_event;
2446     next unless @cust_bill_event;
2447     my $error = $cust_bill_event[0]->retry;
2448     if ( $error ) {
2449       $dbh->rollback if $oldAutoCommit;
2450       return "error scheduling invoice event for retry: $error";
2451     }
2452
2453   }
2454
2455   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2456   '';
2457
2458 }
2459
2460 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
2461
2462 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
2463 via a Business::OnlinePayment realtime gateway.  See
2464 L<http://420.am/business-onlinepayment> for supported gateways.
2465
2466 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2467
2468 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
2469
2470 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2471 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2472 if set, will override the value from the customer record.
2473
2474 I<description> is a free-text field passed to the gateway.  It defaults to
2475 "Internet services".
2476
2477 If an I<invnum> is specified, this payment (if successful) is applied to the
2478 specified invoice.  If you don't specify an I<invnum> you might want to
2479 call the B<apply_payments> method.
2480
2481 I<quiet> can be set true to surpress email decline notices.
2482
2483 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
2484 resulting paynum, if any.
2485
2486 I<payunique> is a unique identifier for this payment.
2487
2488 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
2489
2490 =back
2491
2492 =cut
2493
2494 sub realtime_bop {
2495   my( $self, $method, $amount, %options ) = @_;
2496   if ( $DEBUG ) {
2497     warn "$me realtime_bop: $method $amount\n";
2498     warn "  $_ => $options{$_}\n" foreach keys %options;
2499   }
2500
2501   $options{'description'} ||= 'Internet services';
2502
2503   eval "use Business::OnlinePayment";
2504   die $@ if $@;
2505
2506   my $payinfo = exists($options{'payinfo'})
2507                   ? $options{'payinfo'}
2508                   : $self->payinfo;
2509
2510   my %method2payby = (
2511     'CC'     => 'CARD',
2512     'ECHECK' => 'CHEK',
2513     'LEC'    => 'LECB',
2514   );
2515
2516   ###
2517   # select a gateway
2518   ###
2519
2520   my $taxclass = '';
2521   if ( $options{'invnum'} ) {
2522     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
2523     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
2524     my @taxclasses =
2525       map  { $_->part_pkg->taxclass }
2526       grep { $_ }
2527       map  { $_->cust_pkg }
2528       $cust_bill->cust_bill_pkg;
2529     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
2530                                                            #different taxclasses
2531       $taxclass = $taxclasses[0];
2532     }
2533   }
2534
2535   #look for an agent gateway override first
2536   my $cardtype;
2537   if ( $method eq 'CC' ) {
2538     $cardtype = cardtype($payinfo);
2539   } elsif ( $method eq 'ECHECK' ) {
2540     $cardtype = 'ACH';
2541   } else {
2542     $cardtype = $method;
2543   }
2544
2545   my $override =
2546        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2547                                            cardtype => $cardtype,
2548                                            taxclass => $taxclass,       } )
2549     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2550                                            cardtype => '',
2551                                            taxclass => $taxclass,       } )
2552     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2553                                            cardtype => $cardtype,
2554                                            taxclass => '',              } )
2555     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
2556                                            cardtype => '',
2557                                            taxclass => '',              } );
2558
2559   my $payment_gateway = '';
2560   my( $processor, $login, $password, $action, @bop_options );
2561   if ( $override ) { #use a payment gateway override
2562
2563     $payment_gateway = $override->payment_gateway;
2564
2565     $processor   = $payment_gateway->gateway_module;
2566     $login       = $payment_gateway->gateway_username;
2567     $password    = $payment_gateway->gateway_password;
2568     $action      = $payment_gateway->gateway_action;
2569     @bop_options = $payment_gateway->options;
2570
2571   } else { #use the standard settings from the config
2572
2573     ( $processor, $login, $password, $action, @bop_options ) =
2574       $self->default_payment_gateway($method);
2575
2576   }
2577
2578   ###
2579   # massage data
2580   ###
2581
2582   my $address = exists($options{'address1'})
2583                     ? $options{'address1'}
2584                     : $self->address1;
2585   my $address2 = exists($options{'address2'})
2586                     ? $options{'address2'}
2587                     : $self->address2;
2588   $address .= ", ". $address2 if length($address2);
2589
2590   my $o_payname = exists($options{'payname'})
2591                     ? $options{'payname'}
2592                     : $self->payname;
2593   my($payname, $payfirst, $paylast);
2594   if ( $o_payname && $method ne 'ECHECK' ) {
2595     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2596       or return "Illegal payname $payname";
2597     ($payfirst, $paylast) = ($1, $2);
2598   } else {
2599     $payfirst = $self->getfield('first');
2600     $paylast = $self->getfield('last');
2601     $payname =  "$payfirst $paylast";
2602   }
2603
2604   my @invoicing_list = $self->invoicing_list_emailonly;
2605   if ( $conf->exists('emailinvoiceautoalways')
2606        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
2607        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
2608     push @invoicing_list, $self->all_emails;
2609   }
2610
2611   my $email = ($conf->exists('business-onlinepayment-email-override'))
2612               ? $conf->config('business-onlinepayment-email-override')
2613               : $invoicing_list[0];
2614
2615   my %content = ();
2616
2617   my $payip = exists($options{'payip'})
2618                 ? $options{'payip'}
2619                 : $self->payip;
2620   $content{customer_ip} = $payip
2621     if length($payip);
2622
2623   $content{invoice_number} = $options{'invnum'}
2624     if exists($options{'invnum'}) && length($options{'invnum'});
2625
2626   $content{email_customer} =
2627     (    $conf->exists('business-onlinepayment-email_customer')
2628       || $conf->exists('business-onlinepayment-email-override') );
2629
2630   my $paydate = '';
2631   if ( $method eq 'CC' ) {
2632
2633     $content{card_number} = $payinfo;
2634     $paydate = exists($options{'paydate'})
2635                     ? $options{'paydate'}
2636                     : $self->paydate;
2637     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2638     $content{expiration} = "$2/$1";
2639
2640     my $paycvv = exists($options{'paycvv'})
2641                    ? $options{'paycvv'}
2642                    : $self->paycvv;
2643     $content{cvv2} = $paycvv
2644       if length($paycvv);
2645
2646     my $paystart_month = exists($options{'paystart_month'})
2647                            ? $options{'paystart_month'}
2648                            : $self->paystart_month;
2649
2650     my $paystart_year  = exists($options{'paystart_year'})
2651                            ? $options{'paystart_year'}
2652                            : $self->paystart_year;
2653
2654     $content{card_start} = "$paystart_month/$paystart_year"
2655       if $paystart_month && $paystart_year;
2656
2657     my $payissue       = exists($options{'payissue'})
2658                            ? $options{'payissue'}
2659                            : $self->payissue;
2660     $content{issue_number} = $payissue if $payissue;
2661
2662     $content{recurring_billing} = 'YES'
2663       if qsearch('cust_pay', { 'custnum' => $self->custnum,
2664                                'payby'   => 'CARD',
2665                                'payinfo' => $payinfo,
2666                              } )
2667       || qsearch('cust_pay', { 'custnum' => $self->custnum,
2668                                'payby'   => 'CARD',
2669                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
2670                              } );
2671
2672
2673   } elsif ( $method eq 'ECHECK' ) {
2674     ( $content{account_number}, $content{routing_code} ) =
2675       split('@', $payinfo);
2676     $content{bank_name} = $o_payname;
2677     $content{bank_state} = exists($options{'paystate'})
2678                              ? $options{'paystate'}
2679                              : $self->getfield('paystate');
2680     $content{account_type} = exists($options{'paytype'})
2681                                ? uc($options{'paytype'}) || 'CHECKING'
2682                                : uc($self->getfield('paytype')) || 'CHECKING';
2683     $content{account_name} = $payname;
2684     $content{customer_org} = $self->company ? 'B' : 'I';
2685     $content{state_id}       = exists($options{'stateid'})
2686                                  ? $options{'stateid'}
2687                                  : $self->getfield('stateid');
2688     $content{state_id_state} = exists($options{'stateid_state'})
2689                                  ? $options{'stateid_state'}
2690                                  : $self->getfield('stateid_state');
2691     $content{customer_ssn} = exists($options{'ss'})
2692                                ? $options{'ss'}
2693                                : $self->ss;
2694   } elsif ( $method eq 'LEC' ) {
2695     $content{phone} = $payinfo;
2696   }
2697
2698   ###
2699   # run transaction(s)
2700   ###
2701
2702   my $balance = exists( $options{'balance'} )
2703                   ? $options{'balance'}
2704                   : $self->balance;
2705
2706   $self->select_for_update; #mutex ... just until we get our pending record in
2707
2708   #the checks here are intended to catch concurrent payments
2709   #double-form-submission prevention is taken care of in cust_pay_pending::check
2710
2711   #check the balance
2712   return "The customer's balance has changed; $method transaction aborted."
2713     if $self->balance < $balance;
2714     #&& $self->balance < $amount; #might as well anyway?
2715
2716   #also check and make sure there aren't *other* pending payments for this cust
2717
2718   my @pending = qsearch('cust_pay_pending', {
2719     'custnum' => $self->custnum,
2720     'status'  => { op=>'!=', value=>'done' }
2721   });
2722   return "A payment is already being processed for this customer (".
2723          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
2724          "); $method transaction aborted."
2725     if scalar(@pending);
2726
2727   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
2728
2729   my $cust_pay_pending = new FS::cust_pay_pending {
2730     'custnum'    => $self->custnum,
2731     #'invnum'     => $options{'invnum'},
2732     'paid'       => $amount,
2733     '_date'      => '',
2734     'payby'      => $method2payby{$method},
2735     'payinfo'    => $payinfo,
2736     'paydate'    => $paydate,
2737     'status'     => 'new',
2738     'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
2739   };
2740   $cust_pay_pending->payunique( $options{payunique} )
2741     if length($options{payunique});
2742   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
2743   return $cpp_new_err if $cpp_new_err;
2744
2745   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
2746
2747   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
2748   $transaction->content(
2749     'type'           => $method,
2750     'login'          => $login,
2751     'password'       => $password,
2752     'action'         => $action1,
2753     'description'    => $options{'description'},
2754     'amount'         => $amount,
2755     #'invoice_number' => $options{'invnum'},
2756     'customer_id'    => $self->custnum,
2757     'last_name'      => $paylast,
2758     'first_name'     => $payfirst,
2759     'name'           => $payname,
2760     'address'        => $address,
2761     'city'           => ( exists($options{'city'})
2762                             ? $options{'city'}
2763                             : $self->city          ),
2764     'state'          => ( exists($options{'state'})
2765                             ? $options{'state'}
2766                             : $self->state          ),
2767     'zip'            => ( exists($options{'zip'})
2768                             ? $options{'zip'}
2769                             : $self->zip          ),
2770     'country'        => ( exists($options{'country'})
2771                             ? $options{'country'}
2772                             : $self->country          ),
2773     'referer'        => 'http://cleanwhisker.420.am/',
2774     'email'          => $email,
2775     'phone'          => $self->daytime || $self->night,
2776     %content, #after
2777   );
2778
2779   $cust_pay_pending->status('pending');
2780   my $cpp_pending_err = $cust_pay_pending->replace;
2781   return $cpp_pending_err if $cpp_pending_err;
2782
2783   $transaction->submit();
2784
2785   if ( $transaction->is_success() && $action2 ) {
2786
2787     $cust_pay_pending->status('authorized');
2788     my $cpp_authorized_err = $cust_pay_pending->replace;
2789     return $cpp_authorized_err if $cpp_authorized_err;
2790
2791     my $auth = $transaction->authorization;
2792     my $ordernum = $transaction->can('order_number')
2793                    ? $transaction->order_number
2794                    : '';
2795
2796     my $capture =
2797       new Business::OnlinePayment( $processor, @bop_options );
2798
2799     my %capture = (
2800       %content,
2801       type           => $method,
2802       action         => $action2,
2803       login          => $login,
2804       password       => $password,
2805       order_number   => $ordernum,
2806       amount         => $amount,
2807       authorization  => $auth,
2808       description    => $options{'description'},
2809     );
2810
2811     foreach my $field (qw( authorization_source_code returned_ACI
2812                            transaction_identifier validation_code
2813                            transaction_sequence_num local_transaction_date
2814                            local_transaction_time AVS_result_code          )) {
2815       $capture{$field} = $transaction->$field() if $transaction->can($field);
2816     }
2817
2818     $capture->content( %capture );
2819
2820     $capture->submit();
2821
2822     unless ( $capture->is_success ) {
2823       my $e = "Authorization successful but capture failed, custnum #".
2824               $self->custnum. ': '.  $capture->result_code.
2825               ": ". $capture->error_message;
2826       warn $e;
2827       return $e;
2828     }
2829
2830   }
2831
2832   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
2833   my $cpp_captured_err = $cust_pay_pending->replace;
2834   return $cpp_captured_err if $cpp_captured_err;
2835
2836   ###
2837   # remove paycvv after initial transaction
2838   ###
2839
2840   #false laziness w/misc/process/payment.cgi - check both to make sure working
2841   # correctly
2842   if ( defined $self->dbdef_table->column('paycvv')
2843        && length($self->paycvv)
2844        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2845   ) {
2846     my $error = $self->remove_cvv;
2847     if ( $error ) {
2848       warn "WARNING: error removing cvv: $error\n";
2849     }
2850   }
2851
2852   ###
2853   # result handling
2854   ###
2855
2856   if ( $transaction->is_success() ) {
2857
2858     my $paybatch = '';
2859     if ( $payment_gateway ) { # agent override
2860       $paybatch = $payment_gateway->gatewaynum. '-';
2861     }
2862
2863     $paybatch .= "$processor:". $transaction->authorization;
2864
2865     $paybatch .= ':'. $transaction->order_number
2866       if $transaction->can('order_number')
2867       && length($transaction->order_number);
2868
2869     my $cust_pay = new FS::cust_pay ( {
2870        'custnum'  => $self->custnum,
2871        'invnum'   => $options{'invnum'},
2872        'paid'     => $amount,
2873        '_date'     => '',
2874        'payby'    => $method2payby{$method},
2875        'payinfo'  => $payinfo,
2876        'paybatch' => $paybatch,
2877        'paydate'  => $paydate,
2878     } );
2879     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
2880     $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
2881
2882     my $oldAutoCommit = $FS::UID::AutoCommit;
2883     local $FS::UID::AutoCommit = 0;
2884     my $dbh = dbh;
2885
2886     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
2887
2888     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
2889
2890     if ( $error ) {
2891       $cust_pay->invnum(''); #try again with no specific invnum
2892       my $error2 = $cust_pay->insert( $options{'manual'} ?
2893                                       ( 'manual' => 1 ) : ()
2894                                     );
2895       if ( $error2 ) {
2896         # gah.  but at least we have a record of the state we had to abort in
2897         # from cust_pay_pending now.
2898         my $e = "WARNING: $method captured but payment not recorded - ".
2899                 "error inserting payment ($processor): $error2".
2900                 " (previously tried insert with invnum #$options{'invnum'}" .
2901                 ": $error ) - pending payment saved as paypendingnum ".
2902                 $cust_pay_pending->paypendingnum. "\n";
2903         warn $e;
2904         return $e;
2905       }
2906     }
2907
2908     if ( $options{'paynum_ref'} ) {
2909       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
2910     }
2911
2912     $cust_pay_pending->status('done');
2913     $cust_pay_pending->statustext('captured');
2914     my $cpp_done_err = $cust_pay_pending->replace;
2915
2916     if ( $cpp_done_err ) {
2917
2918       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2919       my $e = "WARNING: $method captured but payment not recorded - ".
2920               "error updating status for paypendingnum ".
2921               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
2922       warn $e;
2923       return $e;
2924
2925     } else {
2926
2927       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2928       return ''; #no error
2929
2930     }
2931
2932   } else {
2933
2934     my $perror = "$processor error: ". $transaction->error_message;
2935
2936     unless ( $transaction->error_message ) {
2937
2938       my $t_response;
2939       #this should be normalized :/
2940       #
2941       # bad, ad-hoc B:OP:PayflowPro "transaction_response" BS
2942       if ( $transaction->can('param')
2943            && $transaction->param('transaction_response') ) {
2944         $t_response = $transaction->param('transaction_response')
2945
2946       # slightly better, ad-hoc B:OP:TransactionCentral without "param"
2947       } elsif ( $transaction->can('response_page') ) {
2948         $t_response = {
2949                         'page'    => ( $transaction->can('response_page')
2950                                          ? $transaction->response_page
2951                                          : ''
2952                                      ),
2953                         'code'    => ( $transaction->can('response_code')
2954                                          ? $transaction->response_code
2955                                          : ''
2956                                      ),
2957                         'headers' => ( $transaction->can('response_headers')
2958                                          ? $transaction->response_headers
2959                                          : ''
2960                                      ),
2961                       };
2962       } else {
2963         $t_response .=
2964           "No additional debugging information available for $processor";
2965       }
2966
2967       $perror .= "No error_message returned from $processor -- ".
2968                  ( ref($t_response) ? Dumper($t_response) : $t_response );
2969
2970     }
2971
2972     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2973          && $conf->exists('emaildecline')
2974          && grep { $_ ne 'POST' } $self->invoicing_list
2975          && ! grep { $transaction->error_message =~ /$_/ }
2976                    $conf->config('emaildecline-exclude')
2977     ) {
2978       my @templ = $conf->config('declinetemplate');
2979       my $template = new Text::Template (
2980         TYPE   => 'ARRAY',
2981         SOURCE => [ map "$_\n", @templ ],
2982       ) or return "($perror) can't create template: $Text::Template::ERROR";
2983       $template->compile()
2984         or return "($perror) can't compile template: $Text::Template::ERROR";
2985
2986       my $templ_hash = { error => $transaction->error_message };
2987
2988       my $error = send_email(
2989         'from'    => $conf->config('invoice_from'),
2990         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2991         'subject' => 'Your payment could not be processed',
2992         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2993       );
2994
2995       $perror .= " (also received error sending decline notification: $error)"
2996         if $error;
2997
2998     }
2999
3000     $cust_pay_pending->status('done');
3001     $cust_pay_pending->statustext("declined: $perror");
3002     my $cpp_done_err = $cust_pay_pending->replace;
3003     if ( $cpp_done_err ) {
3004       my $e = "WARNING: $method declined but pending payment not resolved - ".
3005               "error updating status for paypendingnum ".
3006               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3007       warn $e;
3008       $perror = "$e ($perror)";
3009     }
3010
3011     return $perror;
3012   }
3013
3014 }
3015
3016 =item default_payment_gateway
3017
3018 =cut
3019
3020 sub default_payment_gateway {
3021   my( $self, $method ) = @_;
3022
3023   die "Real-time processing not enabled\n"
3024     unless $conf->exists('business-onlinepayment');
3025
3026   #load up config
3027   my $bop_config = 'business-onlinepayment';
3028   $bop_config .= '-ach'
3029     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3030   my ( $processor, $login, $password, $action, @bop_options ) =
3031     $conf->config($bop_config);
3032   $action ||= 'normal authorization';
3033   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3034   die "No real-time processor is enabled - ".
3035       "did you set the business-onlinepayment configuration value?\n"
3036     unless $processor;
3037
3038   ( $processor, $login, $password, $action, @bop_options )
3039 }
3040
3041 =item remove_cvv
3042
3043 Removes the I<paycvv> field from the database directly.
3044
3045 If there is an error, returns the error, otherwise returns false.
3046
3047 =cut
3048
3049 sub remove_cvv {
3050   my $self = shift;
3051   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3052     or return dbh->errstr;
3053   $sth->execute($self->custnum)
3054     or return $sth->errstr;
3055   $self->paycvv('');
3056   '';
3057 }
3058
3059 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3060
3061 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3062 via a Business::OnlinePayment realtime gateway.  See
3063 L<http://420.am/business-onlinepayment> for supported gateways.
3064
3065 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3066
3067 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3068
3069 Most gateways require a reference to an original payment transaction to refund,
3070 so you probably need to specify a I<paynum>.
3071
3072 I<amount> defaults to the original amount of the payment if not specified.
3073
3074 I<reason> specifies a reason for the refund.
3075
3076 I<paydate> specifies the expiration date for a credit card overriding the
3077 value from the customer record or the payment record. Specified as yyyy-mm-dd
3078
3079 Implementation note: If I<amount> is unspecified or equal to the amount of the
3080 orignal payment, first an attempt is made to "void" the transaction via
3081 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3082 the normal attempt is made to "refund" ("credit") the transaction via the
3083 gateway is attempted.
3084
3085 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3086 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3087 #if set, will override the value from the customer record.
3088
3089 #If an I<invnum> is specified, this payment (if successful) is applied to the
3090 #specified invoice.  If you don't specify an I<invnum> you might want to
3091 #call the B<apply_payments> method.
3092
3093 =cut
3094
3095 #some false laziness w/realtime_bop, not enough to make it worth merging
3096 #but some useful small subs should be pulled out
3097 sub realtime_refund_bop {
3098   my( $self, $method, %options ) = @_;
3099   if ( $DEBUG ) {
3100     warn "$me realtime_refund_bop: $method refund\n";
3101     warn "  $_ => $options{$_}\n" foreach keys %options;
3102   }
3103
3104   eval "use Business::OnlinePayment";
3105   die $@ if $@;
3106
3107   ###
3108   # look up the original payment and optionally a gateway for that payment
3109   ###
3110
3111   my $cust_pay = '';
3112   my $amount = $options{'amount'};
3113
3114   my( $processor, $login, $password, @bop_options ) ;
3115   my( $auth, $order_number ) = ( '', '', '' );
3116
3117   if ( $options{'paynum'} ) {
3118
3119     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
3120     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3121       or return "Unknown paynum $options{'paynum'}";
3122     $amount ||= $cust_pay->paid;
3123
3124     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3125       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3126                 $cust_pay->paybatch;
3127     my $gatewaynum = '';
3128     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3129
3130     if ( $gatewaynum ) { #gateway for the payment to be refunded
3131
3132       my $payment_gateway =
3133         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3134       die "payment gateway $gatewaynum not found"
3135         unless $payment_gateway;
3136
3137       $processor   = $payment_gateway->gateway_module;
3138       $login       = $payment_gateway->gateway_username;
3139       $password    = $payment_gateway->gateway_password;
3140       @bop_options = $payment_gateway->options;
3141
3142     } else { #try the default gateway
3143
3144       my( $conf_processor, $unused_action );
3145       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3146         $self->default_payment_gateway($method);
3147
3148       return "processor of payment $options{'paynum'} $processor does not".
3149              " match default processor $conf_processor"
3150         unless $processor eq $conf_processor;
3151
3152     }
3153
3154
3155   } else { # didn't specify a paynum, so look for agent gateway overrides
3156            # like a normal transaction
3157
3158     my $cardtype;
3159     if ( $method eq 'CC' ) {
3160       $cardtype = cardtype($self->payinfo);
3161     } elsif ( $method eq 'ECHECK' ) {
3162       $cardtype = 'ACH';
3163     } else {
3164       $cardtype = $method;
3165     }
3166     my $override =
3167            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3168                                                cardtype => $cardtype,
3169                                                taxclass => '',              } )
3170         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3171                                                cardtype => '',
3172                                                taxclass => '',              } );
3173
3174     if ( $override ) { #use a payment gateway override
3175
3176       my $payment_gateway = $override->payment_gateway;
3177
3178       $processor   = $payment_gateway->gateway_module;
3179       $login       = $payment_gateway->gateway_username;
3180       $password    = $payment_gateway->gateway_password;
3181       #$action      = $payment_gateway->gateway_action;
3182       @bop_options = $payment_gateway->options;
3183
3184     } else { #use the standard settings from the config
3185
3186       my $unused_action;
3187       ( $processor, $login, $password, $unused_action, @bop_options ) =
3188         $self->default_payment_gateway($method);
3189
3190     }
3191
3192   }
3193   return "neither amount nor paynum specified" unless $amount;
3194
3195   my %content = (
3196     'type'           => $method,
3197     'login'          => $login,
3198     'password'       => $password,
3199     'order_number'   => $order_number,
3200     'amount'         => $amount,
3201     'referer'        => 'http://cleanwhisker.420.am/',
3202   );
3203   $content{authorization} = $auth
3204     if length($auth); #echeck/ACH transactions have an order # but no auth
3205                       #(at least with authorize.net)
3206
3207   my $disable_void_after;
3208   if ($conf->exists('disable_void_after')
3209       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3210     $disable_void_after = $1;
3211   }
3212
3213   #first try void if applicable
3214   if ( $cust_pay && $cust_pay->paid == $amount
3215     && (
3216       ( not defined($disable_void_after) )
3217       || ( time < ($cust_pay->_date + $disable_void_after ) )
3218     )
3219   ) {
3220     warn "  attempting void\n" if $DEBUG > 1;
3221     my $void = new Business::OnlinePayment( $processor, @bop_options );
3222     $void->content( 'action' => 'void', %content );
3223     $void->submit();
3224     if ( $void->is_success ) {
3225       my $error = $cust_pay->void($options{'reason'});
3226       if ( $error ) {
3227         # gah, even with transactions.
3228         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3229                 "error voiding payment: $error";
3230         warn $e;
3231         return $e;
3232       }
3233       warn "  void successful\n" if $DEBUG > 1;
3234       return '';
3235     }
3236   }
3237
3238   warn "  void unsuccessful, trying refund\n"
3239     if $DEBUG > 1;
3240
3241   #massage data
3242   my $address = $self->address1;
3243   $address .= ", ". $self->address2 if $self->address2;
3244
3245   my($payname, $payfirst, $paylast);
3246   if ( $self->payname && $method ne 'ECHECK' ) {
3247     $payname = $self->payname;
3248     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3249       or return "Illegal payname $payname";
3250     ($payfirst, $paylast) = ($1, $2);
3251   } else {
3252     $payfirst = $self->getfield('first');
3253     $paylast = $self->getfield('last');
3254     $payname =  "$payfirst $paylast";
3255   }
3256
3257   my @invoicing_list = $self->invoicing_list_emailonly;
3258   if ( $conf->exists('emailinvoiceautoalways')
3259        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3260        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3261     push @invoicing_list, $self->all_emails;
3262   }
3263
3264   my $email = ($conf->exists('business-onlinepayment-email-override'))
3265               ? $conf->config('business-onlinepayment-email-override')
3266               : $invoicing_list[0];
3267
3268   my $payip = exists($options{'payip'})
3269                 ? $options{'payip'}
3270                 : $self->payip;
3271   $content{customer_ip} = $payip
3272     if length($payip);
3273
3274   my $payinfo = '';
3275   if ( $method eq 'CC' ) {
3276
3277     if ( $cust_pay ) {
3278       $content{card_number} = $payinfo = $cust_pay->payinfo;
3279       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
3280         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
3281         ($content{expiration} = "$2/$1");  # where available
3282     } else {
3283       $content{card_number} = $payinfo = $self->payinfo;
3284       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
3285         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3286       $content{expiration} = "$2/$1";
3287     }
3288
3289   } elsif ( $method eq 'ECHECK' ) {
3290
3291     if ( $cust_pay ) {
3292       $payinfo = $cust_pay->payinfo;
3293     } else {
3294       $payinfo = $self->payinfo;
3295     }
3296     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
3297     $content{bank_name} = $self->payname;
3298     $content{account_type} = 'CHECKING';
3299     $content{account_name} = $payname;
3300     $content{customer_org} = $self->company ? 'B' : 'I';
3301     $content{customer_ssn} = $self->ss;
3302   } elsif ( $method eq 'LEC' ) {
3303     $content{phone} = $payinfo = $self->payinfo;
3304   }
3305
3306   #then try refund
3307   my $refund = new Business::OnlinePayment( $processor, @bop_options );
3308   my %sub_content = $refund->content(
3309     'action'         => 'credit',
3310     'customer_id'    => $self->custnum,
3311     'last_name'      => $paylast,
3312     'first_name'     => $payfirst,
3313     'name'           => $payname,
3314     'address'        => $address,
3315     'city'           => $self->city,
3316     'state'          => $self->state,
3317     'zip'            => $self->zip,
3318     'country'        => $self->country,
3319     'email'          => $email,
3320     'phone'          => $self->daytime || $self->night,
3321     %content, #after
3322   );
3323   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
3324     if $DEBUG > 1;
3325   $refund->submit();
3326
3327   return "$processor error: ". $refund->error_message
3328     unless $refund->is_success();
3329
3330   my %method2payby = (
3331     'CC'     => 'CARD',
3332     'ECHECK' => 'CHEK',
3333     'LEC'    => 'LECB',
3334   );
3335
3336   my $paybatch = "$processor:". $refund->authorization;
3337   $paybatch .= ':'. $refund->order_number
3338     if $refund->can('order_number') && $refund->order_number;
3339
3340   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
3341     my @cust_bill_pay = $cust_pay->cust_bill_pay;
3342     last unless @cust_bill_pay;
3343     my $cust_bill_pay = pop @cust_bill_pay;
3344     my $error = $cust_bill_pay->delete;
3345     last if $error;
3346   }
3347
3348   my $cust_refund = new FS::cust_refund ( {
3349     'custnum'  => $self->custnum,
3350     'paynum'   => $options{'paynum'},
3351     'refund'   => $amount,
3352     '_date'    => '',
3353     'payby'    => $method2payby{$method},
3354     'payinfo'  => $payinfo,
3355     'paybatch' => $paybatch,
3356     'reason'   => $options{'reason'} || 'card or ACH refund',
3357   } );
3358   my $error = $cust_refund->insert;
3359   if ( $error ) {
3360     $cust_refund->paynum(''); #try again with no specific paynum
3361     my $error2 = $cust_refund->insert;
3362     if ( $error2 ) {
3363       # gah, even with transactions.
3364       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
3365               "error inserting refund ($processor): $error2".
3366               " (previously tried insert with paynum #$options{'paynum'}" .
3367               ": $error )";
3368       warn $e;
3369       return $e;
3370     }
3371   }
3372
3373   ''; #no error
3374
3375 }
3376
3377 =item batch_card OPTION => VALUE...
3378
3379 Adds a payment for this invoice to the pending credit card batch (see
3380 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3381 runs the payment using a realtime gateway.
3382
3383 =cut
3384
3385 sub batch_card {
3386   my ($self, %options) = @_;
3387
3388   my $amount;
3389   if (exists($options{amount})) {
3390     $amount = $options{amount};
3391   }else{
3392     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3393   }
3394   return '' unless $amount > 0;
3395
3396   my $invnum = delete $options{invnum};
3397   my $payby = $options{invnum} || $self->payby;  #dubious
3398
3399   if ($options{'realtime'}) {
3400     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3401                                 $amount,
3402                                 %options,
3403                               );
3404   }
3405
3406   my $oldAutoCommit = $FS::UID::AutoCommit;
3407   local $FS::UID::AutoCommit = 0;
3408   my $dbh = dbh;
3409
3410   #this needs to handle mysql as well as Pg, like svc_acct.pm
3411   #(make it into a common function if folks need to do batching with mysql)
3412   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3413     or return "Cannot lock pay_batch: " . $dbh->errstr;
3414
3415   my %pay_batch = (
3416     'status' => 'O',
3417     'payby'  => FS::payby->payby2payment($payby),
3418   );
3419
3420   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3421
3422   unless ( $pay_batch ) {
3423     $pay_batch = new FS::pay_batch \%pay_batch;
3424     my $error = $pay_batch->insert;
3425     if ( $error ) {
3426       $dbh->rollback if $oldAutoCommit;
3427       die "error creating new batch: $error\n";
3428     }
3429   }
3430
3431   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3432       'batchnum' => $pay_batch->batchnum,
3433       'custnum'  => $self->custnum,
3434   } );
3435
3436   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3437                payname )) {
3438     $options{$_} = '' unless exists($options{$_});
3439   }
3440
3441   my $cust_pay_batch = new FS::cust_pay_batch ( {
3442     'batchnum' => $pay_batch->batchnum,
3443     'invnum'   => $invnum || 0,                    # is there a better value?
3444                                                    # this field should be
3445                                                    # removed...
3446                                                    # cust_bill_pay_batch now
3447     'custnum'  => $self->custnum,
3448     'last'     => $self->getfield('last'),
3449     'first'    => $self->getfield('first'),
3450     'address1' => $options{address1} || $self->address1,
3451     'address2' => $options{address2} || $self->address2,
3452     'city'     => $options{city}     || $self->city,
3453     'state'    => $options{state}    || $self->state,
3454     'zip'      => $options{zip}      || $self->zip,
3455     'country'  => $options{country}  || $self->country,
3456     'payby'    => $options{payby}    || $self->payby,
3457     'payinfo'  => $options{payinfo}  || $self->payinfo,
3458     'exp'      => $options{paydate}  || $self->paydate,
3459     'payname'  => $options{payname}  || $self->payname,
3460     'amount'   => $amount,                         # consolidating
3461   } );
3462
3463   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3464     if $old_cust_pay_batch;
3465
3466   my $error;
3467   if ($old_cust_pay_batch) {
3468     $error = $cust_pay_batch->replace($old_cust_pay_batch)
3469   } else {
3470     $error = $cust_pay_batch->insert;
3471   }
3472
3473   if ( $error ) {
3474     $dbh->rollback if $oldAutoCommit;
3475     die $error;
3476   }
3477
3478   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
3479   foreach my $cust_bill ($self->open_cust_bill) {
3480     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3481     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3482       'invnum' => $cust_bill->invnum,
3483       'paybatchnum' => $cust_pay_batch->paybatchnum,
3484       'amount' => $cust_bill->owed,
3485       '_date' => time,
3486     };
3487     if ($unapplied >= $cust_bill_pay_batch->amount){
3488       $unapplied -= $cust_bill_pay_batch->amount;
3489       next;
3490     }else{
3491       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3492                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
3493     }
3494     $error = $cust_bill_pay_batch->insert;
3495     if ( $error ) {
3496       $dbh->rollback if $oldAutoCommit;
3497       die $error;
3498     }
3499   }
3500
3501   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3502   '';
3503 }
3504
3505 =item total_owed
3506
3507 Returns the total owed for this customer on all invoices
3508 (see L<FS::cust_bill/owed>).
3509
3510 =cut
3511
3512 sub total_owed {
3513   my $self = shift;
3514   $self->total_owed_date(2145859200); #12/31/2037
3515 }
3516
3517 =item total_owed_date TIME
3518
3519 Returns the total owed for this customer on all invoices with date earlier than
3520 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3521 see L<Time::Local> and L<Date::Parse> for conversion functions.
3522
3523 =cut
3524
3525 sub total_owed_date {
3526   my $self = shift;
3527   my $time = shift;
3528   my $total_bill = 0;
3529   foreach my $cust_bill (
3530     grep { $_->_date <= $time }
3531       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3532   ) {
3533     $total_bill += $cust_bill->owed;
3534   }
3535   sprintf( "%.2f", $total_bill );
3536 }
3537
3538 =item apply_payments_and_credits
3539
3540 Applies unapplied payments and credits.
3541
3542 In most cases, this new method should be used in place of sequential
3543 apply_payments and apply_credits methods.
3544
3545 If there is an error, returns the error, otherwise returns false.
3546
3547 =cut
3548
3549 sub apply_payments_and_credits {
3550   my $self = shift;
3551
3552   local $SIG{HUP} = 'IGNORE';
3553   local $SIG{INT} = 'IGNORE';
3554   local $SIG{QUIT} = 'IGNORE';
3555   local $SIG{TERM} = 'IGNORE';
3556   local $SIG{TSTP} = 'IGNORE';
3557   local $SIG{PIPE} = 'IGNORE';
3558
3559   my $oldAutoCommit = $FS::UID::AutoCommit;
3560   local $FS::UID::AutoCommit = 0;
3561   my $dbh = dbh;
3562
3563   $self->select_for_update; #mutex
3564
3565   foreach my $cust_bill ( $self->open_cust_bill ) {
3566     my $error = $cust_bill->apply_payments_and_credits;
3567     if ( $error ) {
3568       $dbh->rollback if $oldAutoCommit;
3569       return "Error applying: $error";
3570     }
3571   }
3572
3573   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3574   ''; #no error
3575
3576 }
3577
3578 =item apply_credits OPTION => VALUE ...
3579
3580 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
3581 to outstanding invoice balances in chronological order (or reverse
3582 chronological order if the I<order> option is set to B<newest>) and returns the
3583 value of any remaining unapplied credits available for refund (see
3584 L<FS::cust_refund>).
3585
3586 Dies if there is an error.
3587
3588 =cut
3589
3590 sub apply_credits {
3591   my $self = shift;
3592   my %opt = @_;
3593
3594   local $SIG{HUP} = 'IGNORE';
3595   local $SIG{INT} = 'IGNORE';
3596   local $SIG{QUIT} = 'IGNORE';
3597   local $SIG{TERM} = 'IGNORE';
3598   local $SIG{TSTP} = 'IGNORE';
3599   local $SIG{PIPE} = 'IGNORE';
3600
3601   my $oldAutoCommit = $FS::UID::AutoCommit;
3602   local $FS::UID::AutoCommit = 0;
3603   my $dbh = dbh;
3604
3605   $self->select_for_update; #mutex
3606
3607   unless ( $self->total_credited ) {
3608     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3609     return 0;
3610   }
3611
3612   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
3613       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
3614
3615   my @invoices = $self->open_cust_bill;
3616   @invoices = sort { $b->_date <=> $a->_date } @invoices
3617     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
3618
3619   my $credit;
3620   foreach my $cust_bill ( @invoices ) {
3621     my $amount;
3622
3623     if ( !defined($credit) || $credit->credited == 0) {
3624       $credit = pop @credits or last;
3625     }
3626
3627     if ($cust_bill->owed >= $credit->credited) {
3628       $amount=$credit->credited;
3629     }else{
3630       $amount=$cust_bill->owed;
3631     }
3632
3633     my $cust_credit_bill = new FS::cust_credit_bill ( {
3634       'crednum' => $credit->crednum,
3635       'invnum'  => $cust_bill->invnum,
3636       'amount'  => $amount,
3637     } );
3638     my $error = $cust_credit_bill->insert;
3639     if ( $error ) {
3640       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3641       die $error;
3642     }
3643
3644     redo if ($cust_bill->owed > 0);
3645
3646   }
3647
3648   my $total_credited = $self->total_credited;
3649
3650   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3651
3652   return $total_credited;
3653 }
3654
3655 =item apply_payments
3656
3657 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
3658 to outstanding invoice balances in chronological order.
3659
3660  #and returns the value of any remaining unapplied payments.
3661
3662 Dies if there is an error.
3663
3664 =cut
3665
3666 sub apply_payments {
3667   my $self = shift;
3668
3669   local $SIG{HUP} = 'IGNORE';
3670   local $SIG{INT} = 'IGNORE';
3671   local $SIG{QUIT} = 'IGNORE';
3672   local $SIG{TERM} = 'IGNORE';
3673   local $SIG{TSTP} = 'IGNORE';
3674   local $SIG{PIPE} = 'IGNORE';
3675
3676   my $oldAutoCommit = $FS::UID::AutoCommit;
3677   local $FS::UID::AutoCommit = 0;
3678   my $dbh = dbh;
3679
3680   $self->select_for_update; #mutex
3681
3682   #return 0 unless
3683
3684   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
3685       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
3686
3687   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
3688       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
3689
3690   my $payment;
3691
3692   foreach my $cust_bill ( @invoices ) {
3693     my $amount;
3694
3695     if ( !defined($payment) || $payment->unapplied == 0 ) {
3696       $payment = pop @payments or last;
3697     }
3698
3699     if ( $cust_bill->owed >= $payment->unapplied ) {
3700       $amount = $payment->unapplied;
3701     } else {
3702       $amount = $cust_bill->owed;
3703     }
3704
3705     my $cust_bill_pay = new FS::cust_bill_pay ( {
3706       'paynum' => $payment->paynum,
3707       'invnum' => $cust_bill->invnum,
3708       'amount' => $amount,
3709     } );
3710     my $error = $cust_bill_pay->insert;
3711     if ( $error ) {
3712       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3713       die $error;
3714     }
3715
3716     redo if ( $cust_bill->owed > 0);
3717
3718   }
3719
3720   my $total_unapplied_payments = $self->total_unapplied_payments;
3721
3722   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3723
3724   return $total_unapplied_payments;
3725 }
3726
3727 =item total_credited
3728
3729 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3730 customer.  See L<FS::cust_credit/credited>.
3731
3732 =cut
3733
3734 sub total_credited {
3735   my $self = shift;
3736   my $total_credit = 0;
3737   foreach my $cust_credit ( qsearch('cust_credit', {
3738     'custnum' => $self->custnum,
3739   } ) ) {
3740     $total_credit += $cust_credit->credited;
3741   }
3742   sprintf( "%.2f", $total_credit );
3743 }
3744
3745 =item total_unapplied_payments
3746
3747 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3748 See L<FS::cust_pay/unapplied>.
3749
3750 =cut
3751
3752 sub total_unapplied_payments {
3753   my $self = shift;
3754   my $total_unapplied = 0;
3755   foreach my $cust_pay ( qsearch('cust_pay', {
3756     'custnum' => $self->custnum,
3757   } ) ) {
3758     $total_unapplied += $cust_pay->unapplied;
3759   }
3760   sprintf( "%.2f", $total_unapplied );
3761 }
3762
3763 =item balance
3764
3765 Returns the balance for this customer (total_owed minus total_credited
3766 minus total_unapplied_payments).
3767
3768 =cut
3769
3770 sub balance {
3771   my $self = shift;
3772   sprintf( "%.2f",
3773     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
3774   );
3775 }
3776
3777 =item balance_date TIME
3778
3779 Returns the balance for this customer, only considering invoices with date
3780 earlier than TIME (total_owed_date minus total_credited minus
3781 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3782 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3783 functions.
3784
3785 =cut
3786
3787 sub balance_date {
3788   my $self = shift;
3789   my $time = shift;
3790   sprintf( "%.2f",
3791     $self->total_owed_date($time)
3792       - $self->total_credited
3793       - $self->total_unapplied_payments
3794   );
3795 }
3796
3797 =item in_transit_payments
3798
3799 Returns the total of requests for payments for this customer pending in
3800 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3801
3802 =cut
3803
3804 sub in_transit_payments {
3805   my $self = shift;
3806   my $in_transit_payments = 0;
3807   foreach my $pay_batch ( qsearch('pay_batch', {
3808     'status' => 'I',
3809   } ) ) {
3810     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3811       'batchnum' => $pay_batch->batchnum,
3812       'custnum' => $self->custnum,
3813     } ) ) {
3814       $in_transit_payments += $cust_pay_batch->amount;
3815     }
3816   }
3817   sprintf( "%.2f", $in_transit_payments );
3818 }
3819
3820 =item paydate_monthyear
3821
3822 Returns a two-element list consisting of the month and year of this customer's
3823 paydate (credit card expiration date for CARD customers)
3824
3825 =cut
3826
3827 sub paydate_monthyear {
3828   my $self = shift;
3829   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3830     ( $2, $1 );
3831   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3832     ( $1, $3 );
3833   } else {
3834     ('', '');
3835   }
3836 }
3837
3838 =item invoicing_list [ ARRAYREF ]
3839
3840 If an arguement is given, sets these email addresses as invoice recipients
3841 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3842 (except as warnings), so use check_invoicing_list first.
3843
3844 Returns a list of email addresses (with svcnum entries expanded).
3845
3846 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3847 check it without disturbing anything by passing nothing.
3848
3849 This interface may change in the future.
3850
3851 =cut
3852
3853 sub invoicing_list {
3854   my( $self, $arrayref ) = @_;
3855
3856   if ( $arrayref ) {
3857     my @cust_main_invoice;
3858     if ( $self->custnum ) {
3859       @cust_main_invoice =
3860         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3861     } else {
3862       @cust_main_invoice = ();
3863     }
3864     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3865       #warn $cust_main_invoice->destnum;
3866       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3867         #warn $cust_main_invoice->destnum;
3868         my $error = $cust_main_invoice->delete;
3869         warn $error if $error;
3870       }
3871     }
3872     if ( $self->custnum ) {
3873       @cust_main_invoice =
3874         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3875     } else {
3876       @cust_main_invoice = ();
3877     }
3878     my %seen = map { $_->address => 1 } @cust_main_invoice;
3879     foreach my $address ( @{$arrayref} ) {
3880       next if exists $seen{$address} && $seen{$address};
3881       $seen{$address} = 1;
3882       my $cust_main_invoice = new FS::cust_main_invoice ( {
3883         'custnum' => $self->custnum,
3884         'dest'    => $address,
3885       } );
3886       my $error = $cust_main_invoice->insert;
3887       warn $error if $error;
3888     }
3889   }
3890
3891   if ( $self->custnum ) {
3892     map { $_->address }
3893       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3894   } else {
3895     ();
3896   }
3897
3898 }
3899
3900 =item check_invoicing_list ARRAYREF
3901
3902 Checks these arguements as valid input for the invoicing_list method.  If there
3903 is an error, returns the error, otherwise returns false.
3904
3905 =cut
3906
3907 sub check_invoicing_list {
3908   my( $self, $arrayref ) = @_;
3909
3910   foreach my $address ( @$arrayref ) {
3911
3912     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3913       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3914     }
3915
3916     my $cust_main_invoice = new FS::cust_main_invoice ( {
3917       'custnum' => $self->custnum,
3918       'dest'    => $address,
3919     } );
3920     my $error = $self->custnum
3921                 ? $cust_main_invoice->check
3922                 : $cust_main_invoice->checkdest
3923     ;
3924     return $error if $error;
3925
3926   }
3927
3928   return "Email address required"
3929     if $conf->exists('cust_main-require_invoicing_list_email')
3930     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3931
3932   '';
3933 }
3934
3935 =item set_default_invoicing_list
3936
3937 Sets the invoicing list to all accounts associated with this customer,
3938 overwriting any previous invoicing list.
3939
3940 =cut
3941
3942 sub set_default_invoicing_list {
3943   my $self = shift;
3944   $self->invoicing_list($self->all_emails);
3945 }
3946
3947 =item all_emails
3948
3949 Returns the email addresses of all accounts provisioned for this customer.
3950
3951 =cut
3952
3953 sub all_emails {
3954   my $self = shift;
3955   my %list;
3956   foreach my $cust_pkg ( $self->all_pkgs ) {
3957     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3958     my @svc_acct =
3959       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3960         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3961           @cust_svc;
3962     $list{$_}=1 foreach map { $_->email } @svc_acct;
3963   }
3964   keys %list;
3965 }
3966
3967 =item invoicing_list_addpost
3968
3969 Adds postal invoicing to this customer.  If this customer is already configured
3970 to receive postal invoices, does nothing.
3971
3972 =cut
3973
3974 sub invoicing_list_addpost {
3975   my $self = shift;
3976   return if grep { $_ eq 'POST' } $self->invoicing_list;
3977   my @invoicing_list = $self->invoicing_list;
3978   push @invoicing_list, 'POST';
3979   $self->invoicing_list(\@invoicing_list);
3980 }
3981
3982 =item invoicing_list_emailonly
3983
3984 Returns the list of email invoice recipients (invoicing_list without non-email
3985 destinations such as POST and FAX).
3986
3987 =cut
3988
3989 sub invoicing_list_emailonly {
3990   my $self = shift;
3991   warn "$me invoicing_list_emailonly called"
3992     if $DEBUG;
3993   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3994 }
3995
3996 =item invoicing_list_emailonly_scalar
3997
3998 Returns the list of email invoice recipients (invoicing_list without non-email
3999 destinations such as POST and FAX) as a comma-separated scalar.
4000
4001 =cut
4002
4003 sub invoicing_list_emailonly_scalar {
4004   my $self = shift;
4005   warn "$me invoicing_list_emailonly_scalar called"
4006     if $DEBUG;
4007   join(', ', $self->invoicing_list_emailonly);
4008 }
4009
4010 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4011
4012 Returns an array of customers referred by this customer (referral_custnum set
4013 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
4014 customers referred by customers referred by this customer and so on, inclusive.
4015 The default behavior is DEPTH 1 (no recursion).
4016
4017 =cut
4018
4019 sub referral_cust_main {
4020   my $self = shift;
4021   my $depth = @_ ? shift : 1;
4022   my $exclude = @_ ? shift : {};
4023
4024   my @cust_main =
4025     map { $exclude->{$_->custnum}++; $_; }
4026       grep { ! $exclude->{ $_->custnum } }
4027         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4028
4029   if ( $depth > 1 ) {
4030     push @cust_main,
4031       map { $_->referral_cust_main($depth-1, $exclude) }
4032         @cust_main;
4033   }
4034
4035   @cust_main;
4036 }
4037
4038 =item referral_cust_main_ncancelled
4039
4040 Same as referral_cust_main, except only returns customers with uncancelled
4041 packages.
4042
4043 =cut
4044
4045 sub referral_cust_main_ncancelled {
4046   my $self = shift;
4047   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4048 }
4049
4050 =item referral_cust_pkg [ DEPTH ]
4051
4052 Like referral_cust_main, except returns a flat list of all unsuspended (and
4053 uncancelled) packages for each customer.  The number of items in this list may
4054 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4055
4056 =cut
4057
4058 sub referral_cust_pkg {
4059   my $self = shift;
4060   my $depth = @_ ? shift : 1;
4061
4062   map { $_->unsuspended_pkgs }
4063     grep { $_->unsuspended_pkgs }
4064       $self->referral_cust_main($depth);
4065 }
4066
4067 =item referring_cust_main
4068
4069 Returns the single cust_main record for the customer who referred this customer
4070 (referral_custnum), or false.
4071
4072 =cut
4073
4074 sub referring_cust_main {
4075   my $self = shift;
4076   return '' unless $self->referral_custnum;
4077   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4078 }
4079
4080 =item credit AMOUNT, REASON
4081
4082 Applies a credit to this customer.  If there is an error, returns the error,
4083 otherwise returns false.
4084
4085 =cut
4086
4087 sub credit {
4088   my( $self, $amount, $reason, %options ) = @_;
4089   my $cust_credit = new FS::cust_credit {
4090     'custnum' => $self->custnum,
4091     'amount'  => $amount,
4092     'reason'  => $reason,
4093   };
4094   $cust_credit->insert(%options);
4095 }
4096
4097 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4098
4099 Creates a one-time charge for this customer.  If there is an error, returns
4100 the error, otherwise returns false.
4101
4102 =cut
4103
4104 sub charge {
4105   my $self = shift;
4106   my ( $amount, $pkg, $comment, $taxclass, $additional );
4107   if ( ref( $_[0] ) ) {
4108     $amount     = $_[0]->{amount};
4109     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4110     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4111                                            : '$'. sprintf("%.2f",$amount);
4112     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4113     $additional = $_[0]->{additional};
4114   }else{
4115     $amount     = shift;
4116     $pkg        = @_ ? shift : 'One-time charge';
4117     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4118     $taxclass   = @_ ? shift : '';
4119     $additional = [];
4120   }
4121
4122   local $SIG{HUP} = 'IGNORE';
4123   local $SIG{INT} = 'IGNORE';
4124   local $SIG{QUIT} = 'IGNORE';
4125   local $SIG{TERM} = 'IGNORE';
4126   local $SIG{TSTP} = 'IGNORE';
4127   local $SIG{PIPE} = 'IGNORE';
4128
4129   my $oldAutoCommit = $FS::UID::AutoCommit;
4130   local $FS::UID::AutoCommit = 0;
4131   my $dbh = dbh;
4132
4133   my $part_pkg = new FS::part_pkg ( {
4134     'pkg'      => $pkg,
4135     'comment'  => $comment,
4136     'plan'     => 'flat',
4137     'freq'     => 0,
4138     'disabled' => 'Y',
4139     'taxclass' => $taxclass,
4140   } );
4141
4142   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4143                         ( 0 .. @$additional - 1 )
4144                   ),
4145                   'additional_count' => scalar(@$additional),
4146                   'setup_fee' => $amount,
4147                 );
4148
4149   my $error = $part_pkg->insert( options => \%options );
4150   if ( $error ) {
4151     $dbh->rollback if $oldAutoCommit;
4152     return $error;
4153   }
4154
4155   my $pkgpart = $part_pkg->pkgpart;
4156   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4157   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4158     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4159     $error = $type_pkgs->insert;
4160     if ( $error ) {
4161       $dbh->rollback if $oldAutoCommit;
4162       return $error;
4163     }
4164   }
4165
4166   my $cust_pkg = new FS::cust_pkg ( {
4167     'custnum' => $self->custnum,
4168     'pkgpart' => $pkgpart,
4169   } );
4170
4171   $error = $cust_pkg->insert;
4172   if ( $error ) {
4173     $dbh->rollback if $oldAutoCommit;
4174     return $error;
4175   }
4176
4177   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4178   '';
4179
4180 }
4181
4182 =item cust_bill
4183
4184 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4185
4186 =cut
4187
4188 sub cust_bill {
4189   my $self = shift;
4190   sort { $a->_date <=> $b->_date }
4191     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4192 }
4193
4194 =item open_cust_bill
4195
4196 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4197 customer.
4198
4199 =cut
4200
4201 sub open_cust_bill {
4202   my $self = shift;
4203   grep { $_->owed > 0 } $self->cust_bill;
4204 }
4205
4206 =item cust_credit
4207
4208 Returns all the credits (see L<FS::cust_credit>) for this customer.
4209
4210 =cut
4211
4212 sub cust_credit {
4213   my $self = shift;
4214   sort { $a->_date <=> $b->_date }
4215     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4216 }
4217
4218 =item cust_pay
4219
4220 Returns all the payments (see L<FS::cust_pay>) for this customer.
4221
4222 =cut
4223
4224 sub cust_pay {
4225   my $self = shift;
4226   sort { $a->_date <=> $b->_date }
4227     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4228 }
4229
4230 =item cust_pay_void
4231
4232 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4233
4234 =cut
4235
4236 sub cust_pay_void {
4237   my $self = shift;
4238   sort { $a->_date <=> $b->_date }
4239     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4240 }
4241
4242
4243 =item cust_refund
4244
4245 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4246
4247 =cut
4248
4249 sub cust_refund {
4250   my $self = shift;
4251   sort { $a->_date <=> $b->_date }
4252     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4253 }
4254
4255 =item name
4256
4257 Returns a name string for this customer, either "Company (Last, First)" or
4258 "Last, First".
4259
4260 =cut
4261
4262 sub name {
4263   my $self = shift;
4264   my $name = $self->contact;
4265   $name = $self->company. " ($name)" if $self->company;
4266   $name;
4267 }
4268
4269 =item ship_name
4270
4271 Returns a name string for this (service/shipping) contact, either
4272 "Company (Last, First)" or "Last, First".
4273
4274 =cut
4275
4276 sub ship_name {
4277   my $self = shift;
4278   if ( $self->get('ship_last') ) {
4279     my $name = $self->ship_contact;
4280     $name = $self->ship_company. " ($name)" if $self->ship_company;
4281     $name;
4282   } else {
4283     $self->name;
4284   }
4285 }
4286
4287 =item contact
4288
4289 Returns this customer's full (billing) contact name only, "Last, First"
4290
4291 =cut
4292
4293 sub contact {
4294   my $self = shift;
4295   $self->get('last'). ', '. $self->first;
4296 }
4297
4298 =item ship_contact
4299
4300 Returns this customer's full (shipping) contact name only, "Last, First"
4301
4302 =cut
4303
4304 sub ship_contact {
4305   my $self = shift;
4306   $self->get('ship_last')
4307     ? $self->get('ship_last'). ', '. $self->ship_first
4308     : $self->contact;
4309 }
4310
4311 =item country_full
4312
4313 Returns this customer's full country name
4314
4315 =cut
4316
4317 sub country_full {
4318   my $self = shift;
4319   code2country($self->country);
4320 }
4321
4322 =item cust_status
4323
4324 =item status
4325
4326 Returns a status string for this customer, currently:
4327
4328 =over 4
4329
4330 =item prospect - No packages have ever been ordered
4331
4332 =item active - One or more recurring packages is active
4333
4334 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4335
4336 =item suspended - All non-cancelled recurring packages are suspended
4337
4338 =item cancelled - All recurring packages are cancelled
4339
4340 =back
4341
4342 =cut
4343
4344 sub status { shift->cust_status(@_); }
4345
4346 sub cust_status {
4347   my $self = shift;
4348   for my $status (qw( prospect active inactive suspended cancelled )) {
4349     my $method = $status.'_sql';
4350     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4351     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4352     $sth->execute( ($self->custnum) x $numnum )
4353       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4354     return $status if $sth->fetchrow_arrayref->[0];
4355   }
4356 }
4357
4358 =item ucfirst_cust_status
4359
4360 =item ucfirst_status
4361
4362 Returns the status with the first character capitalized.
4363
4364 =cut
4365
4366 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4367
4368 sub ucfirst_cust_status {
4369   my $self = shift;
4370   ucfirst($self->cust_status);
4371 }
4372
4373 =item statuscolor
4374
4375 Returns a hex triplet color string for this customer's status.
4376
4377 =cut
4378
4379 use vars qw(%statuscolor);
4380 %statuscolor = (
4381   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4382   'active'    => '00CC00', #green
4383   'inactive'  => '0000CC', #blue
4384   'suspended' => 'FF9900', #yellow
4385   'cancelled' => 'FF0000', #red
4386 );
4387
4388 sub statuscolor { shift->cust_statuscolor(@_); }
4389
4390 sub cust_statuscolor {
4391   my $self = shift;
4392   $statuscolor{$self->cust_status};
4393 }
4394
4395 =back
4396
4397 =head1 CLASS METHODS
4398
4399 =over 4
4400
4401 =item prospect_sql
4402
4403 Returns an SQL expression identifying prospective cust_main records (customers
4404 with no packages ever ordered)
4405
4406 =cut
4407
4408 use vars qw($select_count_pkgs);
4409 $select_count_pkgs =
4410   "SELECT COUNT(*) FROM cust_pkg
4411     WHERE cust_pkg.custnum = cust_main.custnum";
4412
4413 sub select_count_pkgs_sql {
4414   $select_count_pkgs;
4415 }
4416
4417 sub prospect_sql { "
4418   0 = ( $select_count_pkgs )
4419 "; }
4420
4421 =item active_sql
4422
4423 Returns an SQL expression identifying active cust_main records (customers with
4424 no active recurring packages, but otherwise unsuspended/uncancelled).
4425
4426 =cut
4427
4428 sub active_sql { "
4429   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
4430       )
4431 "; }
4432
4433 =item inactive_sql
4434
4435 Returns an SQL expression identifying inactive cust_main records (customers with
4436 active recurring packages).
4437
4438 =cut
4439
4440 sub inactive_sql { "
4441   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4442   AND
4443   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4444 "; }
4445
4446 =item susp_sql
4447 =item suspended_sql
4448
4449 Returns an SQL expression identifying suspended cust_main records.
4450
4451 =cut
4452
4453
4454 sub suspended_sql { susp_sql(@_); }
4455 sub susp_sql { "
4456     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
4457     AND
4458     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
4459 "; }
4460
4461 =item cancel_sql
4462 =item cancelled_sql
4463
4464 Returns an SQL expression identifying cancelled cust_main records.
4465
4466 =cut
4467
4468 sub cancelled_sql { cancel_sql(@_); }
4469 sub cancel_sql {
4470
4471   my $recurring_sql = FS::cust_pkg->recurring_sql;
4472   #my $recurring_sql = "
4473   #  '0' != ( select freq from part_pkg
4474   #             where cust_pkg.pkgpart = part_pkg.pkgpart )
4475   #";
4476
4477   "
4478     0 < ( $select_count_pkgs )
4479     AND 0 = ( $select_count_pkgs AND $recurring_sql
4480                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4481             )
4482   ";
4483 }
4484
4485 =item uncancel_sql
4486 =item uncancelled_sql
4487
4488 Returns an SQL expression identifying un-cancelled cust_main records.
4489
4490 =cut
4491
4492 sub uncancelled_sql { uncancel_sql(@_); }
4493 sub uncancel_sql { "
4494   ( 0 < ( $select_count_pkgs
4495                    AND ( cust_pkg.cancel IS NULL
4496                          OR cust_pkg.cancel = 0
4497                        )
4498         )
4499     OR 0 = ( $select_count_pkgs )
4500   )
4501 "; }
4502
4503 =item balance_sql
4504
4505 Returns an SQL fragment to retreive the balance.
4506
4507 =cut
4508
4509 sub balance_sql { "
4510     COALESCE( ( SELECT SUM(charged) FROM cust_bill
4511                   WHERE cust_bill.custnum   = cust_main.custnum ), 0)
4512   - COALESCE( ( SELECT SUM(paid)    FROM cust_pay
4513                   WHERE cust_pay.custnum    = cust_main.custnum ), 0)
4514   - COALESCE( ( SELECT SUM(amount)  FROM cust_credit
4515                   WHERE cust_credit.custnum = cust_main.custnum ), 0)
4516   + COALESCE( ( SELECT SUM(refund)  FROM cust_refund
4517                    WHERE cust_refund.custnum = cust_main.custnum ), 0)
4518 "; }
4519
4520 =item balance_date_sql TIME
4521
4522 Returns an SQL fragment to retreive the balance for this customer, only
4523 considering invoices with date earlier than TIME. (total_owed_date minus total_credited minus
4524 total_unapplied_payments).  TIME is specified as an SQL fragment or a numeric
4525 UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
4526 L<Date::Parse> for conversion functions.
4527
4528 =cut
4529
4530 sub balance_date_sql {
4531   my( $class, $time ) = @_;
4532
4533   my $owed_sql         = FS::cust_bill->owed_sql;
4534   my $unapp_refund_sql = FS::cust_refund->unapplied_sql;
4535   #my $unapp_credit_sql = FS::cust_credit->unapplied_sql;
4536   my $unapp_credit_sql = FS::cust_credit->credited_sql;
4537   my $unapp_pay_sql    = FS::cust_pay->unapplied_sql;
4538
4539   "
4540       COALESCE( ( SELECT SUM($owed_sql) FROM cust_bill
4541                     WHERE cust_bill.custnum   = cust_main.custnum
4542                       AND cust_bill._date    <= $time             )
4543                 ,0
4544               )
4545     + COALESCE( ( SELECT SUM($unapp_refund_sql) FROM cust_refund
4546                     WHERE cust_refund.custnum = cust_main.custnum )
4547                 ,0
4548               )
4549     - COALESCE( ( SELECT SUM($unapp_credit_sql) FROM cust_credit
4550                     WHERE cust_credit.custnum = cust_main.custnum )
4551                 ,0
4552               )
4553     - COALESCE( ( SELECT SUM($unapp_pay_sql) FROM cust_pay
4554                     WHERE cust_pay.custnum = cust_main.custnum )
4555                 ,0
4556               )
4557
4558   ";
4559
4560 }
4561
4562 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
4563
4564 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
4565 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
4566 appropriate ship_ field is also searched).
4567
4568 Additional options are the same as FS::Record::qsearch
4569
4570 =cut
4571
4572 sub fuzzy_search {
4573   my( $self, $fuzzy, $hash, @opt) = @_;
4574   #$self
4575   $hash ||= {};
4576   my @cust_main = ();
4577
4578   check_and_rebuild_fuzzyfiles();
4579   foreach my $field ( keys %$fuzzy ) {
4580
4581     my $all = $self->all_X($field);
4582     next unless scalar(@$all);
4583
4584     my %match = ();
4585     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
4586
4587     my @fcust = ();
4588     foreach ( keys %match ) {
4589       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
4590       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
4591     }
4592     my %fsaw = ();
4593     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
4594   }
4595
4596   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
4597   my %saw = ();
4598   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
4599
4600   @cust_main;
4601
4602 }
4603
4604 =item masked FIELD
4605
4606  Returns a masked version of the named field
4607
4608 =cut
4609
4610 sub masked {
4611   my ($self, $field) = @_;
4612
4613   # Show last four
4614
4615   'x'x(length($self->getfield($field))-4).
4616     substr($self->getfield($field), (length($self->getfield($field))-4));
4617
4618 }
4619
4620 =back
4621
4622 =head1 SUBROUTINES
4623
4624 =over 4
4625
4626 =item smart_search OPTION => VALUE ...
4627
4628 Accepts the following options: I<search>, the string to search for.  The string
4629 will be searched for as a customer number, phone number, name or company name,
4630 as an exact, or, in some cases, a substring or fuzzy match (see the source code
4631 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
4632 skip fuzzy matching when an exact match is found.
4633
4634 Any additional options are treated as an additional qualifier on the search
4635 (i.e. I<agentnum>).
4636
4637 Returns a (possibly empty) array of FS::cust_main objects.
4638
4639 =cut
4640
4641 sub smart_search {
4642   my %options = @_;
4643
4644   #here is the agent virtualization
4645   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
4646
4647   my @cust_main = ();
4648
4649   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
4650   my $search = delete $options{'search'};
4651   ( my $alphanum_search = $search ) =~ s/\W//g;
4652
4653   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
4654
4655     #false laziness w/Record::ut_phone
4656     my $phonen = "$1-$2-$3";
4657     $phonen .= " x$4" if $4;
4658
4659     push @cust_main, qsearch( {
4660       'table'   => 'cust_main',
4661       'hashref' => { %options },
4662       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4663                      ' ( '.
4664                          join(' OR ', map "$_ = '$phonen'",
4665                                           qw( daytime night fax
4666                                               ship_daytime ship_night ship_fax )
4667                              ).
4668                      ' ) '.
4669                      " AND $agentnums_sql", #agent virtualization
4670     } );
4671
4672     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
4673       #try looking for matches with extensions unless one was specified
4674
4675       push @cust_main, qsearch( {
4676         'table'   => 'cust_main',
4677         'hashref' => { %options },
4678         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
4679                        ' ( '.
4680                            join(' OR ', map "$_ LIKE '$phonen\%'",
4681                                             qw( daytime night
4682                                                 ship_daytime ship_night )
4683                                ).
4684                        ' ) '.
4685                        " AND $agentnums_sql", #agent virtualization
4686       } );
4687
4688     }
4689
4690   } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
4691                                            # (also try agent_custid)
4692                                            # (regex needs tweaking if your
4693                                            #  legacy cust numbers have letters)
4694
4695     push @cust_main, qsearch( {
4696       'table'     => 'cust_main',
4697       'hashref'   => { 'custnum' => $1, %options },
4698       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4699     } );
4700
4701     push @cust_main, qsearch( {
4702       'table'     => 'cust_main',
4703       'hashref'   => { 'agent_custid' => $1, %options },
4704       'extra_sql' => " AND $agentnums_sql", #agent virtualization
4705     } );
4706
4707   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
4708
4709     my($company, $last, $first) = ( $1, $2, $3 );
4710
4711     # "Company (Last, First)"
4712     #this is probably something a browser remembered,
4713     #so just do an exact search
4714
4715     foreach my $prefix ( '', 'ship_' ) {
4716       push @cust_main, qsearch( {
4717         'table'     => 'cust_main',
4718         'hashref'   => { $prefix.'first'   => $first,
4719                          $prefix.'last'    => $last,
4720                          $prefix.'company' => $company,
4721                          %options,
4722                        },
4723         'extra_sql' => " AND $agentnums_sql",
4724       } );
4725     }
4726
4727   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
4728                                               # try (ship_){last,company}
4729
4730     my $value = lc($1);
4731
4732     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
4733     # # full strings the browser remembers won't work
4734     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
4735
4736     use Lingua::EN::NameParse;
4737     my $NameParse = new Lingua::EN::NameParse(
4738              auto_clean     => 1,
4739              allow_reversed => 1,
4740     );
4741
4742     my($last, $first) = ( '', '' );
4743     #maybe disable this too and just rely on NameParse?
4744     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
4745
4746       ($last, $first) = ( $1, $2 );
4747
4748     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
4749     } elsif ( ! $NameParse->parse($value) ) {
4750
4751       my %name = $NameParse->components;
4752       $first = $name{'given_name_1'};
4753       $last  = $name{'surname_1'};
4754
4755     }
4756
4757     if ( $first && $last ) {
4758
4759       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
4760
4761       #exact
4762       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4763       $sql .= "
4764         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
4765            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
4766         )";
4767
4768       push @cust_main, qsearch( {
4769         'table'     => 'cust_main',
4770         'hashref'   => \%options,
4771         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4772       } );
4773
4774       # or it just be something that was typed in... (try that in a sec)
4775
4776     }
4777
4778     my $q_value = dbh->quote($value);
4779
4780     #exact
4781     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
4782     $sql .= " (    LOWER(last)         = $q_value
4783                 OR LOWER(company)      = $q_value
4784                 OR LOWER(ship_last)    = $q_value
4785                 OR LOWER(ship_company) = $q_value
4786               )";
4787
4788     push @cust_main, qsearch( {
4789       'table'     => 'cust_main',
4790       'hashref'   => \%options,
4791       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
4792     } );
4793
4794     #always do substring & fuzzy,
4795     #getting complains searches are not returning enough
4796     unless ( @cust_main && $skip_fuzzy ) {  #no exact match, trying substring/fuzzy
4797
4798       #still some false laziness w/ search/cust_main.cgi
4799
4800       #substring
4801
4802       my @hashrefs = (
4803         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
4804         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
4805       );
4806
4807       if ( $first && $last ) {
4808
4809         push @hashrefs,
4810           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
4811             'last'         => { op=>'ILIKE', value=>"%$last%" },
4812           },
4813           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
4814             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
4815           },
4816         ;
4817
4818       } else {
4819
4820         push @hashrefs,
4821           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
4822           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
4823         ;
4824       }
4825
4826       foreach my $hashref ( @hashrefs ) {
4827
4828         push @cust_main, qsearch( {
4829           'table'     => 'cust_main',
4830           'hashref'   => { %$hashref,
4831                            %options,
4832                          },
4833           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
4834         } );
4835
4836       }
4837
4838       #fuzzy
4839       my @fuzopts = (
4840         \%options,                #hashref
4841         '',                       #select
4842         " AND $agentnums_sql",    #extra_sql  #agent virtualization
4843       );
4844
4845       if ( $first && $last ) {
4846         push @cust_main, FS::cust_main->fuzzy_search(
4847           { 'last'   => $last,    #fuzzy hashref
4848             'first'  => $first }, #
4849           @fuzopts
4850         );
4851       }
4852       foreach my $field ( 'last', 'company' ) {
4853         push @cust_main,
4854           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
4855       }
4856
4857     }
4858
4859     #eliminate duplicates
4860     my %saw = ();
4861     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
4862
4863   }
4864
4865   @cust_main;
4866
4867 }
4868
4869 =item check_and_rebuild_fuzzyfiles
4870
4871 =cut
4872
4873 use vars qw(@fuzzyfields);
4874 @fuzzyfields = ( 'last', 'first', 'company' );
4875
4876 sub check_and_rebuild_fuzzyfiles {
4877   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4878   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
4879 }
4880
4881 =item rebuild_fuzzyfiles
4882
4883 =cut
4884
4885 sub rebuild_fuzzyfiles {
4886
4887   use Fcntl qw(:flock);
4888
4889   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4890   mkdir $dir, 0700 unless -d $dir;
4891
4892   foreach my $fuzzy ( @fuzzyfields ) {
4893
4894     open(LOCK,">>$dir/cust_main.$fuzzy")
4895       or die "can't open $dir/cust_main.$fuzzy: $!";
4896     flock(LOCK,LOCK_EX)
4897       or die "can't lock $dir/cust_main.$fuzzy: $!";
4898
4899     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
4900       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
4901
4902     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
4903       my $sth = dbh->prepare("SELECT $field FROM cust_main".
4904                              " WHERE $field != '' AND $field IS NOT NULL");
4905       $sth->execute or die $sth->errstr;
4906
4907       while ( my $row = $sth->fetchrow_arrayref ) {
4908         print CACHE $row->[0]. "\n";
4909       }
4910
4911     }
4912
4913     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
4914
4915     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
4916     close LOCK;
4917   }
4918
4919 }
4920
4921 =item all_X
4922
4923 =cut
4924
4925 sub all_X {
4926   my( $self, $field ) = @_;
4927   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4928   open(CACHE,"<$dir/cust_main.$field")
4929     or die "can't open $dir/cust_main.$field: $!";
4930   my @array = map { chomp; $_; } <CACHE>;
4931   close CACHE;
4932   \@array;
4933 }
4934
4935 =item append_fuzzyfiles LASTNAME COMPANY
4936
4937 =cut
4938
4939 sub append_fuzzyfiles {
4940   #my( $first, $last, $company ) = @_;
4941
4942   &check_and_rebuild_fuzzyfiles;
4943
4944   use Fcntl qw(:flock);
4945
4946   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
4947
4948   foreach my $field (qw( first last company )) {
4949     my $value = shift;
4950
4951     if ( $value ) {
4952
4953       open(CACHE,">>$dir/cust_main.$field")
4954         or die "can't open $dir/cust_main.$field: $!";
4955       flock(CACHE,LOCK_EX)
4956         or die "can't lock $dir/cust_main.$field: $!";
4957
4958       print CACHE "$value\n";
4959
4960       flock(CACHE,LOCK_UN)
4961         or die "can't unlock $dir/cust_main.$field: $!";
4962       close CACHE;
4963     }
4964
4965   }
4966
4967   1;
4968 }
4969
4970 =item batch_import
4971
4972 =cut
4973
4974 sub batch_import {
4975   my $param = shift;
4976   #warn join('-',keys %$param);
4977   my $fh = $param->{filehandle};
4978   my $agentnum = $param->{agentnum};
4979
4980   my $refnum = $param->{refnum};
4981   my $pkgpart = $param->{pkgpart};
4982
4983   #my @fields = @{$param->{fields}};
4984   my $format = $param->{'format'};
4985   my @fields;
4986   my $payby;
4987   if ( $format eq 'simple' ) {
4988     @fields = qw( cust_pkg.setup dayphone first last
4989                   address1 address2 city state zip comments );
4990     $payby = 'BILL';
4991   } elsif ( $format eq 'extended' ) {
4992     @fields = qw( agent_custid refnum
4993                   last first address1 address2 city state zip country
4994                   daytime night
4995                   ship_last ship_first ship_address1 ship_address2
4996                   ship_city ship_state ship_zip ship_country
4997                   payinfo paycvv paydate
4998                   invoicing_list
4999                   cust_pkg.pkgpart
5000                   svc_acct.username svc_acct._password
5001                 );
5002     $payby = 'BILL';
5003  } elsif ( $format eq 'extended-plus_company' ) {
5004     @fields = qw( agent_custid refnum
5005                   last first company address1 address2 city state zip country
5006                   daytime night
5007                   ship_last ship_first ship_company ship_address1 ship_address2
5008                   ship_city ship_state ship_zip ship_country
5009                   payinfo paycvv paydate
5010                   invoicing_list
5011                   cust_pkg.pkgpart
5012                   svc_acct.username svc_acct._password
5013                 );
5014     $payby = 'BILL';
5015   } else {
5016     die "unknown format $format";
5017   }
5018
5019   eval "use Text::CSV_XS;";
5020   die $@ if $@;
5021
5022   my $csv = new Text::CSV_XS;
5023   #warn $csv;
5024   #warn $fh;
5025
5026   my $imported = 0;
5027   #my $columns;
5028
5029   local $SIG{HUP} = 'IGNORE';
5030   local $SIG{INT} = 'IGNORE';
5031   local $SIG{QUIT} = 'IGNORE';
5032   local $SIG{TERM} = 'IGNORE';
5033   local $SIG{TSTP} = 'IGNORE';
5034   local $SIG{PIPE} = 'IGNORE';
5035
5036   my $oldAutoCommit = $FS::UID::AutoCommit;
5037   local $FS::UID::AutoCommit = 0;
5038   my $dbh = dbh;
5039
5040   #while ( $columns = $csv->getline($fh) ) {
5041   my $line;
5042   while ( defined($line=<$fh>) ) {
5043
5044     $csv->parse($line) or do {
5045       $dbh->rollback if $oldAutoCommit;
5046       return "can't parse: ". $csv->error_input();
5047     };
5048
5049     my @columns = $csv->fields();
5050     #warn join('-',@columns);
5051
5052     my %cust_main = (
5053       agentnum => $agentnum,
5054       refnum   => $refnum,
5055       country  => $conf->config('countrydefault') || 'US',
5056       payby    => $payby, #default
5057       paydate  => '12/2037', #default
5058     );
5059     my $billtime = time;
5060     my %cust_pkg = ( pkgpart => $pkgpart );
5061     my %svc_acct = ();
5062     foreach my $field ( @fields ) {
5063
5064       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
5065
5066         #$cust_pkg{$1} = str2time( shift @$columns );
5067         if ( $1 eq 'pkgpart' ) {
5068           $cust_pkg{$1} = shift @columns;
5069         } elsif ( $1 eq 'setup' ) {
5070           $billtime = str2time(shift @columns);
5071         } else {
5072           $cust_pkg{$1} = str2time( shift @columns );
5073         }
5074
5075       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
5076
5077         $svc_acct{$1} = shift @columns;
5078
5079       } else {
5080
5081         #refnum interception
5082         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
5083
5084           my $referral = $columns[0];
5085           my %hash = ( 'referral' => $referral,
5086                        'agentnum' => $agentnum,
5087                        'disabled' => '',
5088                      );
5089
5090           my $part_referral = qsearchs('part_referral', \%hash )
5091                               || new FS::part_referral \%hash;
5092
5093           unless ( $part_referral->refnum ) {
5094             my $error = $part_referral->insert;
5095             if ( $error ) {
5096               $dbh->rollback if $oldAutoCommit;
5097               return "can't auto-insert advertising source: $referral: $error";
5098             }
5099           }
5100
5101           $columns[0] = $part_referral->refnum;
5102         }
5103
5104         #$cust_main{$field} = shift @$columns;
5105         $cust_main{$field} = shift @columns;
5106       }
5107     }
5108
5109     $cust_main{'payby'} = 'CARD' if length($cust_main{'payinfo'});
5110
5111     my $invoicing_list = $cust_main{'invoicing_list'}
5112                            ? [ delete $cust_main{'invoicing_list'} ]
5113                            : [];
5114
5115     my $cust_main = new FS::cust_main ( \%cust_main );
5116
5117     use Tie::RefHash;
5118     tie my %hash, 'Tie::RefHash'; #this part is important
5119
5120     if ( $cust_pkg{'pkgpart'} ) {
5121       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
5122
5123       my @svc_acct = ();
5124       if ( $svc_acct{'username'} ) {
5125         my $part_pkg = $cust_pkg->part_pkg;
5126         unless ( $part_pkg ) {
5127           $dbh->rollback if $oldAutoCommit;
5128           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
5129         }
5130         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
5131         push @svc_acct, new FS::svc_acct ( \%svc_acct )
5132       }
5133
5134       $hash{$cust_pkg} = \@svc_acct;
5135     }
5136
5137     my $error = $cust_main->insert( \%hash, $invoicing_list );
5138
5139     if ( $error ) {
5140       $dbh->rollback if $oldAutoCommit;
5141       return "can't insert customer for $line: $error";
5142     }
5143
5144     if ( $format eq 'simple' ) {
5145
5146       #false laziness w/bill.cgi
5147       $error = $cust_main->bill( 'time' => $billtime );
5148       if ( $error ) {
5149         $dbh->rollback if $oldAutoCommit;
5150         return "can't bill customer for $line: $error";
5151       }
5152
5153       $error = $cust_main->apply_payments_and_credits;
5154       if ( $error ) {
5155         $dbh->rollback if $oldAutoCommit;
5156         return "can't bill customer for $line: $error";
5157       }
5158
5159       $error = $cust_main->collect();
5160       if ( $error ) {
5161         $dbh->rollback if $oldAutoCommit;
5162         return "can't collect customer for $line: $error";
5163       }
5164
5165     }
5166
5167     $imported++;
5168   }
5169
5170   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5171
5172   return "Empty file!" unless $imported;
5173
5174   ''; #no error
5175
5176 }
5177
5178 =item batch_charge
5179
5180 =cut
5181
5182 sub batch_charge {
5183   my $param = shift;
5184   #warn join('-',keys %$param);
5185   my $fh = $param->{filehandle};
5186   my @fields = @{$param->{fields}};
5187
5188   eval "use Text::CSV_XS;";
5189   die $@ if $@;
5190
5191   my $csv = new Text::CSV_XS;
5192   #warn $csv;
5193   #warn $fh;
5194
5195   my $imported = 0;
5196   #my $columns;
5197
5198   local $SIG{HUP} = 'IGNORE';
5199   local $SIG{INT} = 'IGNORE';
5200   local $SIG{QUIT} = 'IGNORE';
5201   local $SIG{TERM} = 'IGNORE';
5202   local $SIG{TSTP} = 'IGNORE';
5203   local $SIG{PIPE} = 'IGNORE';
5204
5205   my $oldAutoCommit = $FS::UID::AutoCommit;
5206   local $FS::UID::AutoCommit = 0;
5207   my $dbh = dbh;
5208
5209   #while ( $columns = $csv->getline($fh) ) {
5210   my $line;
5211   while ( defined($line=<$fh>) ) {
5212
5213     $csv->parse($line) or do {
5214       $dbh->rollback if $oldAutoCommit;
5215       return "can't parse: ". $csv->error_input();
5216     };
5217
5218     my @columns = $csv->fields();
5219     #warn join('-',@columns);
5220
5221     my %row = ();
5222     foreach my $field ( @fields ) {
5223       $row{$field} = shift @columns;
5224     }
5225
5226     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
5227     unless ( $cust_main ) {
5228       $dbh->rollback if $oldAutoCommit;
5229       return "unknown custnum $row{'custnum'}";
5230     }
5231
5232     if ( $row{'amount'} > 0 ) {
5233       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5234       if ( $error ) {
5235         $dbh->rollback if $oldAutoCommit;
5236         return $error;
5237       }
5238       $imported++;
5239     } elsif ( $row{'amount'} < 0 ) {
5240       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5241                                       $row{'pkg'}                         );
5242       if ( $error ) {
5243         $dbh->rollback if $oldAutoCommit;
5244         return $error;
5245       }
5246       $imported++;
5247     } else {
5248       #hmm?
5249     }
5250
5251   }
5252
5253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5254
5255   return "Empty file!" unless $imported;
5256
5257   ''; #no error
5258
5259 }
5260
5261 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5262
5263 Sends a templated email notification to the customer (see L<Text::Template>).
5264
5265 OPTIONS is a hash and may include
5266
5267 I<from> - the email sender (default is invoice_from)
5268
5269 I<to> - comma-separated scalar or arrayref of recipients
5270    (default is invoicing_list)
5271
5272 I<subject> - The subject line of the sent email notification
5273    (default is "Notice from company_name")
5274
5275 I<extra_fields> - a hashref of name/value pairs which will be substituted
5276    into the template
5277
5278 The following variables are vavailable in the template.
5279
5280 I<$first> - the customer first name
5281 I<$last> - the customer last name
5282 I<$company> - the customer company
5283 I<$payby> - a description of the method of payment for the customer
5284             # would be nice to use FS::payby::shortname
5285 I<$payinfo> - the account information used to collect for this customer
5286 I<$expdate> - the expiration of the customer payment in seconds from epoch
5287
5288 =cut
5289
5290 sub notify {
5291   my ($customer, $template, %options) = @_;
5292
5293   return unless $conf->exists($template);
5294
5295   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
5296   $from = $options{from} if exists($options{from});
5297
5298   my $to = join(',', $customer->invoicing_list_emailonly);
5299   $to = $options{to} if exists($options{to});
5300
5301   my $subject = "Notice from " . $conf->config('company_name')
5302     if $conf->exists('company_name');
5303   $subject = $options{subject} if exists($options{subject});
5304
5305   my $notify_template = new Text::Template (TYPE => 'ARRAY',
5306                                             SOURCE => [ map "$_\n",
5307                                               $conf->config($template)]
5308                                            )
5309     or die "can't create new Text::Template object: Text::Template::ERROR";
5310   $notify_template->compile()
5311     or die "can't compile template: Text::Template::ERROR";
5312
5313   my $paydate = $customer->paydate || '2037-12-31';
5314   $FS::notify_template::_template::first = $customer->first;
5315   $FS::notify_template::_template::last = $customer->last;
5316   $FS::notify_template::_template::company = $customer->company;
5317   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
5318   my $payby = $customer->payby;
5319   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5320   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5321
5322   #credit cards expire at the end of the month/year of their exp date
5323   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5324     $FS::notify_template::_template::payby = 'credit card';
5325     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5326     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5327     $expire_time--;
5328   }elsif ($payby eq 'COMP') {
5329     $FS::notify_template::_template::payby = 'complimentary account';
5330   }else{
5331     $FS::notify_template::_template::payby = 'current method';
5332   }
5333   $FS::notify_template::_template::expdate = $expire_time;
5334
5335   for (keys %{$options{extra_fields}}){
5336     no strict "refs";
5337     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5338   }
5339
5340   send_email(from => $from,
5341              to => $to,
5342              subject => $subject,
5343              body => $notify_template->fill_in( PACKAGE =>
5344                                                 'FS::notify_template::_template'                                              ),
5345             );
5346
5347 }
5348
5349 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5350
5351 Generates a templated notification to the customer (see L<Text::Template>).
5352
5353 OPTIONS is a hash and may include
5354
5355 I<extra_fields> - a hashref of name/value pairs which will be substituted
5356    into the template.  These values may override values mentioned below
5357    and those from the customer record.
5358
5359 The following variables are available in the template instead of or in addition
5360 to the fields of the customer record.
5361
5362 I<$payby> - a description of the method of payment for the customer
5363             # would be nice to use FS::payby::shortname
5364 I<$payinfo> - the masked account information used to collect for this customer
5365 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5366 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress
5367
5368 =cut
5369
5370 sub generate_letter {
5371   my ($self, $template, %options) = @_;
5372
5373   return unless $conf->exists($template);
5374
5375   my $letter_template = new Text::Template
5376                         ( TYPE       => 'ARRAY',
5377                           SOURCE     => [ map "$_\n", $conf->config($template)],
5378                           DELIMITERS => [ '[@--', '--@]' ],
5379                         )
5380     or die "can't create new Text::Template object: Text::Template::ERROR";
5381
5382   $letter_template->compile()
5383     or die "can't compile template: Text::Template::ERROR";
5384
5385   my %letter_data = map { $_ => $self->$_ } $self->fields;
5386   $letter_data{payinfo} = $self->mask_payinfo;
5387
5388   my $paydate = $self->paydate || '2037-12-31';
5389   my $payby = $self->payby;
5390   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5391   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5392
5393   #credit cards expire at the end of the month/year of their exp date
5394   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5395     $letter_data{payby} = 'credit card';
5396     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5397     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5398     $expire_time--;
5399   }elsif ($payby eq 'COMP') {
5400     $letter_data{payby} = 'complimentary account';
5401   }else{
5402     $letter_data{payby} = 'current method';
5403   }
5404   $letter_data{expdate} = $expire_time;
5405
5406   for (keys %{$options{extra_fields}}){
5407     $letter_data{$_} = $options{extra_fields}->{$_};
5408   }
5409
5410   unless(exists($letter_data{returnaddress})){
5411     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5412                                                   $self->_agent_template)
5413                      );
5414
5415     $letter_data{returnaddress} = length($retadd) ? $retadd : '~';
5416   }
5417
5418   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5419
5420   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
5421   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5422                            DIR      => $dir,
5423                            SUFFIX   => '.tex',
5424                            UNLINK   => 0,
5425                          ) or die "can't open temp file: $!\n";
5426
5427   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5428   close $fh;
5429   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5430   return $1;
5431 }
5432
5433 =item print_ps TEMPLATE
5434
5435 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5436
5437 =cut
5438
5439 sub print_ps {
5440   my $self = shift;
5441   my $file = $self->generate_letter(@_);
5442   FS::Misc::generate_ps($file);
5443 }
5444
5445 =item print TEMPLATE
5446
5447 Prints the filled in template.
5448
5449 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5450
5451 =cut
5452
5453 sub queueable_print {
5454   my %opt = @_;
5455
5456   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5457     or die "invalid customer number: " . $opt{custvnum};
5458
5459   my $error = $self->print( $opt{template} );
5460   die $error if $error;
5461 }
5462
5463 sub print {
5464   my ($self, $template) = (shift, shift);
5465   do_print [ $self->print_ps($template) ];
5466 }
5467
5468 sub agent_template {
5469   my $self = shift;
5470   $self->_agent_plandata('agent_templatename');
5471 }
5472
5473 sub agent_invoice_from {
5474   my $self = shift;
5475   $self->_agent_plandata('agent_invoice_from');
5476 }
5477
5478 sub _agent_plandata {
5479   my( $self, $option ) = @_;
5480
5481   my $regexp = '';
5482   if ( driver_name =~ /^Pg/i ) {
5483     $regexp = '~';
5484   } elsif ( driver_name =~ /^mysql/i ) {
5485     $regexp = 'REGEXP';
5486   } else {
5487     die "don't know how to use regular expressions in ". driver_name. " databases";
5488   }
5489
5490   my $part_bill_event = qsearchs( 'part_bill_event',
5491     {
5492       'payby'     => $self->payby,
5493       'plan'      => 'send_agent',
5494       'plandata'  => { 'op'    => $regexp,
5495                        'value' => "(^|\n)agentnum ".
5496                                    '([0-9]*, )*'.
5497                                   $self->agentnum.
5498                                    '(, [0-9]*)*'.
5499                                   "(\n|\$)",
5500                      },
5501     },
5502     '',
5503     'ORDER BY seconds LIMIT 1'
5504   );
5505
5506   return '' unless $part_bill_event;
5507
5508   if ( $part_bill_event->plandata =~ /^$option (.*)$/m ) {
5509     return $1;
5510   } else {
5511     warn "can't parse part_bill_event eventpart#". $part_bill_event->eventpart.
5512          " plandata for $option";
5513     return '';
5514   }
5515
5516 }
5517
5518 =back
5519
5520 =head1 BUGS
5521
5522 The delete method.
5523
5524 The delete method should possibly take an FS::cust_main object reference
5525 instead of a scalar customer number.
5526
5527 Bill and collect options should probably be passed as references instead of a
5528 list.
5529
5530 There should probably be a configuration file with a list of allowed credit
5531 card types.
5532
5533 No multiple currency support (probably a larger project than just this module).
5534
5535 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5536
5537 Birthdates rely on negative epoch values.
5538
5539 The payby for card/check batches is broken.  With mixed batching, bad
5540 things will happen.
5541
5542 =head1 SEE ALSO
5543
5544 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5545 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5546 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5547
5548 =cut
5549
5550 1;
5551