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
1911   my $email = ($conf->exists('business-onlinepayment-email-override'))
1912               ? $conf->config('business-onlinepayment-email-override')
1913               : $invoicing_list[0];
1914
1915   my $payinfo = exists($options{'payinfo'})
1916                   ? $options{'payinfo'}
1917                   : $self->payinfo;
1918
1919   my %content = ();
1920   if ( $method eq 'CC' ) {
1921
1922     $content{card_number} = $payinfo;
1923     my $paydate = exists($options{'paydate'})
1924                     ? $options{'paydate'}
1925                     : $self->paydate;
1926     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1927     $content{expiration} = "$2/$1";
1928
1929     if ( defined $self->dbdef_table->column('paycvv') ) {
1930       my $paycvv = exists($options{'paycvv'})
1931                      ? $options{'paycvv'}
1932                      : $self->paycvv;
1933       $content{cvv2} = $self->paycvv
1934         if length($paycvv);
1935     }
1936
1937     $content{recurring_billing} = 'YES'
1938       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1939                                'payby'   => 'CARD',
1940                                'payinfo' => $payinfo,
1941                              } );
1942
1943   } elsif ( $method eq 'ECHECK' ) {
1944     ( $content{account_number}, $content{routing_code} ) =
1945       split('@', $payinfo);
1946     $content{bank_name} = $o_payname;
1947     $content{account_type} = 'CHECKING';
1948     $content{account_name} = $payname;
1949     $content{customer_org} = $self->company ? 'B' : 'I';
1950     $content{customer_ssn} = exists($options{'ss'})
1951                                ? $options{'ss'}
1952                                : $self->ss;
1953   } elsif ( $method eq 'LEC' ) {
1954     $content{phone} = $payinfo;
1955   }
1956
1957   #transaction(s)
1958
1959   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1960
1961   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1962   $transaction->content(
1963     'type'           => $method,
1964     'login'          => $login,
1965     'password'       => $password,
1966     'action'         => $action1,
1967     'description'    => $options{'description'},
1968     'amount'         => $amount,
1969     'invoice_number' => $options{'invnum'},
1970     'customer_id'    => $self->custnum,
1971     'last_name'      => $paylast,
1972     'first_name'     => $payfirst,
1973     'name'           => $payname,
1974     'address'        => $address,
1975     'city'           => ( exists($options{'city'})
1976                             ? $options{'city'}
1977                             : $self->city          ),
1978     'state'          => ( exists($options{'state'})
1979                             ? $options{'state'}
1980                             : $self->state          ),
1981     'zip'            => ( exists($options{'zip'})
1982                             ? $options{'zip'}
1983                             : $self->zip          ),
1984     'country'        => ( exists($options{'country'})
1985                             ? $options{'country'}
1986                             : $self->country          ),
1987     'referer'        => 'http://cleanwhisker.420.am/',
1988     'email'          => $email,
1989     'phone'          => $self->daytime || $self->night,
1990     %content, #after
1991   );
1992   $transaction->submit();
1993
1994   if ( $transaction->is_success() && $action2 ) {
1995     my $auth = $transaction->authorization;
1996     my $ordernum = $transaction->can('order_number')
1997                    ? $transaction->order_number
1998                    : '';
1999
2000     my $capture =
2001       new Business::OnlinePayment( $processor, @bop_options );
2002
2003     my %capture = (
2004       %content,
2005       type           => $method,
2006       action         => $action2,
2007       login          => $login,
2008       password       => $password,
2009       order_number   => $ordernum,
2010       amount         => $amount,
2011       authorization  => $auth,
2012       description    => $options{'description'},
2013     );
2014
2015     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
2016                            transaction_sequence_num local_transaction_date
2017                            local_transaction_time AVS_result_code          )) {
2018       $capture{$field} = $transaction->$field() if $transaction->can($field);
2019     }
2020
2021     $capture->content( %capture );
2022
2023     $capture->submit();
2024
2025     unless ( $capture->is_success ) {
2026       my $e = "Authorization sucessful but capture failed, custnum #".
2027               $self->custnum. ': '.  $capture->result_code.
2028               ": ". $capture->error_message;
2029       warn $e;
2030       return $e;
2031     }
2032
2033   }
2034
2035   #remove paycvv after initial transaction
2036   #false laziness w/misc/process/payment.cgi - check both to make sure working
2037   # correctly
2038   if ( defined $self->dbdef_table->column('paycvv')
2039        && length($self->paycvv)
2040        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
2041   ) {
2042     my $error = $self->remove_cvv;
2043     if ( $error ) {
2044       warn "error removing cvv: $error\n";
2045     }
2046   }
2047
2048   #result handling
2049   if ( $transaction->is_success() ) {
2050
2051     my %method2payby = (
2052       'CC'     => 'CARD',
2053       'ECHECK' => 'CHEK',
2054       'LEC'    => 'LECB',
2055     );
2056
2057     my $paybatch = "$processor:". $transaction->authorization;
2058     $paybatch .= ':'. $transaction->order_number
2059       if $transaction->can('order_number')
2060       && length($transaction->order_number);
2061
2062     my $cust_pay = new FS::cust_pay ( {
2063        'custnum'  => $self->custnum,
2064        'invnum'   => $options{'invnum'},
2065        'paid'     => $amount,
2066        '_date'     => '',
2067        'payby'    => $method2payby{$method},
2068        'payinfo'  => $payinfo,
2069        'paybatch' => $paybatch,
2070     } );
2071     my $error = $cust_pay->insert;
2072     if ( $error ) {
2073       $cust_pay->invnum(''); #try again with no specific invnum
2074       my $error2 = $cust_pay->insert;
2075       if ( $error2 ) {
2076         # gah, even with transactions.
2077         my $e = 'WARNING: Card/ACH debited but database not updated - '.
2078                 "error inserting payment ($processor): $error2".
2079                 " (previously tried insert with invnum #$options{'invnum'}" .
2080                 ": $error )";
2081         warn $e;
2082         return $e;
2083       }
2084     }
2085     return ''; #no error
2086
2087   } else {
2088
2089     my $perror = "$processor error: ". $transaction->error_message;
2090
2091     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
2092          && $conf->exists('emaildecline')
2093          && grep { $_ ne 'POST' } $self->invoicing_list
2094          && ! grep { $transaction->error_message =~ /$_/ }
2095                    $conf->config('emaildecline-exclude')
2096     ) {
2097       my @templ = $conf->config('declinetemplate');
2098       my $template = new Text::Template (
2099         TYPE   => 'ARRAY',
2100         SOURCE => [ map "$_\n", @templ ],
2101       ) or return "($perror) can't create template: $Text::Template::ERROR";
2102       $template->compile()
2103         or return "($perror) can't compile template: $Text::Template::ERROR";
2104
2105       my $templ_hash = { error => $transaction->error_message };
2106
2107       my $error = send_email(
2108         'from'    => $conf->config('invoice_from'),
2109         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
2110         'subject' => 'Your payment could not be processed',
2111         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
2112       );
2113
2114       $perror .= " (also received error sending decline notification: $error)"
2115         if $error;
2116
2117     }
2118
2119     return $perror;
2120   }
2121
2122 }
2123
2124 =item remove_cvv
2125
2126 Removes the I<paycvv> field from the database directly.
2127
2128 If there is an error, returns the error, otherwise returns false.
2129
2130 =cut
2131
2132 sub remove_cvv {
2133   my $self = shift;
2134   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2135     or return dbh->errstr;
2136   $sth->execute($self->custnum)
2137     or return $sth->errstr;
2138   $self->paycvv('');
2139   '';
2140 }
2141
2142 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2143
2144 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2145 via a Business::OnlinePayment realtime gateway.  See
2146 L<http://420.am/business-onlinepayment> for supported gateways.
2147
2148 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2149
2150 Available options are: I<amount>, I<reason>, I<paynum>
2151
2152 Most gateways require a reference to an original payment transaction to refund,
2153 so you probably need to specify a I<paynum>.
2154
2155 I<amount> defaults to the original amount of the payment if not specified.
2156
2157 I<reason> specifies a reason for the refund.
2158
2159 Implementation note: If I<amount> is unspecified or equal to the amount of the
2160 orignal payment, first an attempt is made to "void" the transaction via
2161 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2162 the normal attempt is made to "refund" ("credit") the transaction via the
2163 gateway is attempted.
2164
2165 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2166 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2167 #if set, will override the value from the customer record.
2168
2169 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2170 #specified invoice.  If you don't specify an I<invnum> you might want to
2171 #call the B<apply_payments> method.
2172
2173 =cut
2174
2175 #some false laziness w/realtime_bop, not enough to make it worth merging
2176 #but some useful small subs should be pulled out
2177 sub realtime_refund_bop {
2178   my( $self, $method, %options ) = @_;
2179   if ( $DEBUG ) {
2180     warn "$self $method refund\n";
2181     warn "  $_ => $options{$_}\n" foreach keys %options;
2182   }
2183
2184   #pre-requisites
2185   die "Real-time processing not enabled\n"
2186     unless $conf->exists('business-onlinepayment');
2187   eval "use Business::OnlinePayment";
2188   die $@ if $@;
2189
2190   #load up config
2191   my $bop_config = 'business-onlinepayment';
2192   $bop_config .= '-ach'
2193     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2194   my ( $processor, $login, $password, $unused_action, @bop_options ) =
2195     $conf->config($bop_config);
2196   #$action ||= 'normal authorization';
2197   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2198   die "No real-time processor is enabled - ".
2199       "did you set the business-onlinepayment configuration value?\n"
2200     unless $processor;
2201
2202   my $cust_pay = '';
2203   my $amount = $options{'amount'};
2204   my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2205   if ( $options{'paynum'} ) {
2206     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2207     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2208       or return "Unknown paynum $options{'paynum'}";
2209     $amount ||= $cust_pay->paid;
2210     $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/
2211       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2212                 $cust_pay->paybatch;
2213     ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2214     return "processor of payment $options{'paynum'} $pay_processor does not".
2215            " match current processor $processor"
2216       unless $pay_processor eq $processor;
2217   }
2218   return "neither amount nor paynum specified" unless $amount;
2219
2220   my %content = (
2221     'type'           => $method,
2222     'login'          => $login,
2223     'password'       => $password,
2224     'order_number'   => $order_number,
2225     'amount'         => $amount,
2226     'referer'        => 'http://cleanwhisker.420.am/',
2227   );
2228   $content{authorization} = $auth
2229     if length($auth); #echeck/ACH transactions have an order # but no auth
2230                       #(at least with authorize.net)
2231
2232   #first try void if applicable
2233   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2234     warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG;
2235     my $void = new Business::OnlinePayment( $processor, @bop_options );
2236     $void->content( 'action' => 'void', %content );
2237     $void->submit();
2238     if ( $void->is_success ) {
2239       my $error = $cust_pay->void($options{'reason'});
2240       if ( $error ) {
2241         # gah, even with transactions.
2242         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2243                 "error voiding payment: $error";
2244         warn $e;
2245         return $e;
2246       }
2247       warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG;
2248       return '';
2249     }
2250   }
2251
2252   warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n"
2253     if $DEBUG;
2254
2255   #massage data
2256   my $address = $self->address1;
2257   $address .= ", ". $self->address2 if $self->address2;
2258
2259   my($payname, $payfirst, $paylast);
2260   if ( $self->payname && $method ne 'ECHECK' ) {
2261     $payname = $self->payname;
2262     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2263       or return "Illegal payname $payname";
2264     ($payfirst, $paylast) = ($1, $2);
2265   } else {
2266     $payfirst = $self->getfield('first');
2267     $paylast = $self->getfield('last');
2268     $payname =  "$payfirst $paylast";
2269   }
2270
2271   my $payinfo = '';
2272   if ( $method eq 'CC' ) {
2273
2274     if ( $cust_pay ) {
2275       $content{card_number} = $payinfo = $cust_pay->payinfo;
2276       #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2277       #$content{expiration} = "$2/$1";
2278     } else {
2279       $content{card_number} = $payinfo = $self->payinfo;
2280       $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2281       $content{expiration} = "$2/$1";
2282     }
2283
2284   } elsif ( $method eq 'ECHECK' ) {
2285     ( $content{account_number}, $content{routing_code} ) =
2286       split('@', $payinfo = $self->payinfo);
2287     $content{bank_name} = $self->payname;
2288     $content{account_type} = 'CHECKING';
2289     $content{account_name} = $payname;
2290     $content{customer_org} = $self->company ? 'B' : 'I';
2291     $content{customer_ssn} = $self->ss;
2292   } elsif ( $method eq 'LEC' ) {
2293     $content{phone} = $payinfo = $self->payinfo;
2294   }
2295
2296   #then try refund
2297   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2298   my %sub_content = $refund->content(
2299     'action'         => 'credit',
2300     'customer_id'    => $self->custnum,
2301     'last_name'      => $paylast,
2302     'first_name'     => $payfirst,
2303     'name'           => $payname,
2304     'address'        => $address,
2305     'city'           => $self->city,
2306     'state'          => $self->state,
2307     'zip'            => $self->zip,
2308     'country'        => $self->country,
2309     %content, #after
2310   );
2311   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
2312     if $DEBUG > 1;
2313   $refund->submit();
2314
2315   return "$processor error: ". $refund->error_message
2316     unless $refund->is_success();
2317
2318   my %method2payby = (
2319     'CC'     => 'CARD',
2320     'ECHECK' => 'CHEK',
2321     'LEC'    => 'LECB',
2322   );
2323
2324   my $paybatch = "$processor:". $refund->authorization;
2325   $paybatch .= ':'. $refund->order_number
2326     if $refund->can('order_number') && $refund->order_number;
2327
2328   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2329     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2330     last unless @cust_bill_pay;
2331     my $cust_bill_pay = pop @cust_bill_pay;
2332     my $error = $cust_bill_pay->delete;
2333     last if $error;
2334   }
2335
2336   my $cust_refund = new FS::cust_refund ( {
2337     'custnum'  => $self->custnum,
2338     'paynum'   => $options{'paynum'},
2339     'refund'   => $amount,
2340     '_date'    => '',
2341     'payby'    => $method2payby{$method},
2342     'payinfo'  => $payinfo,
2343     'paybatch' => $paybatch,
2344     'reason'   => $options{'reason'} || 'card or ACH refund',
2345   } );
2346   my $error = $cust_refund->insert;
2347   if ( $error ) {
2348     $cust_refund->paynum(''); #try again with no specific paynum
2349     my $error2 = $cust_refund->insert;
2350     if ( $error2 ) {
2351       # gah, even with transactions.
2352       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2353               "error inserting refund ($processor): $error2".
2354               " (previously tried insert with paynum #$options{'paynum'}" .
2355               ": $error )";
2356       warn $e;
2357       return $e;
2358     }
2359   }
2360
2361   ''; #no error
2362
2363 }
2364
2365 =item total_owed
2366
2367 Returns the total owed for this customer on all invoices
2368 (see L<FS::cust_bill/owed>).
2369
2370 =cut
2371
2372 sub total_owed {
2373   my $self = shift;
2374   $self->total_owed_date(2145859200); #12/31/2037
2375 }
2376
2377 =item total_owed_date TIME
2378
2379 Returns the total owed for this customer on all invoices with date earlier than
2380 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2381 see L<Time::Local> and L<Date::Parse> for conversion functions.
2382
2383 =cut
2384
2385 sub total_owed_date {
2386   my $self = shift;
2387   my $time = shift;
2388   my $total_bill = 0;
2389   foreach my $cust_bill (
2390     grep { $_->_date <= $time }
2391       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2392   ) {
2393     $total_bill += $cust_bill->owed;
2394   }
2395   sprintf( "%.2f", $total_bill );
2396 }
2397
2398 =item apply_credits OPTION => VALUE ...
2399
2400 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2401 to outstanding invoice balances in chronological order (or reverse
2402 chronological order if the I<order> option is set to B<newest>) and returns the
2403 value of any remaining unapplied credits available for refund (see
2404 L<FS::cust_refund>).
2405
2406 =cut
2407
2408 sub apply_credits {
2409   my $self = shift;
2410   my %opt = @_;
2411
2412   return 0 unless $self->total_credited;
2413
2414   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2415       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2416
2417   my @invoices = $self->open_cust_bill;
2418   @invoices = sort { $b->_date <=> $a->_date } @invoices
2419     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2420
2421   my $credit;
2422   foreach my $cust_bill ( @invoices ) {
2423     my $amount;
2424
2425     if ( !defined($credit) || $credit->credited == 0) {
2426       $credit = pop @credits or last;
2427     }
2428
2429     if ($cust_bill->owed >= $credit->credited) {
2430       $amount=$credit->credited;
2431     }else{
2432       $amount=$cust_bill->owed;
2433     }
2434
2435     my $cust_credit_bill = new FS::cust_credit_bill ( {
2436       'crednum' => $credit->crednum,
2437       'invnum'  => $cust_bill->invnum,
2438       'amount'  => $amount,
2439     } );
2440     my $error = $cust_credit_bill->insert;
2441     die $error if $error;
2442
2443     redo if ($cust_bill->owed > 0);
2444
2445   }
2446
2447   return $self->total_credited;
2448 }
2449
2450 =item apply_payments
2451
2452 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2453 to outstanding invoice balances in chronological order.
2454
2455  #and returns the value of any remaining unapplied payments.
2456
2457 =cut
2458
2459 sub apply_payments {
2460   my $self = shift;
2461
2462   #return 0 unless
2463
2464   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2465       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2466
2467   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2468       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2469
2470   my $payment;
2471
2472   foreach my $cust_bill ( @invoices ) {
2473     my $amount;
2474
2475     if ( !defined($payment) || $payment->unapplied == 0 ) {
2476       $payment = pop @payments or last;
2477     }
2478
2479     if ( $cust_bill->owed >= $payment->unapplied ) {
2480       $amount = $payment->unapplied;
2481     } else {
2482       $amount = $cust_bill->owed;
2483     }
2484
2485     my $cust_bill_pay = new FS::cust_bill_pay ( {
2486       'paynum' => $payment->paynum,
2487       'invnum' => $cust_bill->invnum,
2488       'amount' => $amount,
2489     } );
2490     my $error = $cust_bill_pay->insert;
2491     die $error if $error;
2492
2493     redo if ( $cust_bill->owed > 0);
2494
2495   }
2496
2497   return $self->total_unapplied_payments;
2498 }
2499
2500 =item total_credited
2501
2502 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2503 customer.  See L<FS::cust_credit/credited>.
2504
2505 =cut
2506
2507 sub total_credited {
2508   my $self = shift;
2509   my $total_credit = 0;
2510   foreach my $cust_credit ( qsearch('cust_credit', {
2511     'custnum' => $self->custnum,
2512   } ) ) {
2513     $total_credit += $cust_credit->credited;
2514   }
2515   sprintf( "%.2f", $total_credit );
2516 }
2517
2518 =item total_unapplied_payments
2519
2520 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2521 See L<FS::cust_pay/unapplied>.
2522
2523 =cut
2524
2525 sub total_unapplied_payments {
2526   my $self = shift;
2527   my $total_unapplied = 0;
2528   foreach my $cust_pay ( qsearch('cust_pay', {
2529     'custnum' => $self->custnum,
2530   } ) ) {
2531     $total_unapplied += $cust_pay->unapplied;
2532   }
2533   sprintf( "%.2f", $total_unapplied );
2534 }
2535
2536 =item balance
2537
2538 Returns the balance for this customer (total_owed minus total_credited
2539 minus total_unapplied_payments).
2540
2541 =cut
2542
2543 sub balance {
2544   my $self = shift;
2545   sprintf( "%.2f",
2546     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2547   );
2548 }
2549
2550 =item balance_date TIME
2551
2552 Returns the balance for this customer, only considering invoices with date
2553 earlier than TIME (total_owed_date minus total_credited minus
2554 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2555 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2556 functions.
2557
2558 =cut
2559
2560 sub balance_date {
2561   my $self = shift;
2562   my $time = shift;
2563   sprintf( "%.2f",
2564     $self->total_owed_date($time)
2565       - $self->total_credited
2566       - $self->total_unapplied_payments
2567   );
2568 }
2569
2570 =item paydate_monthyear
2571
2572 Returns a two-element list consisting of the month and year of this customer's
2573 paydate (credit card expiration date for CARD customers)
2574
2575 =cut
2576
2577 sub paydate_monthyear {
2578   my $self = shift;
2579   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2580     ( $2, $1 );
2581   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2582     ( $1, $3 );
2583   } else {
2584     ('', '');
2585   }
2586 }
2587
2588 =item payinfo_masked
2589
2590 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.
2591
2592 Credit Cards - Mask all but the last four characters.
2593 Checks - Mask all but last 2 of account number and bank routing number.
2594 Others - Do nothing, return the unmasked string.
2595
2596 =cut
2597
2598 sub payinfo_masked {
2599   my $self = shift;
2600   return $self->paymask;
2601 }
2602
2603 =item invoicing_list [ ARRAYREF ]
2604
2605 If an arguement is given, sets these email addresses as invoice recipients
2606 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2607 (except as warnings), so use check_invoicing_list first.
2608
2609 Returns a list of email addresses (with svcnum entries expanded).
2610
2611 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2612 check it without disturbing anything by passing nothing.
2613
2614 This interface may change in the future.
2615
2616 =cut
2617
2618 sub invoicing_list {
2619   my( $self, $arrayref ) = @_;
2620   if ( $arrayref ) {
2621     my @cust_main_invoice;
2622     if ( $self->custnum ) {
2623       @cust_main_invoice =
2624         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2625     } else {
2626       @cust_main_invoice = ();
2627     }
2628     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2629       #warn $cust_main_invoice->destnum;
2630       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2631         #warn $cust_main_invoice->destnum;
2632         my $error = $cust_main_invoice->delete;
2633         warn $error if $error;
2634       }
2635     }
2636     if ( $self->custnum ) {
2637       @cust_main_invoice =
2638         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2639     } else {
2640       @cust_main_invoice = ();
2641     }
2642     my %seen = map { $_->address => 1 } @cust_main_invoice;
2643     foreach my $address ( @{$arrayref} ) {
2644       next if exists $seen{$address} && $seen{$address};
2645       $seen{$address} = 1;
2646       my $cust_main_invoice = new FS::cust_main_invoice ( {
2647         'custnum' => $self->custnum,
2648         'dest'    => $address,
2649       } );
2650       my $error = $cust_main_invoice->insert;
2651       warn $error if $error;
2652     }
2653   }
2654   if ( $self->custnum ) {
2655     map { $_->address }
2656       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2657   } else {
2658     ();
2659   }
2660 }
2661
2662 =item check_invoicing_list ARRAYREF
2663
2664 Checks these arguements as valid input for the invoicing_list method.  If there
2665 is an error, returns the error, otherwise returns false.
2666
2667 =cut
2668
2669 sub check_invoicing_list {
2670   my( $self, $arrayref ) = @_;
2671   foreach my $address ( @{$arrayref} ) {
2672
2673     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2674       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2675     }
2676
2677     my $cust_main_invoice = new FS::cust_main_invoice ( {
2678       'custnum' => $self->custnum,
2679       'dest'    => $address,
2680     } );
2681     my $error = $self->custnum
2682                 ? $cust_main_invoice->check
2683                 : $cust_main_invoice->checkdest
2684     ;
2685     return $error if $error;
2686   }
2687   '';
2688 }
2689
2690 =item set_default_invoicing_list
2691
2692 Sets the invoicing list to all accounts associated with this customer,
2693 overwriting any previous invoicing list.
2694
2695 =cut
2696
2697 sub set_default_invoicing_list {
2698   my $self = shift;
2699   $self->invoicing_list($self->all_emails);
2700 }
2701
2702 =item all_emails
2703
2704 Returns the email addresses of all accounts provisioned for this customer.
2705
2706 =cut
2707
2708 sub all_emails {
2709   my $self = shift;
2710   my %list;
2711   foreach my $cust_pkg ( $self->all_pkgs ) {
2712     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2713     my @svc_acct =
2714       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2715         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2716           @cust_svc;
2717     $list{$_}=1 foreach map { $_->email } @svc_acct;
2718   }
2719   keys %list;
2720 }
2721
2722 =item invoicing_list_addpost
2723
2724 Adds postal invoicing to this customer.  If this customer is already configured
2725 to receive postal invoices, does nothing.
2726
2727 =cut
2728
2729 sub invoicing_list_addpost {
2730   my $self = shift;
2731   return if grep { $_ eq 'POST' } $self->invoicing_list;
2732   my @invoicing_list = $self->invoicing_list;
2733   push @invoicing_list, 'POST';
2734   $self->invoicing_list(\@invoicing_list);
2735 }
2736
2737 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2738
2739 Returns an array of customers referred by this customer (referral_custnum set
2740 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2741 customers referred by customers referred by this customer and so on, inclusive.
2742 The default behavior is DEPTH 1 (no recursion).
2743
2744 =cut
2745
2746 sub referral_cust_main {
2747   my $self = shift;
2748   my $depth = @_ ? shift : 1;
2749   my $exclude = @_ ? shift : {};
2750
2751   my @cust_main =
2752     map { $exclude->{$_->custnum}++; $_; }
2753       grep { ! $exclude->{ $_->custnum } }
2754         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2755
2756   if ( $depth > 1 ) {
2757     push @cust_main,
2758       map { $_->referral_cust_main($depth-1, $exclude) }
2759         @cust_main;
2760   }
2761
2762   @cust_main;
2763 }
2764
2765 =item referral_cust_main_ncancelled
2766
2767 Same as referral_cust_main, except only returns customers with uncancelled
2768 packages.
2769
2770 =cut
2771
2772 sub referral_cust_main_ncancelled {
2773   my $self = shift;
2774   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2775 }
2776
2777 =item referral_cust_pkg [ DEPTH ]
2778
2779 Like referral_cust_main, except returns a flat list of all unsuspended (and
2780 uncancelled) packages for each customer.  The number of items in this list may
2781 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2782
2783 =cut
2784
2785 sub referral_cust_pkg {
2786   my $self = shift;
2787   my $depth = @_ ? shift : 1;
2788
2789   map { $_->unsuspended_pkgs }
2790     grep { $_->unsuspended_pkgs }
2791       $self->referral_cust_main($depth);
2792 }
2793
2794 =item referring_cust_main
2795
2796 Returns the single cust_main record for the customer who referred this customer
2797 (referral_custnum), or false.
2798
2799 =cut
2800
2801 sub referring_cust_main {
2802   my $self = shift;
2803   return '' unless $self->referral_custnum;
2804   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2805 }
2806
2807 =item credit AMOUNT, REASON
2808
2809 Applies a credit to this customer.  If there is an error, returns the error,
2810 otherwise returns false.
2811
2812 =cut
2813
2814 sub credit {
2815   my( $self, $amount, $reason ) = @_;
2816   my $cust_credit = new FS::cust_credit {
2817     'custnum' => $self->custnum,
2818     'amount'  => $amount,
2819     'reason'  => $reason,
2820   };
2821   $cust_credit->insert;
2822 }
2823
2824 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2825
2826 Creates a one-time charge for this customer.  If there is an error, returns
2827 the error, otherwise returns false.
2828
2829 =cut
2830
2831 sub charge {
2832   my ( $self, $amount ) = ( shift, shift );
2833   my $pkg      = @_ ? shift : 'One-time charge';
2834   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2835   my $taxclass = @_ ? shift : '';
2836
2837   local $SIG{HUP} = 'IGNORE';
2838   local $SIG{INT} = 'IGNORE';
2839   local $SIG{QUIT} = 'IGNORE';
2840   local $SIG{TERM} = 'IGNORE';
2841   local $SIG{TSTP} = 'IGNORE';
2842   local $SIG{PIPE} = 'IGNORE';
2843
2844   my $oldAutoCommit = $FS::UID::AutoCommit;
2845   local $FS::UID::AutoCommit = 0;
2846   my $dbh = dbh;
2847
2848   my $part_pkg = new FS::part_pkg ( {
2849     'pkg'      => $pkg,
2850     'comment'  => $comment,
2851     #'setup'    => $amount,
2852     #'recur'    => '0',
2853     'plan'     => 'flat',
2854     'plandata' => "setup_fee=$amount",
2855     'freq'     => 0,
2856     'disabled' => 'Y',
2857     'taxclass' => $taxclass,
2858   } );
2859
2860   my $error = $part_pkg->insert;
2861   if ( $error ) {
2862     $dbh->rollback if $oldAutoCommit;
2863     return $error;
2864   }
2865
2866   my $pkgpart = $part_pkg->pkgpart;
2867   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2868   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2869     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2870     $error = $type_pkgs->insert;
2871     if ( $error ) {
2872       $dbh->rollback if $oldAutoCommit;
2873       return $error;
2874     }
2875   }
2876
2877   my $cust_pkg = new FS::cust_pkg ( {
2878     'custnum' => $self->custnum,
2879     'pkgpart' => $pkgpart,
2880   } );
2881
2882   $error = $cust_pkg->insert;
2883   if ( $error ) {
2884     $dbh->rollback if $oldAutoCommit;
2885     return $error;
2886   }
2887
2888   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2889   '';
2890
2891 }
2892
2893 =item cust_bill
2894
2895 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2896
2897 =cut
2898
2899 sub cust_bill {
2900   my $self = shift;
2901   sort { $a->_date <=> $b->_date }
2902     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2903 }
2904
2905 =item open_cust_bill
2906
2907 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2908 customer.
2909
2910 =cut
2911
2912 sub open_cust_bill {
2913   my $self = shift;
2914   grep { $_->owed > 0 } $self->cust_bill;
2915 }
2916
2917 =item cust_credit
2918
2919 Returns all the credits (see L<FS::cust_credit>) for this customer.
2920
2921 =cut
2922
2923 sub cust_credit {
2924   my $self = shift;
2925   sort { $a->_date <=> $b->_date }
2926     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2927 }
2928
2929 =item cust_pay
2930
2931 Returns all the payments (see L<FS::cust_pay>) for this customer.
2932
2933 =cut
2934
2935 sub cust_pay {
2936   my $self = shift;
2937   sort { $a->_date <=> $b->_date }
2938     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2939 }
2940
2941 =item cust_pay_void
2942
2943 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2944
2945 =cut
2946
2947 sub cust_pay_void {
2948   my $self = shift;
2949   sort { $a->_date <=> $b->_date }
2950     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2951 }
2952
2953
2954 =item cust_refund
2955
2956 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2957
2958 =cut
2959
2960 sub cust_refund {
2961   my $self = shift;
2962   sort { $a->_date <=> $b->_date }
2963     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2964 }
2965
2966 =item select_for_update
2967
2968 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2969 a mutex.
2970
2971 =cut
2972
2973 sub select_for_update {
2974   my $self = shift;
2975   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2976 }
2977
2978 =item name
2979
2980 Returns a name string for this customer, either "Company (Last, First)" or
2981 "Last, First".
2982
2983 =cut
2984
2985 sub name {
2986   my $self = shift;
2987   my $name = $self->get('last'). ', '. $self->first;
2988   $name = $self->company. " ($name)" if $self->company;
2989   $name;
2990 }
2991
2992 =item status
2993
2994 Returns a status string for this customer, currently:
2995
2996 =over 4
2997
2998 =item prospect - No packages have ever been ordered
2999
3000 =item active - One or more recurring packages is active
3001
3002 =item suspended - All non-cancelled recurring packages are suspended
3003
3004 =item cancelled - All recurring packages are cancelled
3005
3006 =back
3007
3008 =cut
3009
3010 sub status {
3011   my $self = shift;
3012   for my $status (qw( prospect active suspended cancelled )) {
3013     my $method = $status.'_sql';
3014     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3015     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3016     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
3017     return $status if $sth->fetchrow_arrayref->[0];
3018   }
3019 }
3020
3021 =item statuscolor
3022
3023 Returns a hex triplet color string for this customer's status.
3024
3025 =cut
3026
3027 my %statuscolor = (
3028   'prospect'  => '000000',
3029   'active'    => '00CC00',
3030   'suspended' => 'FF9900',
3031   'cancelled' => 'FF0000',
3032 );
3033 sub statuscolor {
3034   my $self = shift;
3035   $statuscolor{$self->status};
3036 }
3037
3038 =back
3039
3040 =head1 CLASS METHODS
3041
3042 =over 4
3043
3044 =item prospect_sql
3045
3046 Returns an SQL expression identifying prospective cust_main records (customers
3047 with no packages ever ordered)
3048
3049 =cut
3050
3051 sub prospect_sql { "
3052   0 = ( SELECT COUNT(*) FROM cust_pkg
3053           WHERE cust_pkg.custnum = cust_main.custnum
3054       )
3055 "; }
3056
3057 =item active_sql
3058
3059 Returns an SQL expression identifying active cust_main records.
3060
3061 =cut
3062
3063 sub active_sql { "
3064   0 < ( SELECT COUNT(*) FROM cust_pkg
3065           WHERE cust_pkg.custnum = cust_main.custnum
3066             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3067             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
3068       )
3069 "; }
3070
3071 =item susp_sql
3072 =item suspended_sql
3073
3074 Returns an SQL expression identifying suspended cust_main records.
3075
3076 =cut
3077
3078 sub suspended_sql { susp_sql(@_); }
3079 sub susp_sql { "
3080     0 < ( SELECT COUNT(*) FROM cust_pkg
3081             WHERE cust_pkg.custnum = cust_main.custnum
3082               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3083         )
3084     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3085                 WHERE cust_pkg.custnum = cust_main.custnum
3086                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3087                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3088             )
3089 "; }
3090
3091 =item cancel_sql
3092 =item cancelled_sql
3093
3094 Returns an SQL expression identifying cancelled cust_main records.
3095
3096 =cut
3097
3098 sub cancelled_sql { cancel_sql(@_); }
3099 sub cancel_sql { "
3100   0 < ( SELECT COUNT(*) FROM cust_pkg
3101           WHERE cust_pkg.custnum = cust_main.custnum
3102       )
3103   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
3104               WHERE cust_pkg.custnum = cust_main.custnum
3105                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3106           )
3107 "; }
3108
3109 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
3110
3111 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
3112 records.  Currently, only I<last> or I<company> may be specified (the
3113 appropriate ship_ field is also searched if applicable).
3114
3115 Additional options are the same as FS::Record::qsearch
3116
3117 =cut
3118
3119 sub fuzzy_search {
3120   my( $self, $fuzzy, $hash, @opt) = @_;
3121   #$self
3122   $hash ||= {};
3123   my @cust_main = ();
3124
3125   check_and_rebuild_fuzzyfiles();
3126   foreach my $field ( keys %$fuzzy ) {
3127     my $sub = \&{"all_$field"};
3128     my %match = ();
3129     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
3130
3131     foreach ( keys %match ) {
3132       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3133       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3134         if defined dbdef->table('cust_main')->column('ship_last');
3135     }
3136   }
3137
3138   my %saw = ();
3139   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3140
3141   @cust_main;
3142
3143 }
3144
3145 =back
3146
3147 =head1 SUBROUTINES
3148
3149 =over 4
3150
3151 =item smart_search OPTION => VALUE ...
3152
3153 Accepts the following options: I<search>, the string to search for.  The string
3154 will be searched for as a customer number, last name or company name, first
3155 searching for an exact match then fuzzy and substring matches.
3156
3157 Any additional options treated as an additional qualifier on the search
3158 (i.e. I<agentnum>).
3159
3160 Returns a (possibly empty) array of FS::cust_main objects.
3161
3162 =cut
3163
3164 sub smart_search {
3165   my %options = @_;
3166   my $search = delete $options{'search'};
3167   my @cust_main = ();
3168
3169   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3170
3171     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3172
3173   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3174
3175     my $value = lc($1);
3176     my $q_value = dbh->quote($value);
3177
3178     #exact
3179     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3180     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3181     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3182       if defined dbdef->table('cust_main')->column('ship_last');
3183     $sql .= ' )';
3184
3185     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3186
3187     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3188
3189       #still some false laziness w/ search/cust_main.cgi
3190
3191       #substring
3192       push @cust_main, qsearch( 'cust_main',
3193                                 { 'last'     => { 'op'    => 'ILIKE',
3194                                                   'value' => "%$q_value%" },
3195                                   %options,
3196                                 }
3197                               );
3198       push @cust_main, qsearch( 'cust_main',
3199                                 { 'ship_last' => { 'op'    => 'ILIKE',
3200                                                    'value' => "%$q_value%" },
3201                                   %options,
3202
3203                                 }
3204                               )
3205         if defined dbdef->table('cust_main')->column('ship_last');
3206
3207       push @cust_main, qsearch( 'cust_main',
3208                                 { 'company'  => { 'op'    => 'ILIKE',
3209                                                   'value' => "%$q_value%" },
3210                                   %options,
3211                                 }
3212                               );
3213       push @cust_main, qsearch( 'cust_main',
3214                                 { 'ship_company' => { 'op' => 'ILIKE',
3215                                                    'value' => "%$q_value%" },
3216                                   %options,
3217                                 }
3218                               )
3219         if defined dbdef->table('cust_main')->column('ship_last');
3220
3221       #fuzzy
3222       push @cust_main, FS::cust_main->fuzzy_search(
3223         { 'last'     => $value },
3224         \%options,
3225       );
3226       push @cust_main, FS::cust_main->fuzzy_search(
3227         { 'company'  => $value },
3228         \%options,
3229       );
3230
3231     }
3232
3233   }
3234
3235   @cust_main;
3236
3237 }
3238
3239 =item check_and_rebuild_fuzzyfiles
3240
3241 =cut
3242
3243 sub check_and_rebuild_fuzzyfiles {
3244   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3245   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3246     or &rebuild_fuzzyfiles;
3247 }
3248
3249 =item rebuild_fuzzyfiles
3250
3251 =cut
3252
3253 sub rebuild_fuzzyfiles {
3254
3255   use Fcntl qw(:flock);
3256
3257   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3258
3259   #last
3260
3261   open(LASTLOCK,">>$dir/cust_main.last")
3262     or die "can't open $dir/cust_main.last: $!";
3263   flock(LASTLOCK,LOCK_EX)
3264     or die "can't lock $dir/cust_main.last: $!";
3265
3266   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3267   push @all_last,
3268                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3269     if defined dbdef->table('cust_main')->column('ship_last');
3270
3271   open (LASTCACHE,">$dir/cust_main.last.tmp")
3272     or die "can't open $dir/cust_main.last.tmp: $!";
3273   print LASTCACHE join("\n", @all_last), "\n";
3274   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3275
3276   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3277   close LASTLOCK;
3278
3279   #company
3280
3281   open(COMPANYLOCK,">>$dir/cust_main.company")
3282     or die "can't open $dir/cust_main.company: $!";
3283   flock(COMPANYLOCK,LOCK_EX)
3284     or die "can't lock $dir/cust_main.company: $!";
3285
3286   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3287   push @all_company,
3288        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3289     if defined dbdef->table('cust_main')->column('ship_last');
3290
3291   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3292     or die "can't open $dir/cust_main.company.tmp: $!";
3293   print COMPANYCACHE join("\n", @all_company), "\n";
3294   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3295
3296   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3297   close COMPANYLOCK;
3298
3299 }
3300
3301 =item all_last
3302
3303 =cut
3304
3305 sub all_last {
3306   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3307   open(LASTCACHE,"<$dir/cust_main.last")
3308     or die "can't open $dir/cust_main.last: $!";
3309   my @array = map { chomp; $_; } <LASTCACHE>;
3310   close LASTCACHE;
3311   \@array;
3312 }
3313
3314 =item all_company
3315
3316 =cut
3317
3318 sub all_company {
3319   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3320   open(COMPANYCACHE,"<$dir/cust_main.company")
3321     or die "can't open $dir/cust_main.last: $!";
3322   my @array = map { chomp; $_; } <COMPANYCACHE>;
3323   close COMPANYCACHE;
3324   \@array;
3325 }
3326
3327 =item append_fuzzyfiles LASTNAME COMPANY
3328
3329 =cut
3330
3331 sub append_fuzzyfiles {
3332   my( $last, $company ) = @_;
3333
3334   &check_and_rebuild_fuzzyfiles;
3335
3336   use Fcntl qw(:flock);
3337
3338   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3339
3340   if ( $last ) {
3341
3342     open(LAST,">>$dir/cust_main.last")
3343       or die "can't open $dir/cust_main.last: $!";
3344     flock(LAST,LOCK_EX)
3345       or die "can't lock $dir/cust_main.last: $!";
3346
3347     print LAST "$last\n";
3348
3349     flock(LAST,LOCK_UN)
3350       or die "can't unlock $dir/cust_main.last: $!";
3351     close LAST;
3352   }
3353
3354   if ( $company ) {
3355
3356     open(COMPANY,">>$dir/cust_main.company")
3357       or die "can't open $dir/cust_main.company: $!";
3358     flock(COMPANY,LOCK_EX)
3359       or die "can't lock $dir/cust_main.company: $!";
3360
3361     print COMPANY "$company\n";
3362
3363     flock(COMPANY,LOCK_UN)
3364       or die "can't unlock $dir/cust_main.company: $!";
3365
3366     close COMPANY;
3367   }
3368
3369   1;
3370 }
3371
3372 =item batch_import
3373
3374 =cut
3375
3376 sub batch_import {
3377   my $param = shift;
3378   #warn join('-',keys %$param);
3379   my $fh = $param->{filehandle};
3380   my $agentnum = $param->{agentnum};
3381   my $refnum = $param->{refnum};
3382   my $pkgpart = $param->{pkgpart};
3383   my @fields = @{$param->{fields}};
3384
3385   eval "use Date::Parse;";
3386   die $@ if $@;
3387   eval "use Text::CSV_XS;";
3388   die $@ if $@;
3389
3390   my $csv = new Text::CSV_XS;
3391   #warn $csv;
3392   #warn $fh;
3393
3394   my $imported = 0;
3395   #my $columns;
3396
3397   local $SIG{HUP} = 'IGNORE';
3398   local $SIG{INT} = 'IGNORE';
3399   local $SIG{QUIT} = 'IGNORE';
3400   local $SIG{TERM} = 'IGNORE';
3401   local $SIG{TSTP} = 'IGNORE';
3402   local $SIG{PIPE} = 'IGNORE';
3403
3404   my $oldAutoCommit = $FS::UID::AutoCommit;
3405   local $FS::UID::AutoCommit = 0;
3406   my $dbh = dbh;
3407
3408   #while ( $columns = $csv->getline($fh) ) {
3409   my $line;
3410   while ( defined($line=<$fh>) ) {
3411
3412     $csv->parse($line) or do {
3413       $dbh->rollback if $oldAutoCommit;
3414       return "can't parse: ". $csv->error_input();
3415     };
3416
3417     my @columns = $csv->fields();
3418     #warn join('-',@columns);
3419
3420     my %cust_main = (
3421       agentnum => $agentnum,
3422       refnum   => $refnum,
3423       country  => $conf->config('countrydefault') || 'US',
3424       payby    => 'BILL', #default
3425       paydate  => '12/2037', #default
3426     );
3427     my $billtime = time;
3428     my %cust_pkg = ( pkgpart => $pkgpart );
3429     foreach my $field ( @fields ) {
3430       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3431         #$cust_pkg{$1} = str2time( shift @$columns );
3432         if ( $1 eq 'setup' ) {
3433           $billtime = str2time(shift @columns);
3434         } else {
3435           $cust_pkg{$1} = str2time( shift @columns );
3436         }
3437       } else {
3438         #$cust_main{$field} = shift @$columns;
3439         $cust_main{$field} = shift @columns;
3440       }
3441     }
3442
3443     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3444     my $cust_main = new FS::cust_main ( \%cust_main );
3445     use Tie::RefHash;
3446     tie my %hash, 'Tie::RefHash'; #this part is important
3447     $hash{$cust_pkg} = [] if $pkgpart;
3448     my $error = $cust_main->insert( \%hash );
3449
3450     if ( $error ) {
3451       $dbh->rollback if $oldAutoCommit;
3452       return "can't insert customer for $line: $error";
3453     }
3454
3455     #false laziness w/bill.cgi
3456     $error = $cust_main->bill( 'time' => $billtime );
3457     if ( $error ) {
3458       $dbh->rollback if $oldAutoCommit;
3459       return "can't bill customer for $line: $error";
3460     }
3461
3462     $cust_main->apply_payments;
3463     $cust_main->apply_credits;
3464
3465     $error = $cust_main->collect();
3466     if ( $error ) {
3467       $dbh->rollback if $oldAutoCommit;
3468       return "can't collect customer for $line: $error";
3469     }
3470
3471     $imported++;
3472   }
3473
3474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3475
3476   return "Empty file!" unless $imported;
3477
3478   ''; #no error
3479
3480 }
3481
3482 =item batch_charge
3483
3484 =cut
3485
3486 sub batch_charge {
3487   my $param = shift;
3488   #warn join('-',keys %$param);
3489   my $fh = $param->{filehandle};
3490   my @fields = @{$param->{fields}};
3491
3492   eval "use Date::Parse;";
3493   die $@ if $@;
3494   eval "use Text::CSV_XS;";
3495   die $@ if $@;
3496
3497   my $csv = new Text::CSV_XS;
3498   #warn $csv;
3499   #warn $fh;
3500
3501   my $imported = 0;
3502   #my $columns;
3503
3504   local $SIG{HUP} = 'IGNORE';
3505   local $SIG{INT} = 'IGNORE';
3506   local $SIG{QUIT} = 'IGNORE';
3507   local $SIG{TERM} = 'IGNORE';
3508   local $SIG{TSTP} = 'IGNORE';
3509   local $SIG{PIPE} = 'IGNORE';
3510
3511   my $oldAutoCommit = $FS::UID::AutoCommit;
3512   local $FS::UID::AutoCommit = 0;
3513   my $dbh = dbh;
3514
3515   #while ( $columns = $csv->getline($fh) ) {
3516   my $line;
3517   while ( defined($line=<$fh>) ) {
3518
3519     $csv->parse($line) or do {
3520       $dbh->rollback if $oldAutoCommit;
3521       return "can't parse: ". $csv->error_input();
3522     };
3523
3524     my @columns = $csv->fields();
3525     #warn join('-',@columns);
3526
3527     my %row = ();
3528     foreach my $field ( @fields ) {
3529       $row{$field} = shift @columns;
3530     }
3531
3532     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3533     unless ( $cust_main ) {
3534       $dbh->rollback if $oldAutoCommit;
3535       return "unknown custnum $row{'custnum'}";
3536     }
3537
3538     if ( $row{'amount'} > 0 ) {
3539       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3540       if ( $error ) {
3541         $dbh->rollback if $oldAutoCommit;
3542         return $error;
3543       }
3544       $imported++;
3545     } elsif ( $row{'amount'} < 0 ) {
3546       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3547                                       $row{'pkg'}                         );
3548       if ( $error ) {
3549         $dbh->rollback if $oldAutoCommit;
3550         return $error;
3551       }
3552       $imported++;
3553     } else {
3554       #hmm?
3555     }
3556
3557   }
3558
3559   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3560
3561   return "Empty file!" unless $imported;
3562
3563   ''; #no error
3564
3565 }
3566
3567 =back
3568
3569 =head1 BUGS
3570
3571 The delete method.
3572
3573 The delete method should possibly take an FS::cust_main object reference
3574 instead of a scalar customer number.
3575
3576 Bill and collect options should probably be passed as references instead of a
3577 list.
3578
3579 There should probably be a configuration file with a list of allowed credit
3580 card types.
3581
3582 No multiple currency support (probably a larger project than just this module).
3583
3584 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3585
3586 =head1 SEE ALSO
3587
3588 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3589 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3590 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3591
3592 =cut
3593
3594 1;
3595