FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import @encrypted_fields);
   5 use vars qw( $realtime_bop_decline_quiet ); #ugh
   6 use Safe;
   7 use Carp;
   8 use Exporter;
   9 BEGIN {
  10   eval "use Time::Local;";
  11   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  12     if $] < 5.006 && !defined($Time::Local::VERSION);
  13   #eval "use Time::Local qw(timelocal timelocal_nocheck);";
  14   eval "use Time::Local qw(timelocal_nocheck);";
  15 }
  16 use Date::Format;
  17 #use Date::Manip;
  18 use String::Approx qw(amatch);
  19 use Business::CreditCard;
  20 use FS::UID qw( getotaker dbh );
  21 use FS::Record qw( qsearchs qsearch dbdef );
  22 use FS::Misc qw( send_email );
  23 use FS::cust_pkg;
  24 use FS::cust_svc;
  25 use FS::cust_bill;
  26 use FS::cust_bill_pkg;
  27 use FS::cust_pay;
  28 use FS::cust_pay_void;
  29 use FS::cust_credit;
  30 use FS::cust_refund;
  31 use FS::part_referral;
  32 use FS::cust_main_county;
  33 use FS::agent;
  34 use FS::cust_main_invoice;
  35 use FS::cust_credit_bill;
  36 use FS::cust_bill_pay;
  37 use FS::prepay_credit;
  38 use FS::queue;
  39 use FS::part_pkg;
  40 use FS::part_bill_event;
  41 use FS::cust_bill_event;
  42 use FS::cust_tax_exempt;
  43 use FS::type_pkgs;
  44 use FS::Msgcat qw(gettext);
  45
  46 @ISA = qw( FS::Record );
  47
  48 @EXPORT_OK = qw( smart_search );
  49
  50 $realtime_bop_decline_quiet = 0;
  51
  52 $DEBUG = 0;
  53 #$DEBUG = 1;
  54
  55 $import = 0;
  56
  57 @encrypted_fields = ('payinfo', 'paycvv');
  58
  59 #ask FS::UID to run this stuff for us later
  60 #$FS::UID::callback{'FS::cust_main'} = sub {
  61 install_callback FS::UID sub {
  62   $conf = new FS::Conf;
  63   #yes, need it for stuff below (prolly should be cached)
  64 };
  65
  66 sub _cache {
  67   my $self = shift;
  68   my ( $hashref, $cache ) = @_;
  69   if ( exists $hashref->{'pkgnum'} ) {
  70 #    #@{ $self->{'_pkgnum'} } = ();
  71     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  72     $self->{'_pkgnum'} = $subcache;
  73     #push @{ $self->{'_pkgnum'} },
  74     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  75   }
  76 }
  77
  78 =head1 NAME
  79
  80 FS::cust_main - Object methods for cust_main records
  81
  82 =head1 SYNOPSIS
  83
  84   use FS::cust_main;
  85
  86   $record = new FS::cust_main \%hash;
  87   $record = new FS::cust_main { 'column' => 'value' };
  88
  89   $error = $record->insert;
  90
  91   $error = $new_record->replace($old_record);
  92
  93   $error = $record->delete;
  94
  95   $error = $record->check;
  96
  97   @cust_pkg = $record->all_pkgs;
  98
  99   @cust_pkg = $record->ncancelled_pkgs;
 100
 101   @cust_pkg = $record->suspended_pkgs;
 102
 103   $error = $record->bill;
 104   $error = $record->bill %options;
 105   $error = $record->bill 'time' => $time;
 106
 107   $error = $record->collect;
 108   $error = $record->collect %options;
 109   $error = $record->collect 'invoice_time'   => $time,
 110                             'batch_card'     => 'yes',
 111                             'report_badcard' => 'yes',
 112                           ;
 113
 114 =head1 DESCRIPTION
 115
 116 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 117 FS::Record.  The following fields are currently supported:
 118
 119 =over 4
 120
 121 =item custnum - primary key (assigned automatically for new customers)
 122
 123 =item agentnum - agent (see L<FS::agent>)
 124
 125 =item refnum - Advertising source (see L<FS::part_referral>)
 126
 127 =item first - name
 128
 129 =item last - name
 130
 131 =item ss - social security number (optional)
 132
 133 =item company - (optional)
 134
 135 =item address1
 136
 137 =item address2 - (optional)
 138
 139 =item city
 140
 141 =item county - (optional, see L<FS::cust_main_county>)
 142
 143 =item state - (see L<FS::cust_main_county>)
 144
 145 =item zip
 146
 147 =item country - (see L<FS::cust_main_county>)
 148
 149 =item daytime - phone (optional)
 150
 151 =item night - phone (optional)
 152
 153 =item fax - phone (optional)
 154
 155 =item ship_first - name
 156
 157 =item ship_last - name
 158
 159 =item ship_company - (optional)
 160
 161 =item ship_address1
 162
 163 =item ship_address2 - (optional)
 164
 165 =item ship_city
 166
 167 =item ship_county - (optional, see L<FS::cust_main_county>)
 168
 169 =item ship_state - (see L<FS::cust_main_county>)
 170
 171 =item ship_zip
 172
 173 =item ship_country - (see L<FS::cust_main_county>)
 174
 175 =item ship_daytime - phone (optional)
 176
 177 =item ship_night - phone (optional)
 178
 179 =item ship_fax - phone (optional)
 180
 181 =item payby
 182
 183 I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
 184
 185 =item payinfo
 186
 187 Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 188
 189 =cut
 190
 191 sub payinfo {
 192   my($self,$payinfo) = @_;
 193   if ( defined($payinfo) ) {
 194     $self->paymask($payinfo);
 195     $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter'
 196   } else {
 197     $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter'
 198     return $payinfo;
 199   }
 200 }
 201
 202
 203 =item paycvv
 204
 205 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
 206
 207 =cut
 208
 209 =item paymask - Masked payment type
 210
 211 =over 4
 212
 213 =item Credit Cards
 214
 215 Mask all but the last four characters.
 216
 217 =item Checks
 218
 219 Mask all but last 2 of account number and bank routing number.
 220
 221 =item Others
 222
 223 Do nothing, return the unmasked string.
 224
 225 =back
 226
 227 =cut
 228
 229 sub paymask {
 230   my($self,$value)=@_;
 231
 232   # If it doesn't exist then generate it
 233   my $paymask=$self->getfield('paymask');
 234   if (!defined($value) && (!defined($paymask) || $paymask eq '')) {
 235     $value = $self->payinfo;
 236   }
 237
 238   if ( defined($value) && !$self->is_encrypted($value)) {
 239     my $payinfo = $value;
 240     my $payby = $self->payby;
 241     if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four)
 242       $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
 243     } elsif ($payby eq 'CHEK' ||
 244              $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank)
 245       my( $account, $aba ) = split('@', $payinfo );
 246       $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba;
 247     } else { # Tie up loose ends
 248       $paymask = $payinfo;
 249     }
 250     $self->setfield('paymask', $paymask); # This is okay since we are the 'setter'
 251   } elsif (defined($value) && $self->is_encrypted($value)) {
 252     $paymask = 'N/A';
 253   }
 254   return $paymask;
 255 }
 256
 257
 258
 259
 260 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 261
 262 =item payname - name on card or billing name
 263
 264 =item tax - tax exempt, empty or `Y'
 265
 266 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 267
 268 =item comments - comments (optional)
 269
 270 =item referral_custnum - referring customer number
 271
 272 =back
 273
 274 =head1 METHODS
 275
 276 =over 4
 277
 278 =item new HASHREF
 279
 280 Creates a new customer.  To add the customer to the database, see L<"insert">.
 281
 282 Note that this stores the hash reference, not a distinct copy of the hash it
 283 points to.  You can ask the object for a copy with the I<hash> method.
 284
 285 =cut
 286
 287 sub table { 'cust_main'; }
 288
 289 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 290
 291 Adds this customer to the database.  If there is an error, returns the error,
 292 otherwise returns false.
 293
 294 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 295 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 296 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 297 hash reference is equivalent to not supplying this parameter.  There should be
 298 a better explanation of this, but until then, here's an example:
 299
 300   use Tie::RefHash;
 301   tie %hash, 'Tie::RefHash'; #this part is important
 302   %hash = (
 303     $cust_pkg => [ $svc_acct ],
 304     ...
 305   );
 306   $cust_main->insert( \%hash );
 307
 308 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 309 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 310 expected and rollback the entire transaction; it is not necessary to call
 311 check_invoicing_list first.  The invoicing_list is set after the records in the
 312 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 313 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 314
 315   $cust_main->insert( {}, [ $email, 'POST' ] );
 316
 317 Currently available options are: I<depend_jobnum> and I<noexport>.
 318
 319 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 320 on the supplied jobnum (they will not run until the specific job completes).
 321 This can be used to defer provisioning until some action completes (such
 322 as running the customer's credit card sucessfully).
 323
 324 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 325 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 326 the B<reexport> method.)
 327
 328 =cut
 329
 330 sub insert {
 331   my $self = shift;
 332   my $cust_pkgs = @_ ? shift : {};
 333   my $invoicing_list = @_ ? shift : '';
 334   my %options = @_;
 335   warn "FS::cust_main::insert called with options ".
 336        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 337     if $DEBUG;
 338
 339   local $SIG{HUP} = 'IGNORE';
 340   local $SIG{INT} = 'IGNORE';
 341   local $SIG{QUIT} = 'IGNORE';
 342   local $SIG{TERM} = 'IGNORE';
 343   local $SIG{TSTP} = 'IGNORE';
 344   local $SIG{PIPE} = 'IGNORE';
 345
 346   my $oldAutoCommit = $FS::UID::AutoCommit;
 347   local $FS::UID::AutoCommit = 0;
 348   my $dbh = dbh;
 349
 350   my $prepay_credit = '';
 351   my $seconds = 0;
 352   if ( $self->payby eq 'PREPAY' ) {
 353     $self->payby('BILL');
 354     $prepay_credit = qsearchs(
 355       'prepay_credit',
 356       { 'identifier' => $self->payinfo },
 357       '',
 358       'FOR UPDATE'
 359     );
 360     unless ( $prepay_credit ) {
 361       $dbh->rollback if $oldAutoCommit;
 362       return "Invalid prepaid card: ". $self->payinfo;
 363     }
 364     $seconds = $prepay_credit->seconds;
 365     if ( $prepay_credit->agentnum ) {
 366       if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
 367         $dbh->rollback if $oldAutoCommit;
 368         return "prepaid card not valid for agent ". $self->agentnum;
 369       }
 370       $self->agentnum($prepay_credit->agentnum);
 371     }
 372     my $error = $prepay_credit->delete;
 373     if ( $error ) {
 374       $dbh->rollback if $oldAutoCommit;
 375       return "removing prepay_credit (transaction rolled back): $error";
 376     }
 377   }
 378
 379   my $error = $self->SUPER::insert;
 380   if ( $error ) {
 381     $dbh->rollback if $oldAutoCommit;
 382     #return "inserting cust_main record (transaction rolled back): $error";
 383     return $error;
 384   }
 385
 386   # invoicing list
 387   if ( $invoicing_list ) {
 388     $error = $self->check_invoicing_list( $invoicing_list );
 389     if ( $error ) {
 390       $dbh->rollback if $oldAutoCommit;
 391       return "checking invoicing_list (transaction rolled back): $error";
 392     }
 393     $self->invoicing_list( $invoicing_list );
 394   }
 395
 396   # packages
 397   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 398   if ( $error ) {
 399     $dbh->rollback if $oldAutoCommit;
 400     return $error;
 401   }
 402
 403   if ( $seconds ) {
 404     $dbh->rollback if $oldAutoCommit;
 405     return "No svc_acct record to apply pre-paid time";
 406   }
 407
 408   if ( $prepay_credit && $prepay_credit->amount ) {
 409     my $cust_pay = new FS::cust_pay {
 410       'custnum' => $self->custnum,
 411       'paid'    => $prepay_credit->amount,
 412       #'_date'   => #date the prepaid card was purchased???
 413       'payby'   => 'PREP',
 414       'payinfo' => $prepay_credit->identifier,
 415     };
 416     $error = $cust_pay->insert;
 417     if ( $error ) {
 418       $dbh->rollback if $oldAutoCommit;
 419       return "inserting prepayment (transaction rolled back): $error";
 420     }
 421   }
 422
 423   $error = $self->queue_fuzzyfiles_update;
 424   if ( $error ) {
 425     $dbh->rollback if $oldAutoCommit;
 426     return "updating fuzzy search cache: $error";
 427   }
 428
 429   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 430   '';
 431
 432 }
 433
 434 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 435
 436 Like the insert method on an existing record, this method orders a package
 437 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 438 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 439 be a better explanation of this, but until then, here's an example:
 440
 441   use Tie::RefHash;
 442   tie %hash, 'Tie::RefHash'; #this part is important
 443   %hash = (
 444     $cust_pkg => [ $svc_acct ],
 445     ...
 446   );
 447   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 448
 449 Services can be new, in which case they are inserted, or existing unaudited
 450 services, in which case they are linked to the newly-created package.
 451
 452 Currently available options are: I<depend_jobnum> and I<noexport>.
 453
 454 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 455 on the supplied jobnum (they will not run until the specific job completes).
 456 This can be used to defer provisioning until some action completes (such
 457 as running the customer's credit card sucessfully).
 458
 459 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 460 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 461 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 462 on the cust_main object is not recommended, as existing services will also be
 463 reexported.)
 464
 465 =cut
 466
 467 sub order_pkgs {
 468   my $self = shift;
 469   my $cust_pkgs = shift;
 470   my $seconds = shift;
 471   my %options = @_;
 472   my %svc_options = ();
 473   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 474     if exists $options{'depend_jobnum'};
 475   warn "FS::cust_main::order_pkgs called with options ".
 476        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 477     if $DEBUG;
 478
 479   local $SIG{HUP} = 'IGNORE';
 480   local $SIG{INT} = 'IGNORE';
 481   local $SIG{QUIT} = 'IGNORE';
 482   local $SIG{TERM} = 'IGNORE';
 483   local $SIG{TSTP} = 'IGNORE';
 484   local $SIG{PIPE} = 'IGNORE';
 485
 486   my $oldAutoCommit = $FS::UID::AutoCommit;
 487   local $FS::UID::AutoCommit = 0;
 488   my $dbh = dbh;
 489
 490   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 491
 492   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 493     $cust_pkg->custnum( $self->custnum );
 494     my $error = $cust_pkg->insert;
 495     if ( $error ) {
 496       $dbh->rollback if $oldAutoCommit;
 497       return "inserting cust_pkg (transaction rolled back): $error";
 498     }
 499     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 500       if ( $svc_something->svcnum ) {
 501         my $old_cust_svc = $svc_something->cust_svc;
 502         my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 503         $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 504         $error = $new_cust_svc->replace($old_cust_svc);
 505       } else {
 506         $svc_something->pkgnum( $cust_pkg->pkgnum );
 507         if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 508           $svc_something->seconds( $svc_something->seconds + $$seconds );
 509           $$seconds = 0;
 510         }
 511         $error = $svc_something->insert(%svc_options);
 512       }
 513       if ( $error ) {
 514         $dbh->rollback if $oldAutoCommit;
 515         #return "inserting svc_ (transaction rolled back): $error";
 516         return $error;
 517       }
 518     }
 519   }
 520
 521   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 522   ''; #no error
 523 }
 524
 525 =item reexport
 526
 527 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 528 order_pkgs methods for a better way to defer provisioning.
 529
 530 Re-schedules all exports by calling the B<reexport> method of all associated
 531 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 532 otherwise returns false.
 533
 534 =cut
 535
 536 sub reexport {
 537   my $self = shift;
 538
 539   carp "warning: FS::cust_main::reexport is deprectated; ".
 540        "use the depend_jobnum option to insert or order_pkgs to delay export";
 541
 542   local $SIG{HUP} = 'IGNORE';
 543   local $SIG{INT} = 'IGNORE';
 544   local $SIG{QUIT} = 'IGNORE';
 545   local $SIG{TERM} = 'IGNORE';
 546   local $SIG{TSTP} = 'IGNORE';
 547   local $SIG{PIPE} = 'IGNORE';
 548
 549   my $oldAutoCommit = $FS::UID::AutoCommit;
 550   local $FS::UID::AutoCommit = 0;
 551   my $dbh = dbh;
 552
 553   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 554     my $error = $cust_pkg->reexport;
 555     if ( $error ) {
 556       $dbh->rollback if $oldAutoCommit;
 557       return $error;
 558     }
 559   }
 560
 561   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 562   '';
 563
 564 }
 565
 566 =item delete NEW_CUSTNUM
 567
 568 This deletes the customer.  If there is an error, returns the error, otherwise
 569 returns false.
 570
 571 This will completely remove all traces of the customer record.  This is not
 572 what you want when a customer cancels service; for that, cancel all of the
 573 customer's packages (see L</cancel>).
 574
 575 If the customer has any uncancelled packages, you need to pass a new (valid)
 576 customer number for those packages to be transferred to.  Cancelled packages
 577 will be deleted.  Did I mention that this is NOT what you want when a customer
 578 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 579
 580 You can't delete a customer with invoices (see L<FS::cust_bill>),
 581 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 582 refunds (see L<FS::cust_refund>).
 583
 584 =cut
 585
 586 sub delete {
 587   my $self = shift;
 588
 589   local $SIG{HUP} = 'IGNORE';
 590   local $SIG{INT} = 'IGNORE';
 591   local $SIG{QUIT} = 'IGNORE';
 592   local $SIG{TERM} = 'IGNORE';
 593   local $SIG{TSTP} = 'IGNORE';
 594   local $SIG{PIPE} = 'IGNORE';
 595
 596   my $oldAutoCommit = $FS::UID::AutoCommit;
 597   local $FS::UID::AutoCommit = 0;
 598   my $dbh = dbh;
 599
 600   if ( $self->cust_bill ) {
 601     $dbh->rollback if $oldAutoCommit;
 602     return "Can't delete a customer with invoices";
 603   }
 604   if ( $self->cust_credit ) {
 605     $dbh->rollback if $oldAutoCommit;
 606     return "Can't delete a customer with credits";
 607   }
 608   if ( $self->cust_pay ) {
 609     $dbh->rollback if $oldAutoCommit;
 610     return "Can't delete a customer with payments";
 611   }
 612   if ( $self->cust_refund ) {
 613     $dbh->rollback if $oldAutoCommit;
 614     return "Can't delete a customer with refunds";
 615   }
 616
 617   my @cust_pkg = $self->ncancelled_pkgs;
 618   if ( @cust_pkg ) {
 619     my $new_custnum = shift;
 620     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 621       $dbh->rollback if $oldAutoCommit;
 622       return "Invalid new customer number: $new_custnum";
 623     }
 624     foreach my $cust_pkg ( @cust_pkg ) {
 625       my %hash = $cust_pkg->hash;
 626       $hash{'custnum'} = $new_custnum;
 627       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 628       my $error = $new_cust_pkg->replace($cust_pkg);
 629       if ( $error ) {
 630         $dbh->rollback if $oldAutoCommit;
 631         return $error;
 632       }
 633     }
 634   }
 635   my @cancelled_cust_pkg = $self->all_pkgs;
 636   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 637     my $error = $cust_pkg->delete;
 638     if ( $error ) {
 639       $dbh->rollback if $oldAutoCommit;
 640       return $error;
 641     }
 642   }
 643
 644   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 645     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 646   ) {
 647     my $error = $cust_main_invoice->delete;
 648     if ( $error ) {
 649       $dbh->rollback if $oldAutoCommit;
 650       return $error;
 651     }
 652   }
 653
 654   my $error = $self->SUPER::delete;
 655   if ( $error ) {
 656     $dbh->rollback if $oldAutoCommit;
 657     return $error;
 658   }
 659
 660   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 661   '';
 662
 663 }
 664
 665 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 666
 667 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 668 returns the error, otherwise returns false.
 669
 670 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 671 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 672 expected and rollback the entire transaction; it is not necessary to call
 673 check_invoicing_list first.  Here's an example:
 674
 675   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 676
 677 =cut
 678
 679 sub replace {
 680   my $self = shift;
 681   my $old = shift;
 682   my @param = @_;
 683
 684   local $SIG{HUP} = 'IGNORE';
 685   local $SIG{INT} = 'IGNORE';
 686   local $SIG{QUIT} = 'IGNORE';
 687   local $SIG{TERM} = 'IGNORE';
 688   local $SIG{TSTP} = 'IGNORE';
 689   local $SIG{PIPE} = 'IGNORE';
 690
 691   # If the mask is blank then try to set it - if we can...
 692   if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') {
 693     $self->paymask($self->payinfo);
 694   }
 695
 696   # We absolutely have to have an old vs. new record to make this work.
 697   if (!defined($old)) {
 698     $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 699   }
 700
 701   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 702        && $conf->config('users-allow_comp')                  ) {
 703     return "You are not permitted to create complimentary accounts."
 704       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 705   }
 706
 707   my $oldAutoCommit = $FS::UID::AutoCommit;
 708   local $FS::UID::AutoCommit = 0;
 709   my $dbh = dbh;
 710
 711   my $error = $self->SUPER::replace($old);
 712
 713   if ( $error ) {
 714     $dbh->rollback if $oldAutoCommit;
 715     return $error;
 716   }
 717
 718   if ( @param ) { # INVOICING_LIST_ARYREF
 719     my $invoicing_list = shift @param;
 720     $error = $self->check_invoicing_list( $invoicing_list );
 721     if ( $error ) {
 722       $dbh->rollback if $oldAutoCommit;
 723       return $error;
 724     }
 725     $self->invoicing_list( $invoicing_list );
 726   }
 727
 728   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 729        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 730     # card/check/lec info has changed, want to retry realtime_ invoice events
 731     my $error = $self->retry_realtime;
 732     if ( $error ) {
 733       $dbh->rollback if $oldAutoCommit;
 734       return $error;
 735     }
 736   }
 737
 738   $error = $self->queue_fuzzyfiles_update;
 739   if ( $error ) {
 740     $dbh->rollback if $oldAutoCommit;
 741     return "updating fuzzy search cache: $error";
 742   }
 743
 744   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 745   '';
 746
 747 }
 748
 749 =item queue_fuzzyfiles_update
 750
 751 Used by insert & replace to update the fuzzy search cache
 752
 753 =cut
 754
 755 sub queue_fuzzyfiles_update {
 756   my $self = shift;
 757
 758   local $SIG{HUP} = 'IGNORE';
 759   local $SIG{INT} = 'IGNORE';
 760   local $SIG{QUIT} = 'IGNORE';
 761   local $SIG{TERM} = 'IGNORE';
 762   local $SIG{TSTP} = 'IGNORE';
 763   local $SIG{PIPE} = 'IGNORE';
 764
 765   my $oldAutoCommit = $FS::UID::AutoCommit;
 766   local $FS::UID::AutoCommit = 0;
 767   my $dbh = dbh;
 768
 769   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 770   my $error = $queue->insert($self->getfield('last'), $self->company);
 771   if ( $error ) {
 772     $dbh->rollback if $oldAutoCommit;
 773     return "queueing job (transaction rolled back): $error";
 774   }
 775
 776   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 777     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 778     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
 779     if ( $error ) {
 780       $dbh->rollback if $oldAutoCommit;
 781       return "queueing job (transaction rolled back): $error";
 782     }
 783   }
 784
 785   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 786   '';
 787
 788 }
 789
 790 =item check
 791
 792 Checks all fields to make sure this is a valid customer record.  If there is
 793 an error, returns the error, otherwise returns false.  Called by the insert
 794 and replace methods.
 795
 796 =cut
 797
 798 sub check {
 799   my $self = shift;
 800
 801   #warn "BEFORE: \n". $self->_dump;
 802
 803   my $error =
 804     $self->ut_numbern('custnum')
 805     || $self->ut_number('agentnum')
 806     || $self->ut_number('refnum')
 807     || $self->ut_name('last')
 808     || $self->ut_name('first')
 809     || $self->ut_textn('company')
 810     || $self->ut_text('address1')
 811     || $self->ut_textn('address2')
 812     || $self->ut_text('city')
 813     || $self->ut_textn('county')
 814     || $self->ut_textn('state')
 815     || $self->ut_country('country')
 816     || $self->ut_anything('comments')
 817     || $self->ut_numbern('referral_custnum')
 818   ;
 819   #barf.  need message catalogs.  i18n.  etc.
 820   $error .= "Please select an advertising source."
 821     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 822   return $error if $error;
 823
 824   return "Unknown agent"
 825     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 826
 827   return "Unknown refnum"
 828     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 829
 830   return "Unknown referring custnum ". $self->referral_custnum
 831     unless ! $self->referral_custnum
 832            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 833
 834   if ( $self->ss eq '' ) {
 835     $self->ss('');
 836   } else {
 837     my $ss = $self->ss;
 838     $ss =~ s/\D//g;
 839     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 840       or return "Illegal social security number: ". $self->ss;
 841     $self->ss("$1-$2-$3");
 842   }
 843
 844
 845 # bad idea to disable, causes billing to fail because of no tax rates later
 846 #  unless ( $import ) {
 847     unless ( qsearch('cust_main_county', {
 848       'country' => $self->country,
 849       'state'   => '',
 850      } ) ) {
 851       return "Unknown state/county/country: ".
 852         $self->state. "/". $self->county. "/". $self->country
 853         unless qsearch('cust_main_county',{
 854           'state'   => $self->state,
 855           'county'  => $self->county,
 856           'country' => $self->country,
 857         } );
 858     }
 859 #  }
 860
 861   $error =
 862     $self->ut_phonen('daytime', $self->country)
 863     || $self->ut_phonen('night', $self->country)
 864     || $self->ut_phonen('fax', $self->country)
 865     || $self->ut_zip('zip', $self->country)
 866   ;
 867   return $error if $error;
 868
 869   my @addfields = qw(
 870     last first company address1 address2 city county state zip
 871     country daytime night fax
 872   );
 873
 874   if ( defined $self->dbdef_table->column('ship_last') ) {
 875     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 876                        @addfields )
 877          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 878        )
 879     {
 880       my $error =
 881         $self->ut_name('ship_last')
 882         || $self->ut_name('ship_first')
 883         || $self->ut_textn('ship_company')
 884         || $self->ut_text('ship_address1')
 885         || $self->ut_textn('ship_address2')
 886         || $self->ut_text('ship_city')
 887         || $self->ut_textn('ship_county')
 888         || $self->ut_textn('ship_state')
 889         || $self->ut_country('ship_country')
 890       ;
 891       return $error if $error;
 892
 893       #false laziness with above
 894       unless ( qsearchs('cust_main_county', {
 895         'country' => $self->ship_country,
 896         'state'   => '',
 897        } ) ) {
 898         return "Unknown ship_state/ship_county/ship_country: ".
 899           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 900           unless qsearchs('cust_main_county',{
 901             'state'   => $self->ship_state,
 902             'county'  => $self->ship_county,
 903             'country' => $self->ship_country,
 904           } );
 905       }
 906       #eofalse
 907
 908       $error =
 909         $self->ut_phonen('ship_daytime', $self->ship_country)
 910         || $self->ut_phonen('ship_night', $self->ship_country)
 911         || $self->ut_phonen('ship_fax', $self->ship_country)
 912         || $self->ut_zip('ship_zip', $self->ship_country)
 913       ;
 914       return $error if $error;
 915
 916     } else { # ship_ info eq billing info, so don't store dup info in database
 917       $self->setfield("ship_$_", '')
 918         foreach qw( last first company address1 address2 city county state zip
 919                     country daytime night fax );
 920     }
 921   }
 922
 923   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
 924     or return "Illegal payby: ". $self->payby;
 925
 926   # If it is encrypted and the private key is not availaible then we can't
 927   # check the credit card.
 928
 929   my $check_payinfo = 1;
 930
 931   if ($self->is_encrypted($self->payinfo)) {
 932     $check_payinfo = 0;
 933   }
 934
 935   $self->payby($1);
 936
 937   if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) {
 938
 939     my $payinfo = $self->payinfo;
 940     $payinfo =~ s/\D//g;
 941     $payinfo =~ /^(\d{13,16})$/
 942       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 943     $payinfo = $1;
 944     $self->payinfo($payinfo);
 945     validate($payinfo)
 946       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 947     return gettext('unknown_card_type')
 948       if cardtype($self->payinfo) eq "Unknown";
 949     if ( defined $self->dbdef_table->column('paycvv') ) {
 950       if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
 951         if ( cardtype($self->payinfo) eq 'American Express card' ) {
 952           $self->paycvv =~ /^(\d{4})$/
 953             or return "CVV2 (CID) for American Express cards is four digits.";
 954           $self->paycvv($1);
 955         } else {
 956           $self->paycvv =~ /^(\d{3})$/
 957             or return "CVV2 (CVC2/CID) is three digits.";
 958           $self->paycvv($1);
 959         }
 960       } else {
 961         $self->paycvv('');
 962       }
 963     }
 964
 965   } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) {
 966
 967     my $payinfo = $self->payinfo;
 968     $payinfo =~ s/[^\d\@]//g;
 969     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 970     $payinfo = "$1\@$2";
 971     $self->payinfo($payinfo);
 972     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 973
 974   } elsif ( $self->payby eq 'LECB' ) {
 975
 976     my $payinfo = $self->payinfo;
 977     $payinfo =~ s/\D//g;
 978     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 979     $payinfo = $1;
 980     $self->payinfo($payinfo);
 981     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 982
 983   } elsif ( $self->payby eq 'BILL' ) {
 984
 985     $error = $self->ut_textn('payinfo');
 986     return "Illegal P.O. number: ". $self->payinfo if $error;
 987     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 988
 989   } elsif ( $self->payby eq 'COMP' ) {
 990
 991     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 992       return "You are not permitted to create complimentary accounts."
 993         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 994     }
 995
 996     $error = $self->ut_textn('payinfo');
 997     return "Illegal comp account issuer: ". $self->payinfo if $error;
 998     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 999
1000   } elsif ( $self->payby eq 'PREPAY' ) {
1001
1002     my $payinfo = $self->payinfo;
1003     $payinfo =~ s/\W//g; #anything else would just confuse things
1004     $self->payinfo($payinfo);
1005     $error = $self->ut_alpha('payinfo');
1006     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1007     return "Unknown prepayment identifier"
1008       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1009     $self->paycvv('') if $self->dbdef_table->column('paycvv');
1010
1011   }
1012
1013   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1014     return "Expriation date required"
1015       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
1016     $self->paydate('');
1017   } else {
1018     my( $m, $y );
1019     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1020       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1021     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1022       ( $m, $y ) = ( $3, "20$2" );
1023     } else {
1024       return "Illegal expiration date: ". $self->paydate;
1025     }
1026     $self->paydate("$y-$m-01");
1027     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1028     return gettext('expired_card')
1029       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1030   }
1031
1032   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1033        ( ! $conf->exists('require_cardname')
1034          || $self->payby !~ /^(CARD|DCRD)$/  )
1035   ) {
1036     $self->payname( $self->first. " ". $self->getfield('last') );
1037   } else {
1038     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1039       or return gettext('illegal_name'). " payname: ". $self->payname;
1040     $self->payname($1);
1041   }
1042
1043   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
1044   $self->tax($1);
1045
1046   $self->otaker(getotaker) unless $self->otaker;
1047
1048   #warn "AFTER: \n". $self->_dump;
1049
1050   $self->SUPER::check;
1051 }
1052
1053 =item all_pkgs
1054
1055 Returns all packages (see L<FS::cust_pkg>) for this customer.
1056
1057 =cut
1058
1059 sub all_pkgs {
1060   my $self = shift;
1061   if ( $self->{'_pkgnum'} ) {
1062     values %{ $self->{'_pkgnum'}->cache };
1063   } else {
1064     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
1065   }
1066 }
1067
1068 =item ncancelled_pkgs
1069
1070 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
1071
1072 =cut
1073
1074 sub ncancelled_pkgs {
1075   my $self = shift;
1076   if ( $self->{'_pkgnum'} ) {
1077     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
1078   } else {
1079     @{ [ # force list context
1080       qsearch( 'cust_pkg', {
1081         'custnum' => $self->custnum,
1082         'cancel'  => '',
1083       }),
1084       qsearch( 'cust_pkg', {
1085         'custnum' => $self->custnum,
1086         'cancel'  => 0,
1087       }),
1088     ] };
1089   }
1090 }
1091
1092 =item suspended_pkgs
1093
1094 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
1095
1096 =cut
1097
1098 sub suspended_pkgs {
1099   my $self = shift;
1100   grep { $_->susp } $self->ncancelled_pkgs;
1101 }
1102
1103 =item unflagged_suspended_pkgs
1104
1105 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
1106 customer (thouse packages without the `manual_flag' set).
1107
1108 =cut
1109
1110 sub unflagged_suspended_pkgs {
1111   my $self = shift;
1112   return $self->suspended_pkgs
1113     unless dbdef->table('cust_pkg')->column('manual_flag');
1114   grep { ! $_->manual_flag } $self->suspended_pkgs;
1115 }
1116
1117 =item unsuspended_pkgs
1118
1119 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1120 this customer.
1121
1122 =cut
1123
1124 sub unsuspended_pkgs {
1125   my $self = shift;
1126   grep { ! $_->susp } $self->ncancelled_pkgs;
1127 }
1128
1129 =item num_cancelled_pkgs
1130
1131 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1132 customer.
1133
1134 =cut
1135
1136 sub num_cancelled_pkgs {
1137   my $self = shift;
1138   $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1139 }
1140
1141 sub num_pkgs {
1142   my( $self, $sql ) = @_;
1143   my $sth = dbh->prepare(
1144     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1145   ) or die dbh->errstr;
1146   $sth->execute($self->custnum) or die $sth->errstr;
1147   $sth->fetchrow_arrayref->[0];
1148 }
1149
1150 =item unsuspend
1151
1152 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1153 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1154 on success or a list of errors.
1155
1156 =cut
1157
1158 sub unsuspend {
1159   my $self = shift;
1160   grep { $_->unsuspend } $self->suspended_pkgs;
1161 }
1162
1163 =item suspend
1164
1165 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1166 Always returns a list: an empty list on success or a list of errors.
1167
1168 =cut
1169
1170 sub suspend {
1171   my $self = shift;
1172   grep { $_->suspend } $self->unsuspended_pkgs;
1173 }
1174
1175 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1176
1177 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1178 PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list on
1179 success or a list of errors.
1180
1181 =cut
1182
1183 sub suspend_if_pkgpart {
1184   my $self = shift;
1185   my @pkgparts = @_;
1186   grep { $_->suspend }
1187     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1188       $self->unsuspended_pkgs;
1189 }
1190
1191 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1192
1193 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1194 listed PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list
1195 on success or a list of errors.
1196
1197 =cut
1198
1199 sub suspend_unless_pkgpart {
1200   my $self = shift;
1201   my @pkgparts = @_;
1202   grep { $_->suspend }
1203     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1204       $self->unsuspended_pkgs;
1205 }
1206
1207 =item cancel [ OPTION => VALUE ... ]
1208
1209 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1210
1211 Available options are: I<quiet>
1212
1213 I<quiet> can be set true to supress email cancellation notices.
1214
1215 Always returns a list: an empty list on success or a list of errors.
1216
1217 =cut
1218
1219 sub cancel {
1220   my $self = shift;
1221   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1222 }
1223
1224 =item agent
1225
1226 Returns the agent (see L<FS::agent>) for this customer.
1227
1228 =cut
1229
1230 sub agent {
1231   my $self = shift;
1232   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1233 }
1234
1235 =item bill OPTIONS
1236
1237 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1238 conjunction with the collect method.
1239
1240 Options are passed as name-value pairs.
1241
1242 Currently available options are:
1243
1244 resetup - if set true, re-charges setup fees.
1245
1246 time - bills the customer as if it were that time.  Specified as a UNIX
1247 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1248 L<Date::Parse> for conversion functions.  For example:
1249
1250  use Date::Parse;
1251  ...
1252  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1253
1254
1255 If there is an error, returns the error, otherwise returns false.
1256
1257 =cut
1258
1259 sub bill {
1260   my( $self, %options ) = @_;
1261   return '' if $self->payby eq 'COMP';
1262   warn "bill customer ". $self->custnum if $DEBUG;
1263
1264   my $time = $options{'time'} || time;
1265
1266   my $error;
1267
1268   #put below somehow?
1269   local $SIG{HUP} = 'IGNORE';
1270   local $SIG{INT} = 'IGNORE';
1271   local $SIG{QUIT} = 'IGNORE';
1272   local $SIG{TERM} = 'IGNORE';
1273   local $SIG{TSTP} = 'IGNORE';
1274   local $SIG{PIPE} = 'IGNORE';
1275
1276   my $oldAutoCommit = $FS::UID::AutoCommit;
1277   local $FS::UID::AutoCommit = 0;
1278   my $dbh = dbh;
1279
1280   $self->select_for_update; #mutex
1281
1282   # find the packages which are due for billing, find out how much they are
1283   # & generate invoice database.
1284
1285   my( $total_setup, $total_recur ) = ( 0, 0 );
1286   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1287   my @cust_bill_pkg = ();
1288   #my $tax = 0;##
1289   #my $taxable_charged = 0;##
1290   #my $charged = 0;##
1291
1292   my %tax;
1293
1294   foreach my $cust_pkg (
1295     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1296   ) {
1297
1298     #NO!! next if $cust_pkg->cancel;
1299     next if $cust_pkg->getfield('cancel');
1300
1301     warn "  bill package ". $cust_pkg->pkgnum if $DEBUG;
1302
1303     #? to avoid use of uninitialized value errors... ?
1304     $cust_pkg->setfield('bill', '')
1305       unless defined($cust_pkg->bill);
1306
1307     my $part_pkg = $cust_pkg->part_pkg;
1308
1309     my %hash = $cust_pkg->hash;
1310     my $old_cust_pkg = new FS::cust_pkg \%hash;
1311
1312     my @details = ();
1313
1314     # bill setup
1315     my $setup = 0;
1316     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1317
1318       warn "    bill setup" if $DEBUG;
1319
1320       $setup = eval { $cust_pkg->calc_setup( $time ) };
1321       if ( $@ ) {
1322         $dbh->rollback if $oldAutoCommit;
1323         return $@;
1324       }
1325
1326       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1327     }
1328
1329     #bill recurring fee
1330     my $recur = 0;
1331     my $sdate;
1332     if ( $part_pkg->getfield('freq') ne '0' &&
1333          ! $cust_pkg->getfield('susp') &&
1334          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1335     ) {
1336
1337       warn "    bill recur" if $DEBUG;
1338
1339       # XXX shared with $recur_prog
1340       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1341
1342       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1343       if ( $@ ) {
1344         $dbh->rollback if $oldAutoCommit;
1345         return $@;
1346       }
1347
1348       #change this bit to use Date::Manip? CAREFUL with timezones (see
1349       # mailing list archive)
1350       my ($sec,$min,$hour,$mday,$mon,$year) =
1351         (localtime($sdate) )[0,1,2,3,4,5];
1352
1353       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1354       # only for figuring next bill date, nothing else, so, reset $sdate again
1355       # here
1356       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1357       $cust_pkg->last_bill($sdate)
1358         if $cust_pkg->dbdef_table->column('last_bill');
1359
1360       if ( $part_pkg->freq =~ /^\d+$/ ) {
1361         $mon += $part_pkg->freq;
1362         until ( $mon < 12 ) { $mon -= 12; $year++; }
1363       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1364         my $weeks = $1;
1365         $mday += $weeks * 7;
1366       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1367         my $days = $1;
1368         $mday += $days;
1369       } else {
1370         $dbh->rollback if $oldAutoCommit;
1371         return "unparsable frequency: ". $part_pkg->freq;
1372       }
1373       $cust_pkg->setfield('bill',
1374         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1375     }
1376
1377     warn "\$setup is undefined" unless defined($setup);
1378     warn "\$recur is undefined" unless defined($recur);
1379     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1380
1381     if ( $cust_pkg->modified ) {
1382
1383       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1384
1385       $error=$cust_pkg->replace($old_cust_pkg);
1386       if ( $error ) { #just in case
1387         $dbh->rollback if $oldAutoCommit;
1388         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1389       }
1390
1391       $setup = sprintf( "%.2f", $setup );
1392       $recur = sprintf( "%.2f", $recur );
1393       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1394         $dbh->rollback if $oldAutoCommit;
1395         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1396       }
1397       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1398         $dbh->rollback if $oldAutoCommit;
1399         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1400       }
1401       if ( $setup != 0 || $recur != 0 ) {
1402         warn "    charges (setup=$setup, recur=$recur); queueing line items\n"
1403           if $DEBUG;
1404         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1405           'pkgnum'  => $cust_pkg->pkgnum,
1406           'setup'   => $setup,
1407           'recur'   => $recur,
1408           'sdate'   => $sdate,
1409           'edate'   => $cust_pkg->bill,
1410           'details' => \@details,
1411         });
1412         push @cust_bill_pkg, $cust_bill_pkg;
1413         $total_setup += $setup;
1414         $total_recur += $recur;
1415
1416         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1417
1418           my @taxes = qsearch( 'cust_main_county', {
1419                                  'state'    => $self->state,
1420                                  'county'   => $self->county,
1421                                  'country'  => $self->country,
1422                                  'taxclass' => $part_pkg->taxclass,
1423                                                                       } );
1424           unless ( @taxes ) {
1425             @taxes =  qsearch( 'cust_main_county', {
1426                                   'state'    => $self->state,
1427                                   'county'   => $self->county,
1428                                   'country'  => $self->country,
1429                                   'taxclass' => '',
1430                                                                       } );
1431           }
1432
1433           #one more try at a whole-country tax rate
1434           unless ( @taxes ) {
1435             @taxes =  qsearch( 'cust_main_county', {
1436                                   'state'    => '',
1437                                   'county'   => '',
1438                                   'country'  => $self->country,
1439                                   'taxclass' => '',
1440                                                                       } );
1441           }
1442
1443           # maybe eliminate this entirely, along with all the 0% records
1444           unless ( @taxes ) {
1445             $dbh->rollback if $oldAutoCommit;
1446             return
1447               "fatal: can't find tax rate for state/county/country/taxclass ".
1448               join('/', ( map $self->$_(), qw(state county country) ),
1449                         $part_pkg->taxclass ).  "\n";
1450           }
1451
1452           foreach my $tax ( @taxes ) {
1453
1454             my $taxable_charged = 0;
1455             $taxable_charged += $setup
1456               unless $part_pkg->setuptax =~ /^Y$/i
1457                   || $tax->setuptax =~ /^Y$/i;
1458             $taxable_charged += $recur
1459               unless $part_pkg->recurtax =~ /^Y$/i
1460                   || $tax->recurtax =~ /^Y$/i;
1461             next unless $taxable_charged;
1462
1463             if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) {
1464               my ($mon,$year) = (localtime($sdate) )[4,5];
1465               $mon++;
1466               my $freq = $part_pkg->freq || 1;
1467               if ( $freq !~ /(\d+)$/ ) {
1468                 $dbh->rollback if $oldAutoCommit;
1469                 return "daily/weekly package definitions not (yet?)".
1470                        " compatible with monthly tax exemptions";
1471               }
1472               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1473               foreach my $which_month ( 1 .. $freq ) {
1474                 my %hash = (
1475                   'custnum' => $self->custnum,
1476                   'taxnum'  => $tax->taxnum,
1477                   'year'    => 1900+$year,
1478                   'month'   => $mon++,
1479                 );
1480                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1481                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1482                 my $cust_tax_exempt =
1483                   qsearchs('cust_tax_exempt', \%hash)
1484                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1485                 my $remaining_exemption = sprintf("%.2f",
1486                   $tax->exempt_amount - $cust_tax_exempt->amount );
1487                 if ( $remaining_exemption > 0 ) {
1488                   my $addl = $remaining_exemption > $taxable_per_month
1489                     ? $taxable_per_month
1490                     : $remaining_exemption;
1491                   $taxable_charged -= $addl;
1492                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1493                     $cust_tax_exempt->hash,
1494                     'amount' =>
1495                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1496                   } );
1497                   $error = $new_cust_tax_exempt->exemptnum
1498                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1499                     : $new_cust_tax_exempt->insert;
1500                   if ( $error ) {
1501                     $dbh->rollback if $oldAutoCommit;
1502                     return "fatal: can't update cust_tax_exempt: $error";
1503                   }
1504
1505                 } # if $remaining_exemption > 0
1506
1507               } #foreach $which_month
1508
1509             } #if $tax->exempt_amount
1510
1511             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1512
1513             #$tax += $taxable_charged * $cust_main_county->tax / 100
1514             $tax{ $tax->taxname || 'Tax' } +=
1515               $taxable_charged * $tax->tax / 100
1516
1517           } #foreach my $tax ( @taxes )
1518
1519         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1520
1521       } #if $setup != 0 || $recur != 0
1522
1523     } #if $cust_pkg->modified
1524
1525   } #foreach my $cust_pkg
1526
1527   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1528 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1529
1530   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1531     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1532     return '';
1533   }
1534
1535 #  unless ( $self->tax =~ /Y/i
1536 #           || $self->payby eq 'COMP'
1537 #           || $taxable_charged == 0 ) {
1538 #    my $cust_main_county = qsearchs('cust_main_county',{
1539 #        'state'   => $self->state,
1540 #        'county'  => $self->county,
1541 #        'country' => $self->country,
1542 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1543 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1544 #    my $tax = sprintf( "%.2f",
1545 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1546 #    );
1547
1548   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1549
1550     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1551       my $tax = sprintf("%.2f", $tax{$taxname} );
1552       $charged = sprintf( "%.2f", $charged+$tax );
1553
1554       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1555         'pkgnum'   => 0,
1556         'setup'    => $tax,
1557         'recur'    => 0,
1558         'sdate'    => '',
1559         'edate'    => '',
1560         'itemdesc' => $taxname,
1561       });
1562       push @cust_bill_pkg, $cust_bill_pkg;
1563     }
1564
1565   } else { #1.4 schema
1566
1567     my $tax = 0;
1568     foreach ( values %tax ) { $tax += $_ };
1569     $tax = sprintf("%.2f", $tax);
1570     if ( $tax > 0 ) {
1571       $charged = sprintf( "%.2f", $charged+$tax );
1572
1573       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1574         'pkgnum' => 0,
1575         'setup'  => $tax,
1576         'recur'  => 0,
1577         'sdate'  => '',
1578         'edate'  => '',
1579       });
1580       push @cust_bill_pkg, $cust_bill_pkg;
1581     }
1582
1583   }
1584
1585   my $cust_bill = new FS::cust_bill ( {
1586     'custnum' => $self->custnum,
1587     '_date'   => $time,
1588     'charged' => $charged,
1589   } );
1590   $error = $cust_bill->insert;
1591   if ( $error ) {
1592     $dbh->rollback if $oldAutoCommit;
1593     return "can't create invoice for customer #". $self->custnum. ": $error";
1594   }
1595
1596   my $invnum = $cust_bill->invnum;
1597   my $cust_bill_pkg;
1598   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1599     #warn $invnum;
1600     $cust_bill_pkg->invnum($invnum);
1601     $error = $cust_bill_pkg->insert;
1602     if ( $error ) {
1603       $dbh->rollback if $oldAutoCommit;
1604       return "can't create invoice line item for customer #". $self->custnum.
1605              ": $error";
1606     }
1607   }
1608
1609   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1610   ''; #no error
1611 }
1612
1613 =item collect OPTIONS
1614
1615 (Attempt to) collect money for this customer's outstanding invoices (see
1616 L<FS::cust_bill>).  Usually used after the bill method.
1617
1618 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1619 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1620 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1621
1622 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1623 and the invoice events web interface.
1624
1625 If there is an error, returns the error, otherwise returns false.
1626
1627 Options are passed as name-value pairs.
1628
1629 Currently available options are:
1630
1631 invoice_time - Use this time when deciding when to print invoices and
1632 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>
1633 for conversion functions.
1634
1635 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1636 events.
1637
1638 retry_card - Deprecated alias for 'retry'
1639
1640 batch_card - This option is deprecated.  See the invoice events web interface
1641 to control whether cards are batched or run against a realtime gateway.
1642
1643 report_badcard - This option is deprecated.
1644
1645 force_print - This option is deprecated; see the invoice events web interface.
1646
1647 quiet - set true to surpress email card/ACH decline notices.
1648
1649 =cut
1650
1651 sub collect {
1652   my( $self, %options ) = @_;
1653   my $invoice_time = $options{'invoice_time'} || time;
1654
1655   #put below somehow?
1656   local $SIG{HUP} = 'IGNORE';
1657   local $SIG{INT} = 'IGNORE';
1658   local $SIG{QUIT} = 'IGNORE';
1659   local $SIG{TERM} = 'IGNORE';
1660   local $SIG{TSTP} = 'IGNORE';
1661   local $SIG{PIPE} = 'IGNORE';
1662
1663   my $oldAutoCommit = $FS::UID::AutoCommit;
1664   local $FS::UID::AutoCommit = 0;
1665   my $dbh = dbh;
1666
1667   $self->select_for_update; #mutex
1668
1669   my $balance = $self->balance;
1670   warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1671   unless ( $balance > 0 ) { #redundant?????
1672     $dbh->rollback if $oldAutoCommit; #hmm
1673     return '';
1674   }
1675
1676   if ( exists($options{'retry_card'}) ) {
1677     carp 'retry_card option passed to collect is deprecated; use retry';
1678     $options{'retry'} ||= $options{'retry_card'};
1679   }
1680   if ( exists($options{'retry'}) && $options{'retry'} ) {
1681     my $error = $self->retry_realtime;
1682     if ( $error ) {
1683       $dbh->rollback if $oldAutoCommit;
1684       return $error;
1685     }
1686   }
1687
1688   foreach my $cust_bill ( $self->open_cust_bill ) {
1689
1690     # don't try to charge for the same invoice if it's already in a batch
1691     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1692
1693     last if $self->balance <= 0;
1694
1695     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1696       if $DEBUG;
1697
1698     foreach my $part_bill_event (
1699       sort {    $a->seconds   <=> $b->seconds
1700              || $a->weight    <=> $b->weight
1701              || $a->eventpart <=> $b->eventpart }
1702         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1703                && ! qsearch( 'cust_bill_event', {
1704                                 'invnum'    => $cust_bill->invnum,
1705                                 'eventpart' => $_->eventpart,
1706                                 'status'    => 'done',
1707                                                                    } )
1708              }
1709           qsearch('part_bill_event', { 'payby'    => $self->payby,
1710                                        'disabled' => '',           } )
1711     ) {
1712
1713       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1714            || $self->balance   <= 0; # or if balance<=0
1715
1716       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1717         if $DEBUG;
1718       my $cust_main = $self; #for callback
1719
1720       my $error;
1721       {
1722         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1723         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1724         $error = eval $part_bill_event->eventcode;
1725       }
1726
1727       my $status = '';
1728       my $statustext = '';
1729       if ( $@ ) {
1730         $status = 'failed';
1731         $statustext = $@;
1732       } elsif ( $error ) {
1733         $status = 'done';
1734         $statustext = $error;
1735       } else {
1736         $status = 'done'
1737       }
1738
1739       #add cust_bill_event
1740       my $cust_bill_event = new FS::cust_bill_event {
1741         'invnum'     => $cust_bill->invnum,
1742         'eventpart'  => $part_bill_event->eventpart,
1743         #'_date'      => $invoice_time,
1744         '_date'      => time,
1745         'status'     => $status,
1746         'statustext' => $statustext,
1747       };
1748       $error = $cust_bill_event->insert;
1749       if ( $error ) {
1750         #$dbh->rollback if $oldAutoCommit;
1751         #return "error: $error";
1752
1753         # gah, even with transactions.
1754         $dbh->commit if $oldAutoCommit; #well.
1755         my $e = 'WARNING: Event run but database not updated - '.
1756                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1757                 ', eventpart '. $part_bill_event->eventpart.
1758                 ": $error";
1759         warn $e;
1760         return $e;
1761       }
1762
1763
1764     }
1765
1766   }
1767
1768   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1769   '';
1770
1771 }
1772
1773 =item retry_realtime
1774
1775 Schedules realtime credit card / electronic check / LEC billing events for
1776 for retry.  Useful if card information has changed or manual retry is desired.
1777 The 'collect' method must be called to actually retry the transaction.
1778
1779 Implementation details: For each of this customer's open invoices, changes
1780 the status of the first "done" (with statustext error) realtime processing
1781 event to "failed".
1782
1783 =cut
1784
1785 sub retry_realtime {
1786   my $self = shift;
1787
1788   local $SIG{HUP} = 'IGNORE';
1789   local $SIG{INT} = 'IGNORE';
1790   local $SIG{QUIT} = 'IGNORE';
1791   local $SIG{TERM} = 'IGNORE';
1792   local $SIG{TSTP} = 'IGNORE';
1793   local $SIG{PIPE} = 'IGNORE';
1794
1795   my $oldAutoCommit = $FS::UID::AutoCommit;
1796   local $FS::UID::AutoCommit = 0;
1797   my $dbh = dbh;
1798
1799   foreach my $cust_bill (
1800     grep { $_->cust_bill_event }
1801       $self->open_cust_bill
1802   ) {
1803     my @cust_bill_event =
1804       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1805         grep {
1806                #$_->part_bill_event->plan eq 'realtime-card'
1807                $_->part_bill_event->eventcode =~
1808                    /\$cust_bill\->realtime_(card|ach|lec)/
1809                  && $_->status eq 'done'
1810                  && $_->statustext
1811              }
1812           $cust_bill->cust_bill_event;
1813     next unless @cust_bill_event;
1814     my $error = $cust_bill_event[0]->retry;
1815     if ( $error ) {
1816       $dbh->rollback if $oldAutoCommit;
1817       return "error scheduling invoice event for retry: $error";
1818     }
1819
1820   }
1821
1822   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1823   '';
1824
1825 }
1826
1827 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1828
1829 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1830 via a Business::OnlinePayment realtime gateway.  See
1831 L<http://420.am/business-onlinepayment> for supported gateways.
1832
1833 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1834
1835 Available options are: I<description>, I<invnum>, I<quiet>
1836
1837 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1838 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1839 if set, will override the value from the customer record.
1840
1841 I<description> is a free-text field passed to the gateway.  It defaults to
1842 "Internet services".
1843
1844 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1845 specified invoice.  If you don't specify an I<invnum> you might want to
1846 call the B<apply_payments> method.
1847
1848 I<quiet> can be set true to surpress email decline notices.
1849
1850 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1851
1852 =cut
1853
1854 sub realtime_bop {
1855   my( $self, $method, $amount, %options ) = @_;
1856   if ( $DEBUG ) {
1857     warn "$self $method $amount\n";
1858     warn "  $_ => $options{$_}\n" foreach keys %options;
1859   }
1860
1861   $options{'description'} ||= 'Internet services';
1862
1863   #pre-requisites
1864   die "Real-time processing not enabled\n"
1865     unless $conf->exists('business-onlinepayment');
1866   eval "use Business::OnlinePayment";
1867   die $@ if $@;
1868
1869   #load up config
1870   my $bop_config = 'business-onlinepayment';
1871   $bop_config .= '-ach'
1872     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1873   my ( $processor, $login, $password, $action, @bop_options ) =
1874     $conf->config($bop_config);
1875   $action ||= 'normal authorization';
1876   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1877   die "No real-time processor is enabled - ".
1878       "did you set the business-onlinepayment configuration value?\n"
1879     unless $processor;
1880
1881   #massage data
1882
1883   my $address = exists($options{'address1'})
1884                     ? $options{'address1'}
1885                     : $self->address1;
1886   my $address2 = exists($options{'address2'})
1887                     ? $options{'address2'}
1888                     : $self->address2;
1889   $address .= ", ". $address2 if length($address2);
1890
1891   my $o_payname = exists($options{'payname'})
1892                     ? $options{'payname'}
1893                     : $self->payname;
1894   my($payname, $payfirst, $paylast);
1895   if ( $o_payname && $method ne 'ECHECK' ) {
1896     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1897       or return "Illegal payname $payname";
1898     ($payfirst, $paylast) = ($1, $2);
1899   } else {
1900     $payfirst = $self->getfield('first');
1901     $paylast = $self->getfield('last');
1902     $payname =  "$payfirst $paylast";
1903   }
1904
1905   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1906   if ( $conf->exists('emailinvoiceauto')
1907        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1908     push @invoicing_list, $self->all_emails;
1909   }
1910   my $email = $invoicing_list[0];
1911
1912   my $payinfo = exists($options{'payinfo'})
1913                   ? $options{'payinfo'}
1914                   : $self->payinfo;
1915
1916   my %content = ();
1917   if ( $method eq 'CC' ) {
1918
1919     $content{card_number} = $payinfo;
1920     my $paydate = exists($options{'paydate'})
1921                     ? $options{'paydate'}
1922                     : $self->paydate;
1923     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1924     $content{expiration} = "$2/$1";
1925
1926     if ( defined $self->dbdef_table->column('paycvv') ) {
1927       my $paycvv = exists($options{'paycvv'})
1928                      ? $options{'paycvv'}
1929                      : $self->paycvv;
1930       $content{cvv2} = $self->paycvv
1931         if length($paycvv);
1932     }
1933
1934     $content{recurring_billing} = 'YES'
1935       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1936                                'payby'   => 'CARD',
1937                                'payinfo' => $payinfo,
1938                              } );
1939
1940   } elsif ( $method eq 'ECHECK' ) {
1941     ( $content{account_number}, $content{routing_code} ) =
1942       split('@', $payinfo);
1943     $content{bank_name} = $o_payname;
1944     $content{account_type} = 'CHECKING';
1945     $content{account_name} = $payname;
1946     $content{customer_org} = $self->company ? 'B' : 'I';
1947     $content{customer_ssn} = exists($options{'ss'})
1948                                ? $options{'ss'}
1949                                : $self->ss;
1950   } elsif ( $method eq 'LEC' ) {
1951     $content{phone} = $payinfo;
1952   }
1953
1954   #transaction(s)
1955
1956   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1957
1958   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1959   $transaction->content(
1960     'type'           => $method,
1961     'login'          => $login,
1962     'password'       => $password,
1963     'action'         => $action1,
1964     'description'    => $options{'description'},
1965     'amount'         => $amount,
1966     'invoice_number' => $options{'invnum'},
1967     'customer_id'    => $self->custnum,
1968     'last_name'      => $paylast,
1969     'first_name'     => $payfirst,
1970     'name'           => $payname,
1971     'address'        => $address,
1972     'city'           => ( exists($options{'city'})
1973                             ? $options{'city'}
1974                             : $self->city          ),
1975     'state'          => ( exists($options{'state'})
1976                             ? $options{'state'}
1977                             : $self->state          ),
1978     'zip'            => ( exists($options{'zip'})
1979                             ? $options{'zip'}
1980                             : $self->zip          ),
1981     'country'        => ( exists($options{'country'})
1982                             ? $options{'country'}
1983                             : $self->country          ),
1984     'referer'        => 'http://cleanwhisker.420.am/',
1985     'email'          => $email,
1986     'phone'          => $self->daytime || $self->night,
1987     %content, #after
1988   );
1989   $transaction->submit();
1990
1991   if ( $transaction->is_success() && $action2 ) {
1992     my $auth = $transaction->authorization;
1993     my $ordernum = $transaction->can('order_number')
1994                    ? $transaction->order_number
1995                    : '';
1996
1997     my $capture =
1998       new Business::OnlinePayment( $processor, @bop_options );
1999
2000     my %capture = (
2001       %content,
2002       type           => $method,
2003       action         => $action2,
2004       login          => $login,
2005       password       => $password,
2006       order_number   => $ordernum,
2007       amount         => $amount,
2008       authorization  => $auth,
2009       description    => $options{'description'},
2010     );
2011
2012     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2013                            transaction_sequence_num local_transaction_date
2014                            local_transaction_time AVS_result_code          )) {
2015       $capture{$field} = $transaction->$field() if $transaction->can($field);
2016     }
2017
2018     $capture->content( %capture );
2019
2020     $capture->submit();
2021
2022     unless ( $capture->is_success ) {
2023       my $e = "Authorization sucessful but capture failed, custnum #".
2024               $self->custnum. ': '.  $capture->result_code.
2025               ": ". $capture->error_message;
2026       warn $e;
2027       return $e;
2028     }
2029
2030   }
2031
2032   #remove paycvv after initial transaction
2033   #false laziness w/misc/process/payment.cgi - check both to make sure working
2034   # correctly
2035   if ( defined $self->dbdef_table->column('paycvv')
2036        && length($self->paycvv)
2037        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2038   ) {
2039     my $error = $self->remove_cvv;
2040     if ( $error ) {
2041       warn "error removing cvv: $error\n";
2042     }
2043   }
2044
2045   #result handling
2046   if ( $transaction->is_success() ) {
2047
2048     my %method2payby = (
2049       'CC'     => 'CARD',
2050       'ECHECK' => 'CHEK',
2051       'LEC'    => 'LECB',
2052     );
2053
2054     my $paybatch = "$processor:". $transaction->authorization;
2055     $paybatch .= ':'. $transaction->order_number
2056       if $transaction->can('order_number')
2057       && length($transaction->order_number);
2058
2059     my $cust_pay = new FS::cust_pay ( {
2060        'custnum'  => $self->custnum,
2061        'invnum'   => $options{'invnum'},
2062        'paid'     => $amount,
2063        '_date'     => '',
2064        'payby'    => $method2payby{$method},
2065        'payinfo'  => $payinfo,
2066        'paybatch' => $paybatch,
2067     } );
2068     my $error = $cust_pay->insert;
2069     if ( $error ) {
2070       $cust_pay->invnum(''); #try again with no specific invnum
2071       my $error2 = $cust_pay->insert;
2072       if ( $error2 ) {
2073         # gah, even with transactions.
2074         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2075                 "error inserting payment ($processor): $error2".
2076                 " (previously tried insert with invnum #$options{'invnum'}" .
2077                 ": $error )";
2078         warn $e;
2079         return $e;
2080       }
2081     }
2082     return ''; #no error
2083
2084   } else {
2085
2086     my $perror = "$processor error: ". $transaction->error_message;
2087
2088     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2089          && $conf->exists('emaildecline')
2090          && grep { $_ ne 'POST' } $self->invoicing_list
2091          && ! grep { $transaction->error_message =~ /$_/ }
2092                    $conf->config('emaildecline-exclude')
2093     ) {
2094       my @templ = $conf->config('declinetemplate');
2095       my $template = new Text::Template (
2096         TYPE   => 'ARRAY',
2097         SOURCE => [ map "$_\n", @templ ],
2098       ) or return "($perror) can't create template: $Text::Template::ERROR";
2099       $template->compile()
2100         or return "($perror) can't compile template: $Text::Template::ERROR";
2101
2102       my $templ_hash = { error => $transaction->error_message };
2103
2104       my $error = send_email(
2105         'from'    => $conf->config('invoice_from'),
2106         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2107         'subject' => 'Your payment could not be processed',
2108         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2109       );
2110
2111       $perror .= " (also received error sending decline notification: $error)"
2112         if $error;
2113
2114     }
2115
2116     return $perror;
2117   }
2118
2119 }
2120
2121 =item remove_cvv
2122
2123 Removes the I<paycvv> field from the database directly.
2124
2125 If there is an error, returns the error, otherwise returns false.
2126
2127 =cut
2128
2129 sub remove_cvv {
2130   my $self = shift;
2131   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2132     or return dbh->errstr;
2133   $sth->execute($self->custnum)
2134     or return $sth->errstr;
2135   $self->paycvv('');
2136   '';
2137 }
2138
2139 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2140
2141 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2142 via a Business::OnlinePayment realtime gateway.  See
2143 L<http://420.am/business-onlinepayment> for supported gateways.
2144
2145 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2146
2147 Available options are: I<amount>, I<reason>, I<paynum>
2148
2149 Most gateways require a reference to an original payment transaction to refund,
2150 so you probably need to specify a I<paynum>.
2151
2152 I<amount> defaults to the original amount of the payment if not specified.
2153
2154 I<reason> specifies a reason for the refund.
2155
2156 Implementation note: If I<amount> is unspecified or equal to the amount of the
2157 orignal payment, first an attempt is made to "void" the transaction via
2158 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2159 the normal attempt is made to "refund" ("credit") the transaction via the
2160 gateway is attempted.
2161
2162 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2163 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2164 #if set, will override the value from the customer record.
2165
2166 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2167 #specified invoice.  If you don't specify an I<invnum> you might want to
2168 #call the B<apply_payments> method.
2169
2170 =cut
2171
2172 #some false laziness w/realtime_bop, not enough to make it worth merging
2173 #but some useful small subs should be pulled out
2174 sub realtime_refund_bop {
2175   my( $self, $method, %options ) = @_;
2176   if ( $DEBUG ) {
2177     warn "$self $method refund\n";
2178     warn "  $_ => $options{$_}\n" foreach keys %options;
2179   }
2180
2181   #pre-requisites
2182   die "Real-time processing not enabled\n"
2183     unless $conf->exists('business-onlinepayment');
2184   eval "use Business::OnlinePayment";
2185   die $@ if $@;
2186
2187   #load up config
2188   my $bop_config = 'business-onlinepayment';
2189   $bop_config .= '-ach'
2190     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2191   my ( $processor, $login, $password, $unused_action, @bop_options ) =
2192     $conf->config($bop_config);
2193   #$action ||= 'normal authorization';
2194   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2195   die "No real-time processor is enabled - ".
2196       "did you set the business-onlinepayment configuration value?\n"
2197     unless $processor;
2198
2199   my $cust_pay = '';
2200   my $amount = $options{'amount'};
2201   my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2202   if ( $options{'paynum'} ) {
2203     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2204     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2205       or return "Unknown paynum $options{'paynum'}";
2206     $amount ||= $cust_pay->paid;
2207     $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/
2208       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2209                 $cust_pay->paybatch;
2210     ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2211     return "processor of payment $options{'paynum'} $pay_processor does not".
2212            " match current processor $processor"
2213       unless $pay_processor eq $processor;
2214   }
2215   return "neither amount nor paynum specified" unless $amount;
2216
2217   my %content = (
2218     'type'           => $method,
2219     'login'          => $login,
2220     'password'       => $password,
2221     'order_number'   => $order_number,
2222     'amount'         => $amount,
2223     'referer'        => 'http://cleanwhisker.420.am/',
2224   );
2225   $content{authorization} = $auth
2226     if length($auth); #echeck/ACH transactions have an order # but no auth
2227                       #(at least with authorize.net)
2228
2229   #first try void if applicable
2230   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2231     warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2232     my $void = new Business::OnlinePayment( $processor, @bop_options );
2233     $void->content( 'action' => 'void', %content );
2234     $void->submit();
2235     if ( $void->is_success ) {
2236       my $error = $cust_pay->void($options{'reason'});
2237       if ( $error ) {
2238         # gah, even with transactions.
2239         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2240                 "error voiding payment: $error";
2241         warn $e;
2242         return $e;
2243       }
2244       warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2245       return '';
2246     }
2247   }
2248
2249   warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2250     if $DEBUG;
2251
2252   #massage data
2253   my $address = $self->address1;
2254   $address .= ", ". $self->address2 if $self->address2;
2255
2256   my($payname, $payfirst, $paylast);
2257   if ( $self->payname && $method ne 'ECHECK' ) {
2258     $payname = $self->payname;
2259     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2260       or return "Illegal payname $payname";
2261     ($payfirst, $paylast) = ($1, $2);
2262   } else {
2263     $payfirst = $self->getfield('first');
2264     $paylast = $self->getfield('last');
2265     $payname =  "$payfirst $paylast";
2266   }
2267
2268   my $payinfo = '';
2269   if ( $method eq 'CC' ) {
2270
2271     if ( $cust_pay ) {
2272       $content{card_number} = $payinfo = $cust_pay->payinfo;
2273       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2274       #$content{expiration} = "$2/$1";
2275     } else {
2276       $content{card_number} = $payinfo = $self->payinfo;
2277       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2278       $content{expiration} = "$2/$1";
2279     }
2280
2281   } elsif ( $method eq 'ECHECK' ) {
2282     ( $content{account_number}, $content{routing_code} ) =
2283       split('@', $payinfo = $self->payinfo);
2284     $content{bank_name} = $self->payname;
2285     $content{account_type} = 'CHECKING';
2286     $content{account_name} = $payname;
2287     $content{customer_org} = $self->company ? 'B' : 'I';
2288     $content{customer_ssn} = $self->ss;
2289   } elsif ( $method eq 'LEC' ) {
2290     $content{phone} = $payinfo = $self->payinfo;
2291   }
2292
2293   #then try refund
2294   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2295   my %sub_content = $refund->content(
2296     'action'         => 'credit',
2297     'customer_id'    => $self->custnum,
2298     'last_name'      => $paylast,
2299     'first_name'     => $payfirst,
2300     'name'           => $payname,
2301     'address'        => $address,
2302     'city'           => $self->city,
2303     'state'          => $self->state,
2304     'zip'            => $self->zip,
2305     'country'        => $self->country,
2306     %content, #after
2307   );
2308   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2309     if $DEBUG > 1;
2310   $refund->submit();
2311
2312   return "$processor error: ". $refund->error_message
2313     unless $refund->is_success();
2314
2315   my %method2payby = (
2316     'CC'     => 'CARD',
2317     'ECHECK' => 'CHEK',
2318     'LEC'    => 'LECB',
2319   );
2320
2321   my $paybatch = "$processor:". $refund->authorization;
2322   $paybatch .= ':'. $refund->order_number
2323     if $refund->can('order_number') && $refund->order_number;
2324
2325   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2326     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2327     last unless @cust_bill_pay;
2328     my $cust_bill_pay = pop @cust_bill_pay;
2329     my $error = $cust_bill_pay->delete;
2330     last if $error;
2331   }
2332
2333   my $cust_refund = new FS::cust_refund ( {
2334     'custnum'  => $self->custnum,
2335     'paynum'   => $options{'paynum'},
2336     'refund'   => $amount,
2337     '_date'    => '',
2338     'payby'    => $method2payby{$method},
2339     'payinfo'  => $payinfo,
2340     'paybatch' => $paybatch,
2341     'reason'   => $options{'reason'} || 'card or ACH refund',
2342   } );
2343   my $error = $cust_refund->insert;
2344   if ( $error ) {
2345     $cust_refund->paynum(''); #try again with no specific paynum
2346     my $error2 = $cust_refund->insert;
2347     if ( $error2 ) {
2348       # gah, even with transactions.
2349       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2350               "error inserting refund ($processor): $error2".
2351               " (previously tried insert with paynum #$options{'paynum'}" .
2352               ": $error )";
2353       warn $e;
2354       return $e;
2355     }
2356   }
2357
2358   ''; #no error
2359
2360 }
2361
2362 =item total_owed
2363
2364 Returns the total owed for this customer on all invoices
2365 (see L<FS::cust_bill/owed>).
2366
2367 =cut
2368
2369 sub total_owed {
2370   my $self = shift;
2371   $self->total_owed_date(2145859200); #12/31/2037
2372 }
2373
2374 =item total_owed_date TIME
2375
2376 Returns the total owed for this customer on all invoices with date earlier than
2377 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2378 see L<Time::Local> and L<Date::Parse> for conversion functions.
2379
2380 =cut
2381
2382 sub total_owed_date {
2383   my $self = shift;
2384   my $time = shift;
2385   my $total_bill = 0;
2386   foreach my $cust_bill (
2387     grep { $_->_date <= $time }
2388       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2389   ) {
2390     $total_bill += $cust_bill->owed;
2391   }
2392   sprintf( "%.2f", $total_bill );
2393 }
2394
2395 =item apply_credits OPTION => VALUE ...
2396
2397 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2398 to outstanding invoice balances in chronological order (or reverse
2399 chronological order if the I<order> option is set to B<newest>) and returns the
2400 value of any remaining unapplied credits available for refund (see
2401 L<FS::cust_refund>).
2402
2403 =cut
2404
2405 sub apply_credits {
2406   my $self = shift;
2407   my %opt = @_;
2408
2409   return 0 unless $self->total_credited;
2410
2411   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2412       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2413
2414   my @invoices = $self->open_cust_bill;
2415   @invoices = sort { $b->_date <=> $a->_date } @invoices
2416     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2417
2418   my $credit;
2419   foreach my $cust_bill ( @invoices ) {
2420     my $amount;
2421
2422     if ( !defined($credit) || $credit->credited == 0) {
2423       $credit = pop @credits or last;
2424     }
2425
2426     if ($cust_bill->owed >= $credit->credited) {
2427       $amount=$credit->credited;
2428     }else{
2429       $amount=$cust_bill->owed;
2430     }
2431
2432     my $cust_credit_bill = new FS::cust_credit_bill ( {
2433       'crednum' => $credit->crednum,
2434       'invnum'  => $cust_bill->invnum,
2435       'amount'  => $amount,
2436     } );
2437     my $error = $cust_credit_bill->insert;
2438     die $error if $error;
2439
2440     redo if ($cust_bill->owed > 0);
2441
2442   }
2443
2444   return $self->total_credited;
2445 }
2446
2447 =item apply_payments
2448
2449 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2450 to outstanding invoice balances in chronological order.
2451
2452  #and returns the value of any remaining unapplied payments.
2453
2454 =cut
2455
2456 sub apply_payments {
2457   my $self = shift;
2458
2459   #return 0 unless
2460
2461   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2462       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2463
2464   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2465       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2466
2467   my $payment;
2468
2469   foreach my $cust_bill ( @invoices ) {
2470     my $amount;
2471
2472     if ( !defined($payment) || $payment->unapplied == 0 ) {
2473       $payment = pop @payments or last;
2474     }
2475
2476     if ( $cust_bill->owed >= $payment->unapplied ) {
2477       $amount = $payment->unapplied;
2478     } else {
2479       $amount = $cust_bill->owed;
2480     }
2481
2482     my $cust_bill_pay = new FS::cust_bill_pay ( {
2483       'paynum' => $payment->paynum,
2484       'invnum' => $cust_bill->invnum,
2485       'amount' => $amount,
2486     } );
2487     my $error = $cust_bill_pay->insert;
2488     die $error if $error;
2489
2490     redo if ( $cust_bill->owed > 0);
2491
2492   }
2493
2494   return $self->total_unapplied_payments;
2495 }
2496
2497 =item total_credited
2498
2499 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2500 customer.  See L<FS::cust_credit/credited>.
2501
2502 =cut
2503
2504 sub total_credited {
2505   my $self = shift;
2506   my $total_credit = 0;
2507   foreach my $cust_credit ( qsearch('cust_credit', {
2508     'custnum' => $self->custnum,
2509   } ) ) {
2510     $total_credit += $cust_credit->credited;
2511   }
2512   sprintf( "%.2f", $total_credit );
2513 }
2514
2515 =item total_unapplied_payments
2516
2517 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2518 See L<FS::cust_pay/unapplied>.
2519
2520 =cut
2521
2522 sub total_unapplied_payments {
2523   my $self = shift;
2524   my $total_unapplied = 0;
2525   foreach my $cust_pay ( qsearch('cust_pay', {
2526     'custnum' => $self->custnum,
2527   } ) ) {
2528     $total_unapplied += $cust_pay->unapplied;
2529   }
2530   sprintf( "%.2f", $total_unapplied );
2531 }
2532
2533 =item balance
2534
2535 Returns the balance for this customer (total_owed minus total_credited
2536 minus total_unapplied_payments).
2537
2538 =cut
2539
2540 sub balance {
2541   my $self = shift;
2542   sprintf( "%.2f",
2543     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2544   );
2545 }
2546
2547 =item balance_date TIME
2548
2549 Returns the balance for this customer, only considering invoices with date
2550 earlier than TIME (total_owed_date minus total_credited minus
2551 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2552 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2553 functions.
2554
2555 =cut
2556
2557 sub balance_date {
2558   my $self = shift;
2559   my $time = shift;
2560   sprintf( "%.2f",
2561     $self->total_owed_date($time)
2562       - $self->total_credited
2563       - $self->total_unapplied_payments
2564   );
2565 }
2566
2567 =item paydate_monthyear
2568
2569 Returns a two-element list consisting of the month and year of this customer's
2570 paydate (credit card expiration date for CARD customers)
2571
2572 =cut
2573
2574 sub paydate_monthyear {
2575   my $self = shift;
2576   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2577     ( $2, $1 );
2578   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2579     ( $1, $3 );
2580   } else {
2581     ('', '');
2582   }
2583 }
2584
2585 =item payinfo_masked
2586
2587 Returns a "masked" payinfo field appropriate to the payment type.  Masked characters are replaced by 'x'es.  Use this to display publicly accessable account Information.
2588
2589 Credit Cards - Mask all but the last four characters.
2590 Checks - Mask all but last 2 of account number and bank routing number.
2591 Others - Do nothing, return the unmasked string.
2592
2593 =cut
2594
2595 sub payinfo_masked {
2596   my $self = shift;
2597   return $self->paymask;
2598 }
2599
2600 =item invoicing_list [ ARRAYREF ]
2601
2602 If an arguement is given, sets these email addresses as invoice recipients
2603 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2604 (except as warnings), so use check_invoicing_list first.
2605
2606 Returns a list of email addresses (with svcnum entries expanded).
2607
2608 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2609 check it without disturbing anything by passing nothing.
2610
2611 This interface may change in the future.
2612
2613 =cut
2614
2615 sub invoicing_list {
2616   my( $self, $arrayref ) = @_;
2617   if ( $arrayref ) {
2618     my @cust_main_invoice;
2619     if ( $self->custnum ) {
2620       @cust_main_invoice =
2621         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2622     } else {
2623       @cust_main_invoice = ();
2624     }
2625     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2626       #warn $cust_main_invoice->destnum;
2627       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2628         #warn $cust_main_invoice->destnum;
2629         my $error = $cust_main_invoice->delete;
2630         warn $error if $error;
2631       }
2632     }
2633     if ( $self->custnum ) {
2634       @cust_main_invoice =
2635         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2636     } else {
2637       @cust_main_invoice = ();
2638     }
2639     my %seen = map { $_->address => 1 } @cust_main_invoice;
2640     foreach my $address ( @{$arrayref} ) {
2641       next if exists $seen{$address} && $seen{$address};
2642       $seen{$address} = 1;
2643       my $cust_main_invoice = new FS::cust_main_invoice ( {
2644         'custnum' => $self->custnum,
2645         'dest'    => $address,
2646       } );
2647       my $error = $cust_main_invoice->insert;
2648       warn $error if $error;
2649     }
2650   }
2651   if ( $self->custnum ) {
2652     map { $_->address }
2653       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2654   } else {
2655     ();
2656   }
2657 }
2658
2659 =item check_invoicing_list ARRAYREF
2660
2661 Checks these arguements as valid input for the invoicing_list method.  If there
2662 is an error, returns the error, otherwise returns false.
2663
2664 =cut
2665
2666 sub check_invoicing_list {
2667   my( $self, $arrayref ) = @_;
2668   foreach my $address ( @{$arrayref} ) {
2669
2670     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2671       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2672     }
2673
2674     my $cust_main_invoice = new FS::cust_main_invoice ( {
2675       'custnum' => $self->custnum,
2676       'dest'    => $address,
2677     } );
2678     my $error = $self->custnum
2679                 ? $cust_main_invoice->check
2680                 : $cust_main_invoice->checkdest
2681     ;
2682     return $error if $error;
2683   }
2684   '';
2685 }
2686
2687 =item set_default_invoicing_list
2688
2689 Sets the invoicing list to all accounts associated with this customer,
2690 overwriting any previous invoicing list.
2691
2692 =cut
2693
2694 sub set_default_invoicing_list {
2695   my $self = shift;
2696   $self->invoicing_list($self->all_emails);
2697 }
2698
2699 =item all_emails
2700
2701 Returns the email addresses of all accounts provisioned for this customer.
2702
2703 =cut
2704
2705 sub all_emails {
2706   my $self = shift;
2707   my %list;
2708   foreach my $cust_pkg ( $self->all_pkgs ) {
2709     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2710     my @svc_acct =
2711       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2712         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2713           @cust_svc;
2714     $list{$_}=1 foreach map { $_->email } @svc_acct;
2715   }
2716   keys %list;
2717 }
2718
2719 =item invoicing_list_addpost
2720
2721 Adds postal invoicing to this customer.  If this customer is already configured
2722 to receive postal invoices, does nothing.
2723
2724 =cut
2725
2726 sub invoicing_list_addpost {
2727   my $self = shift;
2728   return if grep { $_ eq 'POST' } $self->invoicing_list;
2729   my @invoicing_list = $self->invoicing_list;
2730   push @invoicing_list, 'POST';
2731   $self->invoicing_list(\@invoicing_list);
2732 }
2733
2734 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2735
2736 Returns an array of customers referred by this customer (referral_custnum set
2737 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2738 customers referred by customers referred by this customer and so on, inclusive.
2739 The default behavior is DEPTH 1 (no recursion).
2740
2741 =cut
2742
2743 sub referral_cust_main {
2744   my $self = shift;
2745   my $depth = @_ ? shift : 1;
2746   my $exclude = @_ ? shift : {};
2747
2748   my @cust_main =
2749     map { $exclude->{$_->custnum}++; $_; }
2750       grep { ! $exclude->{ $_->custnum } }
2751         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2752
2753   if ( $depth > 1 ) {
2754     push @cust_main,
2755       map { $_->referral_cust_main($depth-1, $exclude) }
2756         @cust_main;
2757   }
2758
2759   @cust_main;
2760 }
2761
2762 =item referral_cust_main_ncancelled
2763
2764 Same as referral_cust_main, except only returns customers with uncancelled
2765 packages.
2766
2767 =cut
2768
2769 sub referral_cust_main_ncancelled {
2770   my $self = shift;
2771   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2772 }
2773
2774 =item referral_cust_pkg [ DEPTH ]
2775
2776 Like referral_cust_main, except returns a flat list of all unsuspended (and
2777 uncancelled) packages for each customer.  The number of items in this list may
2778 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2779
2780 =cut
2781
2782 sub referral_cust_pkg {
2783   my $self = shift;
2784   my $depth = @_ ? shift : 1;
2785
2786   map { $_->unsuspended_pkgs }
2787     grep { $_->unsuspended_pkgs }
2788       $self->referral_cust_main($depth);
2789 }
2790
2791 =item referring_cust_main
2792
2793 Returns the single cust_main record for the customer who referred this customer
2794 (referral_custnum), or false.
2795
2796 =cut
2797
2798 sub referring_cust_main {
2799   my $self = shift;
2800   return '' unless $self->referral_custnum;
2801   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2802 }
2803
2804 =item credit AMOUNT, REASON
2805
2806 Applies a credit to this customer.  If there is an error, returns the error,
2807 otherwise returns false.
2808
2809 =cut
2810
2811 sub credit {
2812   my( $self, $amount, $reason ) = @_;
2813   my $cust_credit = new FS::cust_credit {
2814     'custnum' => $self->custnum,
2815     'amount'  => $amount,
2816     'reason'  => $reason,
2817   };
2818   $cust_credit->insert;
2819 }
2820
2821 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2822
2823 Creates a one-time charge for this customer.  If there is an error, returns
2824 the error, otherwise returns false.
2825
2826 =cut
2827
2828 sub charge {
2829   my ( $self, $amount ) = ( shift, shift );
2830   my $pkg      = @_ ? shift : 'One-time charge';
2831   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2832   my $taxclass = @_ ? shift : '';
2833
2834   local $SIG{HUP} = 'IGNORE';
2835   local $SIG{INT} = 'IGNORE';
2836   local $SIG{QUIT} = 'IGNORE';
2837   local $SIG{TERM} = 'IGNORE';
2838   local $SIG{TSTP} = 'IGNORE';
2839   local $SIG{PIPE} = 'IGNORE';
2840
2841   my $oldAutoCommit = $FS::UID::AutoCommit;
2842   local $FS::UID::AutoCommit = 0;
2843   my $dbh = dbh;
2844
2845   my $part_pkg = new FS::part_pkg ( {
2846     'pkg'      => $pkg,
2847     'comment'  => $comment,
2848     #'setup'    => $amount,
2849     #'recur'    => '0',
2850     'plan'     => 'flat',
2851     'plandata' => "setup_fee=$amount",
2852     'freq'     => 0,
2853     'disabled' => 'Y',
2854     'taxclass' => $taxclass,
2855   } );
2856
2857   my $error = $part_pkg->insert;
2858   if ( $error ) {
2859     $dbh->rollback if $oldAutoCommit;
2860     return $error;
2861   }
2862
2863   my $pkgpart = $part_pkg->pkgpart;
2864   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2865   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2866     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2867     $error = $type_pkgs->insert;
2868     if ( $error ) {
2869       $dbh->rollback if $oldAutoCommit;
2870       return $error;
2871     }
2872   }
2873
2874   my $cust_pkg = new FS::cust_pkg ( {
2875     'custnum' => $self->custnum,
2876     'pkgpart' => $pkgpart,
2877   } );
2878
2879   $error = $cust_pkg->insert;
2880   if ( $error ) {
2881     $dbh->rollback if $oldAutoCommit;
2882     return $error;
2883   }
2884
2885   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2886   '';
2887
2888 }
2889
2890 =item cust_bill
2891
2892 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2893
2894 =cut
2895
2896 sub cust_bill {
2897   my $self = shift;
2898   sort { $a->_date <=> $b->_date }
2899     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2900 }
2901
2902 =item open_cust_bill
2903
2904 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2905 customer.
2906
2907 =cut
2908
2909 sub open_cust_bill {
2910   my $self = shift;
2911   grep { $_->owed > 0 } $self->cust_bill;
2912 }
2913
2914 =item cust_credit
2915
2916 Returns all the credits (see L<FS::cust_credit>) for this customer.
2917
2918 =cut
2919
2920 sub cust_credit {
2921   my $self = shift;
2922   sort { $a->_date <=> $b->_date }
2923     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2924 }
2925
2926 =item cust_pay
2927
2928 Returns all the payments (see L<FS::cust_pay>) for this customer.
2929
2930 =cut
2931
2932 sub cust_pay {
2933   my $self = shift;
2934   sort { $a->_date <=> $b->_date }
2935     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2936 }
2937
2938 =item cust_pay_void
2939
2940 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2941
2942 =cut
2943
2944 sub cust_pay_void {
2945   my $self = shift;
2946   sort { $a->_date <=> $b->_date }
2947     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2948 }
2949
2950
2951 =item cust_refund
2952
2953 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2954
2955 =cut
2956
2957 sub cust_refund {
2958   my $self = shift;
2959   sort { $a->_date <=> $b->_date }
2960     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2961 }
2962
2963 =item select_for_update
2964
2965 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2966 a mutex.
2967
2968 =cut
2969
2970 sub select_for_update {
2971   my $self = shift;
2972   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2973 }
2974
2975 =item name
2976
2977 Returns a name string for this customer, either "Company (Last, First)" or
2978 "Last, First".
2979
2980 =cut
2981
2982 sub name {
2983   my $self = shift;
2984   my $name = $self->get('last'). ', '. $self->first;
2985   $name = $self->company. " ($name)" if $self->company;
2986   $name;
2987 }
2988
2989 =item status
2990
2991 Returns a status string for this customer, currently:
2992
2993 =over 4
2994
2995 =item prospect - No packages have ever been ordered
2996
2997 =item active - One or more recurring packages is active
2998
2999 =item suspended - All non-cancelled recurring packages are suspended
3000
3001 =item cancelled - All recurring packages are cancelled
3002
3003 =back
3004
3005 =cut
3006
3007 sub status {
3008   my $self = shift;
3009   for my $status (qw( prospect active suspended cancelled )) {
3010     my $method = $status.'_sql';
3011     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3012     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3013     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3014     return $status if $sth->fetchrow_arrayref->[0];
3015   }
3016 }
3017
3018 =item statuscolor
3019
3020 Returns a hex triplet color string for this customer's status.
3021
3022 =cut
3023
3024 my %statuscolor = (
3025   'prospect'  => '000000',
3026   'active'    => '00CC00',
3027   'suspended' => 'FF9900',
3028   'cancelled' => 'FF0000',
3029 );
3030 sub statuscolor {
3031   my $self = shift;
3032   $statuscolor{$self->status};
3033 }
3034
3035 =back
3036
3037 =head1 CLASS METHODS
3038
3039 =over 4
3040
3041 =item prospect_sql
3042
3043 Returns an SQL expression identifying prospective cust_main records (customers
3044 with no packages ever ordered)
3045
3046 =cut
3047
3048 sub prospect_sql { "
3049   0 = ( SELECT COUNT(*) FROM cust_pkg
3050           WHERE cust_pkg.custnum = cust_main.custnum
3051       )
3052 "; }
3053
3054 =item active_sql
3055
3056 Returns an SQL expression identifying active cust_main records.
3057
3058 =cut
3059
3060 sub active_sql { "
3061   0 < ( SELECT COUNT(*) FROM cust_pkg
3062           WHERE cust_pkg.custnum = cust_main.custnum
3063             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3064             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
3065       )
3066 "; }
3067
3068 =item susp_sql
3069 =item suspended_sql
3070
3071 Returns an SQL expression identifying suspended cust_main records.
3072
3073 =cut
3074
3075 sub suspended_sql { susp_sql(@_); }
3076 sub susp_sql { "
3077     0 < ( SELECT COUNT(*) FROM cust_pkg
3078             WHERE cust_pkg.custnum = cust_main.custnum
3079               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3080         )
3081     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3082                 WHERE cust_pkg.custnum = cust_main.custnum
3083                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3084                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3085             )
3086 "; }
3087
3088 =item cancel_sql
3089 =item cancelled_sql
3090
3091 Returns an SQL expression identifying cancelled cust_main records.
3092
3093 =cut
3094
3095 sub cancelled_sql { cancel_sql(@_); }
3096 sub cancel_sql { "
3097   0 < ( SELECT COUNT(*) FROM cust_pkg
3098           WHERE cust_pkg.custnum = cust_main.custnum
3099       )
3100   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3101               WHERE cust_pkg.custnum = cust_main.custnum
3102                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3103           )
3104 "; }
3105
3106 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3107
3108 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3109 records.  Currently, only I<last> or I<company> may be specified (the
3110 appropriate ship_ field is also searched if applicable).
3111
3112 Additional options are the same as FS::Record::qsearch
3113
3114 =cut
3115
3116 sub fuzzy_search {
3117   my( $self, $fuzzy, $hash, @opt) = @_;
3118   #$self
3119   $hash ||= {};
3120   my @cust_main = ();
3121
3122   check_and_rebuild_fuzzyfiles();
3123   foreach my $field ( keys %$fuzzy ) {
3124     my $sub = \&{"all_$field"};
3125     my %match = ();
3126     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3127
3128     foreach ( keys %match ) {
3129       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3130       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3131         if defined dbdef->table('cust_main')->column('ship_last');
3132     }
3133   }
3134
3135   my %saw = ();
3136   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3137
3138   @cust_main;
3139
3140 }
3141
3142 =back
3143
3144 =head1 SUBROUTINES
3145
3146 =over 4
3147
3148 =item smart_search OPTION => VALUE ...
3149
3150 Accepts the following options: I<search>, the string to search for.  The string
3151 will be searched for as a customer number, last name or company name, first
3152 searching for an exact match then fuzzy and substring matches.
3153
3154 Any additional options treated as an additional qualifier on the search
3155 (i.e. I<agentnum>).
3156
3157 Returns a (possibly empty) array of FS::cust_main objects.
3158
3159 =cut
3160
3161 sub smart_search {
3162   my %options = @_;
3163   my $search = delete $options{'search'};
3164   my @cust_main = ();
3165
3166   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3167
3168     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3169
3170   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3171
3172     my $value = lc($1);
3173     my $q_value = dbh->quote($value);
3174
3175     #exact
3176     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3177     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3178     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3179       if defined dbdef->table('cust_main')->column('ship_last');
3180     $sql .= ' )';
3181
3182     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3183
3184     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3185
3186       #still some false laziness w/ search/cust_main.cgi
3187
3188       #substring
3189       push @cust_main, qsearch( 'cust_main',
3190                                 { 'last'     => { 'op'    => 'ILIKE',
3191                                                   'value' => "%$q_value%" },
3192                                   %options,
3193                                 }
3194                               );
3195       push @cust_main, qsearch( 'cust_main',
3196                                 { 'ship_last' => { 'op'    => 'ILIKE',
3197                                                    'value' => "%$q_value%" },
3198                                   %options,
3199
3200                                 }
3201                               )
3202         if defined dbdef->table('cust_main')->column('ship_last');
3203
3204       push @cust_main, qsearch( 'cust_main',
3205                                 { 'company'  => { 'op'    => 'ILIKE',
3206                                                   'value' => "%$q_value%" },
3207                                   %options,
3208                                 }
3209                               );
3210       push @cust_main, qsearch( 'cust_main',
3211                                 { 'ship_company' => { 'op' => 'ILIKE',
3212                                                    'value' => "%$q_value%" },
3213                                   %options,
3214                                 }
3215                               )
3216         if defined dbdef->table('cust_main')->column('ship_last');
3217
3218       #fuzzy
3219       push @cust_main, FS::cust_main->fuzzy_search(
3220         { 'last'     => $value },
3221         \%options,
3222       );
3223       push @cust_main, FS::cust_main->fuzzy_search(
3224         { 'company'  => $value },
3225         \%options,
3226       );
3227
3228     }
3229
3230   }
3231
3232   @cust_main;
3233
3234 }
3235
3236 =item check_and_rebuild_fuzzyfiles
3237
3238 =cut
3239
3240 sub check_and_rebuild_fuzzyfiles {
3241   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3242   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3243     or &rebuild_fuzzyfiles;
3244 }
3245
3246 =item rebuild_fuzzyfiles
3247
3248 =cut
3249
3250 sub rebuild_fuzzyfiles {
3251
3252   use Fcntl qw(:flock);
3253
3254   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3255
3256   #last
3257
3258   open(LASTLOCK,">>$dir/cust_main.last")
3259     or die "can't open $dir/cust_main.last: $!";
3260   flock(LASTLOCK,LOCK_EX)
3261     or die "can't lock $dir/cust_main.last: $!";
3262
3263   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3264   push @all_last,
3265                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3266     if defined dbdef->table('cust_main')->column('ship_last');
3267
3268   open (LASTCACHE,">$dir/cust_main.last.tmp")
3269     or die "can't open $dir/cust_main.last.tmp: $!";
3270   print LASTCACHE join("\n", @all_last), "\n";
3271   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3272
3273   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3274   close LASTLOCK;
3275
3276   #company
3277
3278   open(COMPANYLOCK,">>$dir/cust_main.company")
3279     or die "can't open $dir/cust_main.company: $!";
3280   flock(COMPANYLOCK,LOCK_EX)
3281     or die "can't lock $dir/cust_main.company: $!";
3282
3283   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3284   push @all_company,
3285        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3286     if defined dbdef->table('cust_main')->column('ship_last');
3287
3288   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3289     or die "can't open $dir/cust_main.company.tmp: $!";
3290   print COMPANYCACHE join("\n", @all_company), "\n";
3291   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3292
3293   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3294   close COMPANYLOCK;
3295
3296 }
3297
3298 =item all_last
3299
3300 =cut
3301
3302 sub all_last {
3303   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3304   open(LASTCACHE,"<$dir/cust_main.last")
3305     or die "can't open $dir/cust_main.last: $!";
3306   my @array = map { chomp; $_; } <LASTCACHE>;
3307   close LASTCACHE;
3308   \@array;
3309 }
3310
3311 =item all_company
3312
3313 =cut
3314
3315 sub all_company {
3316   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3317   open(COMPANYCACHE,"<$dir/cust_main.company")
3318     or die "can't open $dir/cust_main.last: $!";
3319   my @array = map { chomp; $_; } <COMPANYCACHE>;
3320   close COMPANYCACHE;
3321   \@array;
3322 }
3323
3324 =item append_fuzzyfiles LASTNAME COMPANY
3325
3326 =cut
3327
3328 sub append_fuzzyfiles {
3329   my( $last, $company ) = @_;
3330
3331   &check_and_rebuild_fuzzyfiles;
3332
3333   use Fcntl qw(:flock);
3334
3335   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3336
3337   if ( $last ) {
3338
3339     open(LAST,">>$dir/cust_main.last")
3340       or die "can't open $dir/cust_main.last: $!";
3341     flock(LAST,LOCK_EX)
3342       or die "can't lock $dir/cust_main.last: $!";
3343
3344     print LAST "$last\n";
3345
3346     flock(LAST,LOCK_UN)
3347       or die "can't unlock $dir/cust_main.last: $!";
3348     close LAST;
3349   }
3350
3351   if ( $company ) {
3352
3353     open(COMPANY,">>$dir/cust_main.company")
3354       or die "can't open $dir/cust_main.company: $!";
3355     flock(COMPANY,LOCK_EX)
3356       or die "can't lock $dir/cust_main.company: $!";
3357
3358     print COMPANY "$company\n";
3359
3360     flock(COMPANY,LOCK_UN)
3361       or die "can't unlock $dir/cust_main.company: $!";
3362
3363     close COMPANY;
3364   }
3365
3366   1;
3367 }
3368
3369 =item batch_import
3370
3371 =cut
3372
3373 sub batch_import {
3374   my $param = shift;
3375   #warn join('-',keys %$param);
3376   my $fh = $param->{filehandle};
3377   my $agentnum = $param->{agentnum};
3378   my $refnum = $param->{refnum};
3379   my $pkgpart = $param->{pkgpart};
3380   my @fields = @{$param->{fields}};
3381
3382   eval "use Date::Parse;";
3383   die $@ if $@;
3384   eval "use Text::CSV_XS;";
3385   die $@ if $@;
3386
3387   my $csv = new Text::CSV_XS;
3388   #warn $csv;
3389   #warn $fh;
3390
3391   my $imported = 0;
3392   #my $columns;
3393
3394   local $SIG{HUP} = 'IGNORE';
3395   local $SIG{INT} = 'IGNORE';
3396   local $SIG{QUIT} = 'IGNORE';
3397   local $SIG{TERM} = 'IGNORE';
3398   local $SIG{TSTP} = 'IGNORE';
3399   local $SIG{PIPE} = 'IGNORE';
3400
3401   my $oldAutoCommit = $FS::UID::AutoCommit;
3402   local $FS::UID::AutoCommit = 0;
3403   my $dbh = dbh;
3404
3405   #while ( $columns = $csv->getline($fh) ) {
3406   my $line;
3407   while ( defined($line=<$fh>) ) {
3408
3409     $csv->parse($line) or do {
3410       $dbh->rollback if $oldAutoCommit;
3411       return "can't parse: ". $csv->error_input();
3412     };
3413
3414     my @columns = $csv->fields();
3415     #warn join('-',@columns);
3416
3417     my %cust_main = (
3418       agentnum => $agentnum,
3419       refnum   => $refnum,
3420       country  => $conf->config('countrydefault') || 'US',
3421       payby    => 'BILL', #default
3422       paydate  => '12/2037', #default
3423     );
3424     my $billtime = time;
3425     my %cust_pkg = ( pkgpart => $pkgpart );
3426     foreach my $field ( @fields ) {
3427       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3428         #$cust_pkg{$1} = str2time( shift @$columns );
3429         if ( $1 eq 'setup' ) {
3430           $billtime = str2time(shift @columns);
3431         } else {
3432           $cust_pkg{$1} = str2time( shift @columns );
3433         }
3434       } else {
3435         #$cust_main{$field} = shift @$columns;
3436         $cust_main{$field} = shift @columns;
3437       }
3438     }
3439
3440     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3441     my $cust_main = new FS::cust_main ( \%cust_main );
3442     use Tie::RefHash;
3443     tie my %hash, 'Tie::RefHash'; #this part is important
3444     $hash{$cust_pkg} = [] if $pkgpart;
3445     my $error = $cust_main->insert( \%hash );
3446
3447     if ( $error ) {
3448       $dbh->rollback if $oldAutoCommit;
3449       return "can't insert customer for $line: $error";
3450     }
3451
3452     #false laziness w/bill.cgi
3453     $error = $cust_main->bill( 'time' => $billtime );
3454     if ( $error ) {
3455       $dbh->rollback if $oldAutoCommit;
3456       return "can't bill customer for $line: $error";
3457     }
3458
3459     $cust_main->apply_payments;
3460     $cust_main->apply_credits;
3461
3462     $error = $cust_main->collect();
3463     if ( $error ) {
3464       $dbh->rollback if $oldAutoCommit;
3465       return "can't collect customer for $line: $error";
3466     }
3467
3468     $imported++;
3469   }
3470
3471   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3472
3473   return "Empty file!" unless $imported;
3474
3475   ''; #no error
3476
3477 }
3478
3479 =item batch_charge
3480
3481 =cut
3482
3483 sub batch_charge {
3484   my $param = shift;
3485   #warn join('-',keys %$param);
3486   my $fh = $param->{filehandle};
3487   my @fields = @{$param->{fields}};
3488
3489   eval "use Date::Parse;";
3490   die $@ if $@;
3491   eval "use Text::CSV_XS;";
3492   die $@ if $@;
3493
3494   my $csv = new Text::CSV_XS;
3495   #warn $csv;
3496   #warn $fh;
3497
3498   my $imported = 0;
3499   #my $columns;
3500
3501   local $SIG{HUP} = 'IGNORE';
3502   local $SIG{INT} = 'IGNORE';
3503   local $SIG{QUIT} = 'IGNORE';
3504   local $SIG{TERM} = 'IGNORE';
3505   local $SIG{TSTP} = 'IGNORE';
3506   local $SIG{PIPE} = 'IGNORE';
3507
3508   my $oldAutoCommit = $FS::UID::AutoCommit;
3509   local $FS::UID::AutoCommit = 0;
3510   my $dbh = dbh;
3511
3512   #while ( $columns = $csv->getline($fh) ) {
3513   my $line;
3514   while ( defined($line=<$fh>) ) {
3515
3516     $csv->parse($line) or do {
3517       $dbh->rollback if $oldAutoCommit;
3518       return "can't parse: ". $csv->error_input();
3519     };
3520
3521     my @columns = $csv->fields();
3522     #warn join('-',@columns);
3523
3524     my %row = ();
3525     foreach my $field ( @fields ) {
3526       $row{$field} = shift @columns;
3527     }
3528
3529     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3530     unless ( $cust_main ) {
3531       $dbh->rollback if $oldAutoCommit;
3532       return "unknown custnum $row{'custnum'}";
3533     }
3534
3535     if ( $row{'amount'} > 0 ) {
3536       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3537       if ( $error ) {
3538         $dbh->rollback if $oldAutoCommit;
3539         return $error;
3540       }
3541       $imported++;
3542     } elsif ( $row{'amount'} < 0 ) {
3543       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3544                                       $row{'pkg'}                         );
3545       if ( $error ) {
3546         $dbh->rollback if $oldAutoCommit;
3547         return $error;
3548       }
3549       $imported++;
3550     } else {
3551       #hmm?
3552     }
3553
3554   }
3555
3556   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3557
3558   return "Empty file!" unless $imported;
3559
3560   ''; #no error
3561
3562 }
3563
3564 =back
3565
3566 =head1 BUGS
3567
3568 The delete method.
3569
3570 The delete method should possibly take an FS::cust_main object reference
3571 instead of a scalar customer number.
3572
3573 Bill and collect options should probably be passed as references instead of a
3574 list.
3575
3576 There should probably be a configuration file with a list of allowed credit
3577 card types.
3578
3579 No multiple currency support (probably a larger project than just this module).
3580
3581 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3582
3583 =head1 SEE ALSO
3584
3585 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3586 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3587 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3588
3589 =cut
3590
3591 1;
3592