FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $Debug $import );
   5 use Safe;
   6 use Carp;
   7 use Time::Local;
   8 use Date::Format;
   9 #use Date::Manip;
  10 use Business::CreditCard;
  11 use FS::UID qw( getotaker dbh );
  12 use FS::Record qw( qsearchs qsearch dbdef );
  13 use FS::cust_pkg;
  14 use FS::cust_bill;
  15 use FS::cust_bill_pkg;
  16 use FS::cust_pay;
  17 use FS::cust_credit;
  18 use FS::part_referral;
  19 use FS::cust_main_county;
  20 use FS::agent;
  21 use FS::cust_main_invoice;
  22 use FS::cust_credit_bill;
  23 use FS::cust_bill_pay;
  24 use FS::prepay_credit;
  25 use FS::queue;
  26 use FS::part_pkg;
  27 use FS::part_bill_event;
  28 use FS::cust_bill_event;
  29 use FS::cust_tax_exempt;
  30 use FS::type_pkgs;
  31 use FS::Msgcat qw(gettext);
  32
  33 @ISA = qw( FS::Record );
  34
  35 $Debug = 0;
  36 #$Debug = 1;
  37
  38 $import = 0;
  39
  40 #ask FS::UID to run this stuff for us later
  41 $FS::UID::callback{'FS::cust_main'} = sub {
  42   $conf = new FS::Conf;
  43   #yes, need it for stuff below (prolly should be cached)
  44 };
  45
  46 sub _cache {
  47   my $self = shift;
  48   my ( $hashref, $cache ) = @_;
  49   if ( exists $hashref->{'pkgnum'} ) {
  50 #    #@{ $self->{'_pkgnum'} } = ();
  51     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  52     $self->{'_pkgnum'} = $subcache;
  53     #push @{ $self->{'_pkgnum'} },
  54     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  55   }
  56 }
  57
  58 =head1 NAME
  59
  60 FS::cust_main - Object methods for cust_main records
  61
  62 =head1 SYNOPSIS
  63
  64   use FS::cust_main;
  65
  66   $record = new FS::cust_main \%hash;
  67   $record = new FS::cust_main { 'column' => 'value' };
  68
  69   $error = $record->insert;
  70
  71   $error = $new_record->replace($old_record);
  72
  73   $error = $record->delete;
  74
  75   $error = $record->check;
  76
  77   @cust_pkg = $record->all_pkgs;
  78
  79   @cust_pkg = $record->ncancelled_pkgs;
  80
  81   @cust_pkg = $record->suspended_pkgs;
  82
  83   $error = $record->bill;
  84   $error = $record->bill %options;
  85   $error = $record->bill 'time' => $time;
  86
  87   $error = $record->collect;
  88   $error = $record->collect %options;
  89   $error = $record->collect 'invoice_time'   => $time,
  90                             'batch_card'     => 'yes',
  91                             'report_badcard' => 'yes',
  92                           ;
  93
  94 =head1 DESCRIPTION
  95
  96 An FS::cust_main object represents a customer.  FS::cust_main inherits from
  97 FS::Record.  The following fields are currently supported:
  98
  99 =over 4
 100
 101 =item custnum - primary key (assigned automatically for new customers)
 102
 103 =item agentnum - agent (see L<FS::agent>)
 104
 105 =item refnum - Advertising source (see L<FS::part_referral>)
 106
 107 =item first - name
 108
 109 =item last - name
 110
 111 =item ss - social security number (optional)
 112
 113 =item company - (optional)
 114
 115 =item address1
 116
 117 =item address2 - (optional)
 118
 119 =item city
 120
 121 =item county - (optional, see L<FS::cust_main_county>)
 122
 123 =item state - (see L<FS::cust_main_county>)
 124
 125 =item zip
 126
 127 =item country - (see L<FS::cust_main_county>)
 128
 129 =item daytime - phone (optional)
 130
 131 =item night - phone (optional)
 132
 133 =item fax - phone (optional)
 134
 135 =item ship_first - name
 136
 137 =item ship_last - name
 138
 139 =item ship_company - (optional)
 140
 141 =item ship_address1
 142
 143 =item ship_address2 - (optional)
 144
 145 =item ship_city
 146
 147 =item ship_county - (optional, see L<FS::cust_main_county>)
 148
 149 =item ship_state - (see L<FS::cust_main_county>)
 150
 151 =item ship_zip
 152
 153 =item ship_country - (see L<FS::cust_main_county>)
 154
 155 =item ship_daytime - phone (optional)
 156
 157 =item ship_night - phone (optional)
 158
 159 =item ship_fax - phone (optional)
 160
 161 =item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 162
 163 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 164
 165 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 166
 167 =item payname - name on card or billing name
 168
 169 =item tax - tax exempt, empty or `Y'
 170
 171 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 172
 173 =item comments - comments (optional)
 174
 175 =back
 176
 177 =head1 METHODS
 178
 179 =over 4
 180
 181 =item new HASHREF
 182
 183 Creates a new customer.  To add the customer to the database, see L<"insert">.
 184
 185 Note that this stores the hash reference, not a distinct copy of the hash it
 186 points to.  You can ask the object for a copy with the I<hash> method.
 187
 188 =cut
 189
 190 sub table { 'cust_main'; }
 191
 192 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
 193
 194 Adds this customer to the database.  If there is an error, returns the error,
 195 otherwise returns false.
 196
 197 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 198 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 199 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 200 hash reference is equivalent to not supplying this parameter.  There should be
 201 a better explanation of this, but until then, here's an example:
 202
 203   use Tie::RefHash;
 204   tie %hash, 'Tie::RefHash'; #this part is important
 205   %hash = (
 206     $cust_pkg => [ $svc_acct ],
 207     ...
 208   );
 209   $cust_main->insert( \%hash );
 210
 211 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 212 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 213 expected and rollback the entire transaction; it is not necessary to call
 214 check_invoicing_list first.  The invoicing_list is set after the records in the
 215 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 216 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 217
 218   $cust_main->insert( {}, [ $email, 'POST' ] );
 219
 220 =cut
 221
 222 sub insert {
 223   my $self = shift;
 224   my $cust_pkgs = @_ ? shift : {};
 225   my $invoicing_list = @_ ? shift : '';
 226
 227   local $SIG{HUP} = 'IGNORE';
 228   local $SIG{INT} = 'IGNORE';
 229   local $SIG{QUIT} = 'IGNORE';
 230   local $SIG{TERM} = 'IGNORE';
 231   local $SIG{TSTP} = 'IGNORE';
 232   local $SIG{PIPE} = 'IGNORE';
 233
 234   my $oldAutoCommit = $FS::UID::AutoCommit;
 235   local $FS::UID::AutoCommit = 0;
 236   my $dbh = dbh;
 237
 238   my $amount = 0;
 239   my $seconds = 0;
 240   if ( $self->payby eq 'PREPAY' ) {
 241     $self->payby('BILL');
 242     my $prepay_credit = qsearchs(
 243       'prepay_credit',
 244       { 'identifier' => $self->payinfo },
 245       '',
 246       'FOR UPDATE'
 247     );
 248     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 249       unless $prepay_credit;
 250     $amount = $prepay_credit->amount;
 251     $seconds = $prepay_credit->seconds;
 252     my $error = $prepay_credit->delete;
 253     if ( $error ) {
 254       $dbh->rollback if $oldAutoCommit;
 255       return "removing prepay_credit (transaction rolled back): $error";
 256     }
 257   }
 258
 259   my $error = $self->SUPER::insert;
 260   if ( $error ) {
 261     $dbh->rollback if $oldAutoCommit;
 262     #return "inserting cust_main record (transaction rolled back): $error";
 263     return $error;
 264   }
 265
 266   # invoicing list
 267   if ( $invoicing_list ) {
 268     $error = $self->check_invoicing_list( $invoicing_list );
 269     if ( $error ) {
 270       $dbh->rollback if $oldAutoCommit;
 271       return "checking invoicing_list (transaction rolled back): $error";
 272     }
 273     $self->invoicing_list( $invoicing_list );
 274   }
 275
 276   # packages
 277   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 278     $cust_pkg->custnum( $self->custnum );
 279     $error = $cust_pkg->insert;
 280     if ( $error ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return "inserting cust_pkg (transaction rolled back): $error";
 283     }
 284     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 285       $svc_something->pkgnum( $cust_pkg->pkgnum );
 286       if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 287         $svc_something->seconds( $svc_something->seconds + $seconds );
 288         $seconds = 0;
 289       }
 290       $error = $svc_something->insert;
 291       if ( $error ) {
 292         $dbh->rollback if $oldAutoCommit;
 293         #return "inserting svc_ (transaction rolled back): $error";
 294         return $error;
 295       }
 296     }
 297   }
 298
 299   if ( $seconds ) {
 300     $dbh->rollback if $oldAutoCommit;
 301     return "No svc_acct record to apply pre-paid time";
 302   }
 303
 304   if ( $amount ) {
 305     my $cust_credit = new FS::cust_credit {
 306       'custnum' => $self->custnum,
 307       'amount'  => $amount,
 308     };
 309     $error = $cust_credit->insert;
 310     if ( $error ) {
 311       $dbh->rollback if $oldAutoCommit;
 312       return "inserting credit (transaction rolled back): $error";
 313     }
 314   }
 315
 316   #false laziness with sub replace
 317   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 318   $error = $queue->insert($self->getfield('last'), $self->company);
 319   if ( $error ) {
 320     $dbh->rollback if $oldAutoCommit;
 321     return "queueing job (transaction rolled back): $error";
 322   }
 323
 324   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 325     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 326     $error = $queue->insert($self->getfield('last'), $self->company);
 327     if ( $error ) {
 328       $dbh->rollback if $oldAutoCommit;
 329       return "queueing job (transaction rolled back): $error";
 330     }
 331   }
 332   #eslaf
 333
 334   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 335   '';
 336
 337 }
 338
 339 =item delete NEW_CUSTNUM
 340
 341 This deletes the customer.  If there is an error, returns the error, otherwise
 342 returns false.
 343
 344 This will completely remove all traces of the customer record.  This is not
 345 what you want when a customer cancels service; for that, cancel all of the
 346 customer's packages (see L<FS::cust_pkg/cancel>).
 347
 348 If the customer has any uncancelled packages, you need to pass a new (valid)
 349 customer number for those packages to be transferred to.  Cancelled packages
 350 will be deleted.  Did I mention that this is NOT what you want when a customer
 351 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 352
 353 You can't delete a customer with invoices (see L<FS::cust_bill>),
 354 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 355 refunds (see L<FS::cust_refund>).
 356
 357 =cut
 358
 359 sub delete {
 360   my $self = shift;
 361
 362   local $SIG{HUP} = 'IGNORE';
 363   local $SIG{INT} = 'IGNORE';
 364   local $SIG{QUIT} = 'IGNORE';
 365   local $SIG{TERM} = 'IGNORE';
 366   local $SIG{TSTP} = 'IGNORE';
 367   local $SIG{PIPE} = 'IGNORE';
 368
 369   my $oldAutoCommit = $FS::UID::AutoCommit;
 370   local $FS::UID::AutoCommit = 0;
 371   my $dbh = dbh;
 372
 373   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 374     $dbh->rollback if $oldAutoCommit;
 375     return "Can't delete a customer with invoices";
 376   }
 377   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 378     $dbh->rollback if $oldAutoCommit;
 379     return "Can't delete a customer with credits";
 380   }
 381   if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
 382     $dbh->rollback if $oldAutoCommit;
 383     return "Can't delete a customer with payments";
 384   }
 385   if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
 386     $dbh->rollback if $oldAutoCommit;
 387     return "Can't delete a customer with refunds";
 388   }
 389
 390   my @cust_pkg = $self->ncancelled_pkgs;
 391   if ( @cust_pkg ) {
 392     my $new_custnum = shift;
 393     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 394       $dbh->rollback if $oldAutoCommit;
 395       return "Invalid new customer number: $new_custnum";
 396     }
 397     foreach my $cust_pkg ( @cust_pkg ) {
 398       my %hash = $cust_pkg->hash;
 399       $hash{'custnum'} = $new_custnum;
 400       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 401       my $error = $new_cust_pkg->replace($cust_pkg);
 402       if ( $error ) {
 403         $dbh->rollback if $oldAutoCommit;
 404         return $error;
 405       }
 406     }
 407   }
 408   my @cancelled_cust_pkg = $self->all_pkgs;
 409   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 410     my $error = $cust_pkg->delete;
 411     if ( $error ) {
 412       $dbh->rollback if $oldAutoCommit;
 413       return $error;
 414     }
 415   }
 416
 417   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 418     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 419   ) {
 420     my $error = $cust_main_invoice->delete;
 421     if ( $error ) {
 422       $dbh->rollback if $oldAutoCommit;
 423       return $error;
 424     }
 425   }
 426
 427   my $error = $self->SUPER::delete;
 428   if ( $error ) {
 429     $dbh->rollback if $oldAutoCommit;
 430     return $error;
 431   }
 432
 433   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 434   '';
 435
 436 }
 437
 438 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 439
 440 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 441 returns the error, otherwise returns false.
 442
 443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 444 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 445 expected and rollback the entire transaction; it is not necessary to call
 446 check_invoicing_list first.  Here's an example:
 447
 448   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 449
 450 =cut
 451
 452 sub replace {
 453   my $self = shift;
 454   my $old = shift;
 455   my @param = @_;
 456
 457   local $SIG{HUP} = 'IGNORE';
 458   local $SIG{INT} = 'IGNORE';
 459   local $SIG{QUIT} = 'IGNORE';
 460   local $SIG{TERM} = 'IGNORE';
 461   local $SIG{TSTP} = 'IGNORE';
 462   local $SIG{PIPE} = 'IGNORE';
 463
 464   my $oldAutoCommit = $FS::UID::AutoCommit;
 465   local $FS::UID::AutoCommit = 0;
 466   my $dbh = dbh;
 467
 468   my $error = $self->SUPER::replace($old);
 469
 470   if ( $error ) {
 471     $dbh->rollback if $oldAutoCommit;
 472     return $error;
 473   }
 474
 475   if ( @param ) { # INVOICING_LIST_ARYREF
 476     my $invoicing_list = shift @param;
 477     $error = $self->check_invoicing_list( $invoicing_list );
 478     if ( $error ) {
 479       $dbh->rollback if $oldAutoCommit;
 480       return $error;
 481     }
 482     $self->invoicing_list( $invoicing_list );
 483   }
 484
 485   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 486        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 487     # card info has changed, want to retry realtime_card invoice events
 488     #false laziness w/collect
 489     foreach my $cust_bill_event (
 490       grep {
 491              #$_->part_bill_event->plan eq 'realtime-card'
 492              $_->part_bill_event->eventcode =~
 493                  /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
 494                && $_->status eq 'done'
 495                && $_->statustext
 496            }
 497         map { $_->cust_bill_event }
 498           grep { $_->cust_bill_event }
 499             $self->open_cust_bill
 500
 501     ) {
 502       my $error = $cust_bill_event->retry;
 503       if ( $error ) {
 504         $dbh->rollback if $oldAutoCommit;
 505         return "error scheduling invoice events for retry: $error";
 506       }
 507     }
 508     #eslaf
 509
 510   }
 511
 512   #false laziness with sub insert
 513   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 514   $error = $queue->insert($self->getfield('last'), $self->company);
 515   if ( $error ) {
 516     $dbh->rollback if $oldAutoCommit;
 517     return "queueing job (transaction rolled back): $error";
 518   }
 519
 520   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 521     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 522     $error = $queue->insert($self->getfield('last'), $self->company);
 523     if ( $error ) {
 524       $dbh->rollback if $oldAutoCommit;
 525       return "queueing job (transaction rolled back): $error";
 526     }
 527   }
 528   #eslaf
 529
 530   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 531   '';
 532
 533 }
 534
 535 =item check
 536
 537 Checks all fields to make sure this is a valid customer record.  If there is
 538 an error, returns the error, otherwise returns false.  Called by the insert
 539 and repalce methods.
 540
 541 =cut
 542
 543 sub check {
 544   my $self = shift;
 545
 546   #warn "BEFORE: \n". $self->_dump;
 547
 548   my $error =
 549     $self->ut_numbern('custnum')
 550     || $self->ut_number('agentnum')
 551     || $self->ut_number('refnum')
 552     || $self->ut_name('last')
 553     || $self->ut_name('first')
 554     || $self->ut_textn('company')
 555     || $self->ut_text('address1')
 556     || $self->ut_textn('address2')
 557     || $self->ut_text('city')
 558     || $self->ut_textn('county')
 559     || $self->ut_textn('state')
 560     || $self->ut_country('country')
 561     || $self->ut_anything('comments')
 562     || $self->ut_numbern('referral_custnum')
 563   ;
 564   #barf.  need message catalogs.  i18n.  etc.
 565   $error .= "Please select a advertising source."
 566     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 567   return $error if $error;
 568
 569   return "Unknown agent"
 570     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 571
 572   return "Unknown refnum"
 573     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 574
 575   return "Unknown referring custnum ". $self->referral_custnum
 576     unless ! $self->referral_custnum
 577            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 578
 579   if ( $self->ss eq '' ) {
 580     $self->ss('');
 581   } else {
 582     my $ss = $self->ss;
 583     $ss =~ s/\D//g;
 584     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 585       or return "Illegal social security number: ". $self->ss;
 586     $self->ss("$1-$2-$3");
 587   }
 588
 589
 590 # bad idea to disable, causes billing to fail because of no tax rates later
 591 #  unless ( $import ) {
 592     unless ( qsearch('cust_main_county', {
 593       'country' => $self->country,
 594       'state'   => '',
 595      } ) ) {
 596       return "Unknown state/county/country: ".
 597         $self->state. "/". $self->county. "/". $self->country
 598         unless qsearch('cust_main_county',{
 599           'state'   => $self->state,
 600           'county'  => $self->county,
 601           'country' => $self->country,
 602         } );
 603     }
 604 #  }
 605
 606   $error =
 607     $self->ut_phonen('daytime', $self->country)
 608     || $self->ut_phonen('night', $self->country)
 609     || $self->ut_phonen('fax', $self->country)
 610     || $self->ut_zip('zip', $self->country)
 611   ;
 612   return $error if $error;
 613
 614   my @addfields = qw(
 615     last first company address1 address2 city county state zip
 616     country daytime night fax
 617   );
 618
 619   if ( defined $self->dbdef_table->column('ship_last') ) {
 620     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 621                        @addfields )
 622          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 623        )
 624     {
 625       my $error =
 626         $self->ut_name('ship_last')
 627         || $self->ut_name('ship_first')
 628         || $self->ut_textn('ship_company')
 629         || $self->ut_text('ship_address1')
 630         || $self->ut_textn('ship_address2')
 631         || $self->ut_text('ship_city')
 632         || $self->ut_textn('ship_county')
 633         || $self->ut_textn('ship_state')
 634         || $self->ut_country('ship_country')
 635       ;
 636       return $error if $error;
 637
 638       #false laziness with above
 639       unless ( qsearchs('cust_main_county', {
 640         'country' => $self->ship_country,
 641         'state'   => '',
 642        } ) ) {
 643         return "Unknown ship_state/ship_county/ship_country: ".
 644           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 645           unless qsearchs('cust_main_county',{
 646             'state'   => $self->ship_state,
 647             'county'  => $self->ship_county,
 648             'country' => $self->ship_country,
 649           } );
 650       }
 651       #eofalse
 652
 653       $error =
 654         $self->ut_phonen('ship_daytime', $self->ship_country)
 655         || $self->ut_phonen('ship_night', $self->ship_country)
 656         || $self->ut_phonen('ship_fax', $self->ship_country)
 657         || $self->ut_zip('ship_zip', $self->ship_country)
 658       ;
 659       return $error if $error;
 660
 661     } else { # ship_ info eq billing info, so don't store dup info in database
 662       $self->setfield("ship_$_", '')
 663         foreach qw( last first company address1 address2 city county state zip
 664                     country daytime night fax );
 665     }
 666   }
 667
 668   $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
 669     or return "Illegal payby: ". $self->payby;
 670   $self->payby($1);
 671
 672   if ( $self->payby eq 'CARD' ) {
 673
 674     my $payinfo = $self->payinfo;
 675     $payinfo =~ s/\D//g;
 676     $payinfo =~ /^(\d{13,16})$/
 677       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 678     $payinfo = $1;
 679     $self->payinfo($payinfo);
 680     validate($payinfo)
 681       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 682     return gettext('unknown_card_type')
 683       if cardtype($self->payinfo) eq "Unknown";
 684
 685   } elsif ( $self->payby eq 'CHEK' ) {
 686
 687     my $payinfo = $self->payinfo;
 688     $payinfo =~ s/[^\d\@]//g;
 689     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 690     $payinfo = "$1\@$2";
 691     $self->payinfo($payinfo);
 692
 693   } elsif ( $self->payby eq 'LECB' ) {
 694
 695     my $payinfo = $self->payinfo;
 696     $payinfo =~ s/\D//g;
 697     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 698     $payinfo = $1;
 699     $self->payinfo($payinfo);
 700
 701   } elsif ( $self->payby eq 'BILL' ) {
 702
 703     $error = $self->ut_textn('payinfo');
 704     return "Illegal P.O. number: ". $self->payinfo if $error;
 705
 706   } elsif ( $self->payby eq 'COMP' ) {
 707
 708     $error = $self->ut_textn('payinfo');
 709     return "Illegal comp account issuer: ". $self->payinfo if $error;
 710
 711   } elsif ( $self->payby eq 'PREPAY' ) {
 712
 713     my $payinfo = $self->payinfo;
 714     $payinfo =~ s/\W//g; #anything else would just confuse things
 715     $self->payinfo($payinfo);
 716     $error = $self->ut_alpha('payinfo');
 717     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 718     return "Unknown prepayment identifier"
 719       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 720
 721   }
 722
 723   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 724     return "Expriation date required"
 725       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 726     $self->paydate('');
 727   } else {
 728     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 729       or return "Illegal expiration date: ". $self->paydate;
 730     my $y = length($2) == 4 ? $2 : "20$2";
 731     $self->paydate("$y-$1-01");
 732     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 733     return gettext('expired_card')
 734       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 735   }
 736
 737   if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
 738        ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
 739     $self->payname( $self->first. " ". $self->getfield('last') );
 740   } else {
 741     $self->payname =~ /^([\w \,\.\-\']+)$/
 742       or return gettext('illegal_name'). " payname: ". $self->payname;
 743     $self->payname($1);
 744   }
 745
 746   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 747   $self->tax($1);
 748
 749   $self->otaker(getotaker);
 750
 751   #warn "AFTER: \n". $self->_dump;
 752
 753   ''; #no error
 754 }
 755
 756 =item all_pkgs
 757
 758 Returns all packages (see L<FS::cust_pkg>) for this customer.
 759
 760 =cut
 761
 762 sub all_pkgs {
 763   my $self = shift;
 764   if ( $self->{'_pkgnum'} ) {
 765     values %{ $self->{'_pkgnum'}->cache };
 766   } else {
 767     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 768   }
 769 }
 770
 771 =item ncancelled_pkgs
 772
 773 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 774
 775 =cut
 776
 777 sub ncancelled_pkgs {
 778   my $self = shift;
 779   if ( $self->{'_pkgnum'} ) {
 780     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 781   } else {
 782     @{ [ # force list context
 783       qsearch( 'cust_pkg', {
 784         'custnum' => $self->custnum,
 785         'cancel'  => '',
 786       }),
 787       qsearch( 'cust_pkg', {
 788         'custnum' => $self->custnum,
 789         'cancel'  => 0,
 790       }),
 791     ] };
 792   }
 793 }
 794
 795 =item suspended_pkgs
 796
 797 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 798
 799 =cut
 800
 801 sub suspended_pkgs {
 802   my $self = shift;
 803   grep { $_->susp } $self->ncancelled_pkgs;
 804 }
 805
 806 =item unflagged_suspended_pkgs
 807
 808 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 809 customer (thouse packages without the `manual_flag' set).
 810
 811 =cut
 812
 813 sub unflagged_suspended_pkgs {
 814   my $self = shift;
 815   return $self->suspended_pkgs
 816     unless dbdef->table('cust_pkg')->column('manual_flag');
 817   grep { ! $_->manual_flag } $self->suspended_pkgs;
 818 }
 819
 820 =item unsuspended_pkgs
 821
 822 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 823 this customer.
 824
 825 =cut
 826
 827 sub unsuspended_pkgs {
 828   my $self = shift;
 829   grep { ! $_->susp } $self->ncancelled_pkgs;
 830 }
 831
 832 =item unsuspend
 833
 834 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 835 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 836 on success or a list of errors.
 837
 838 =cut
 839
 840 sub unsuspend {
 841   my $self = shift;
 842   grep { $_->unsuspend } $self->suspended_pkgs;
 843 }
 844
 845 =item suspend
 846
 847 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 848 Always returns a list: an empty list on success or a list of errors.
 849
 850 =cut
 851
 852 sub suspend {
 853   my $self = shift;
 854   grep { $_->suspend } $self->unsuspended_pkgs;
 855 }
 856
 857 =item cancel
 858
 859 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 860 Always returns a list: an empty list on success or a list of errors.
 861
 862 =cut
 863
 864 sub cancel {
 865   my $self = shift;
 866   grep { $_->cancel } $self->ncancelled_pkgs;
 867 }
 868
 869 =item agent
 870
 871 Returns the agent (see L<FS::agent>) for this customer.
 872
 873 =cut
 874
 875 sub agent {
 876   my $self = shift;
 877   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 878 }
 879
 880 =item bill OPTIONS
 881
 882 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 883 conjunction with the collect method.
 884
 885 Options are passed as name-value pairs.
 886
 887 The only currently available option is `time', which bills the customer as if
 888 it were that time.  It is specified as a UNIX timestamp; see
 889 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 890 functions.  For example:
 891
 892  use Date::Parse;
 893  ...
 894  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 895
 896 If there is an error, returns the error, otherwise returns false.
 897
 898 =cut
 899
 900 sub bill {
 901   my( $self, %options ) = @_;
 902   my $time = $options{'time'} || time;
 903
 904   my $error;
 905
 906   #put below somehow?
 907   local $SIG{HUP} = 'IGNORE';
 908   local $SIG{INT} = 'IGNORE';
 909   local $SIG{QUIT} = 'IGNORE';
 910   local $SIG{TERM} = 'IGNORE';
 911   local $SIG{TSTP} = 'IGNORE';
 912   local $SIG{PIPE} = 'IGNORE';
 913
 914   my $oldAutoCommit = $FS::UID::AutoCommit;
 915   local $FS::UID::AutoCommit = 0;
 916   my $dbh = dbh;
 917
 918   # find the packages which are due for billing, find out how much they are
 919   # & generate invoice database.
 920
 921   my( $total_setup, $total_recur ) = ( 0, 0 );
 922   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 923   my @cust_bill_pkg = ();
 924   my $tax = 0;##
 925   #my $taxable_charged = 0;##
 926   #my $charged = 0;##
 927
 928   foreach my $cust_pkg (
 929     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
 930   ) {
 931
 932     #NO!! next if $cust_pkg->cancel;
 933     next if $cust_pkg->getfield('cancel');
 934
 935     #? to avoid use of uninitialized value errors... ?
 936     $cust_pkg->setfield('bill', '')
 937       unless defined($cust_pkg->bill);
 938
 939     my $part_pkg = $cust_pkg->part_pkg;
 940
 941     #so we don't modify cust_pkg record unnecessarily
 942     my $cust_pkg_mod_flag = 0;
 943     my %hash = $cust_pkg->hash;
 944     my $old_cust_pkg = new FS::cust_pkg \%hash;
 945
 946     # bill setup
 947     my $setup = 0;
 948     unless ( $cust_pkg->setup ) {
 949       my $setup_prog = $part_pkg->getfield('setup');
 950       $setup_prog =~ /^(.*)$/ or do {
 951         $dbh->rollback if $oldAutoCommit;
 952         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 953                ": $setup_prog";
 954       };
 955       $setup_prog = $1;
 956
 957         #my $cpt = new Safe;
 958         ##$cpt->permit(); #what is necessary?
 959         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 960         #$setup = $cpt->reval($setup_prog);
 961       $setup = eval $setup_prog;
 962       unless ( defined($setup) ) {
 963         $dbh->rollback if $oldAutoCommit;
 964         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 965                "(expression $setup_prog): $@";
 966       }
 967       $cust_pkg->setfield('setup',$time);
 968       $cust_pkg_mod_flag=1;
 969     }
 970
 971     #bill recurring fee
 972     my $recur = 0;
 973     my $sdate;
 974     if ( $part_pkg->getfield('freq') > 0 &&
 975          ! $cust_pkg->getfield('susp') &&
 976          ( $cust_pkg->getfield('bill') || 0 ) < $time
 977     ) {
 978       my $recur_prog = $part_pkg->getfield('recur');
 979       $recur_prog =~ /^(.*)$/ or do {
 980         $dbh->rollback if $oldAutoCommit;
 981         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
 982                ": $recur_prog";
 983       };
 984       $recur_prog = $1;
 985
 986       # shared with $recur_prog
 987       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 988
 989         #my $cpt = new Safe;
 990         ##$cpt->permit(); #what is necessary?
 991         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 992         #$recur = $cpt->reval($recur_prog);
 993       $recur = eval $recur_prog;
 994       unless ( defined($recur) ) {
 995         $dbh->rollback if $oldAutoCommit;
 996         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
 997                "(expression $recur_prog): $@";
 998       }
 999       #change this bit to use Date::Manip? CAREFUL with timezones (see
1000       # mailing list archive)
1001       my ($sec,$min,$hour,$mday,$mon,$year) =
1002         (localtime($sdate) )[0,1,2,3,4,5];
1003
1004       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1005       # only for figuring next bill date, nothing else, so, reset $sdate again
1006       # here
1007       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1008
1009       $mon += $part_pkg->freq;
1010       until ( $mon < 12 ) { $mon -= 12; $year++; }
1011       $cust_pkg->setfield('bill',
1012         timelocal($sec,$min,$hour,$mday,$mon,$year));
1013       $cust_pkg_mod_flag = 1;
1014     }
1015
1016     warn "\$setup is undefined" unless defined($setup);
1017     warn "\$recur is undefined" unless defined($recur);
1018     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1019
1020     my $taxable_charged = 0;
1021     if ( $cust_pkg_mod_flag ) {
1022       $error=$cust_pkg->replace($old_cust_pkg);
1023       if ( $error ) { #just in case
1024         $dbh->rollback if $oldAutoCommit;
1025         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1026       }
1027       $setup = sprintf( "%.2f", $setup );
1028       $recur = sprintf( "%.2f", $recur );
1029       if ( $setup < 0 ) {
1030         $dbh->rollback if $oldAutoCommit;
1031         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1032       }
1033       if ( $recur < 0 ) {
1034         $dbh->rollback if $oldAutoCommit;
1035         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1036       }
1037       if ( $setup > 0 || $recur > 0 ) {
1038         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1039           'pkgnum' => $cust_pkg->pkgnum,
1040           'setup'  => $setup,
1041           'recur'  => $recur,
1042           'sdate'  => $sdate,
1043           'edate'  => $cust_pkg->bill,
1044         });
1045         push @cust_bill_pkg, $cust_bill_pkg;
1046         $total_setup += $setup;
1047         $total_recur += $recur;
1048         $taxable_charged += $setup
1049           unless $part_pkg->setuptax =~ /^Y$/i;
1050         $taxable_charged += $recur
1051           unless $part_pkg->recurtax =~ /^Y$/i;
1052
1053         unless ( $self->tax =~ /Y/i
1054                  || $self->payby eq 'COMP'
1055                  || $taxable_charged == 0 ) {
1056
1057           my $cust_main_county = qsearchs('cust_main_county',{
1058               'state'    => $self->state,
1059               'county'   => $self->county,
1060               'country'  => $self->country,
1061               'taxclass' => $part_pkg->taxclass,
1062           } );
1063           $cust_main_county ||= qsearchs('cust_main_county',{
1064               'state'    => $self->state,
1065               'county'   => $self->county,
1066               'country'  => $self->country,
1067               'taxclass' => '',
1068           } );
1069           unless ( $cust_main_county ) {
1070             $dbh->rollback if $oldAutoCommit;
1071             return
1072               "fatal: can't find tax rate for state/county/country/taxclass ".
1073               join('/', ( map $self->$_(), qw(state county country) ),
1074                         $part_pkg->taxclass ).  "\n";
1075           }
1076
1077           if ( $cust_main_county->exempt_amount ) {
1078             my ($mon,$year) = (localtime($sdate) )[4,5];
1079             $mon++;
1080             my $freq = $part_pkg->freq || 1;
1081             my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1082             foreach my $which_month ( 1 .. $freq ) {
1083               my %hash = (
1084                 'custnum' => $self->custnum,
1085                 'taxnum'  => $cust_main_county->taxnum,
1086                 'year'    => 1900+$year,
1087                 'month'   => $mon++,
1088               );
1089               #until ( $mon < 12 ) { $mon -= 12; $year++; }
1090               until ( $mon < 13 ) { $mon -= 12; $year++; }
1091               my $cust_tax_exempt =
1092                 qsearchs('cust_tax_exempt', \%hash)
1093                 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1094               my $remaining_exemption = sprintf("%.2f",
1095                 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1096               if ( $remaining_exemption > 0 ) {
1097                 my $addl = $remaining_exemption > $taxable_per_month
1098                   ? $taxable_per_month
1099                   : $remaining_exemption;
1100                 $taxable_charged -= $addl;
1101                 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1102                   $cust_tax_exempt->hash,
1103                   'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1104                 } );
1105                 $error = $new_cust_tax_exempt->exemptnum
1106                   ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1107                   : $new_cust_tax_exempt->insert;
1108                 if ( $error ) {
1109                   $dbh->rollback if $oldAutoCommit;
1110                   return "fatal: can't update cust_tax_exempt: $error";
1111                 }
1112
1113               } # if $remaining_exemption > 0
1114
1115             } #foreach $which_month
1116
1117           } #if $cust_main_county->exempt_amount
1118
1119           $taxable_charged = sprintf( "%.2f", $taxable_charged);
1120           $tax += $taxable_charged * $cust_main_county->tax / 100
1121
1122         } #unless $self->tax =~ /Y/i
1123           #       || $self->payby eq 'COMP'
1124           #       || $taxable_charged == 0
1125
1126       } #if $setup > 0 || $recur > 0
1127
1128     } #if $cust_pkg_mod_flag
1129
1130   } #foreach my $cust_pkg
1131
1132   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1133 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1134
1135   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1136     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1137     return '';
1138   }
1139
1140 #  unless ( $self->tax =~ /Y/i
1141 #           || $self->payby eq 'COMP'
1142 #           || $taxable_charged == 0 ) {
1143 #    my $cust_main_county = qsearchs('cust_main_county',{
1144 #        'state'   => $self->state,
1145 #        'county'  => $self->county,
1146 #        'country' => $self->country,
1147 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1148 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1149 #    my $tax = sprintf( "%.2f",
1150 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1151 #    );
1152
1153   $tax = sprintf("%.2f", $tax);
1154   if ( $tax > 0 ) {
1155     $charged = sprintf( "%.2f", $charged+$tax );
1156
1157     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1158       'pkgnum' => 0,
1159       'setup'  => $tax,
1160       'recur'  => 0,
1161       'sdate'  => '',
1162       'edate'  => '',
1163     });
1164     push @cust_bill_pkg, $cust_bill_pkg;
1165   }
1166 #  }
1167
1168   my $cust_bill = new FS::cust_bill ( {
1169     'custnum' => $self->custnum,
1170     '_date'   => $time,
1171     'charged' => $charged,
1172   } );
1173   $error = $cust_bill->insert;
1174   if ( $error ) {
1175     $dbh->rollback if $oldAutoCommit;
1176     return "can't create invoice for customer #". $self->custnum. ": $error";
1177   }
1178
1179   my $invnum = $cust_bill->invnum;
1180   my $cust_bill_pkg;
1181   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1182     #warn $invnum;
1183     $cust_bill_pkg->invnum($invnum);
1184     $error = $cust_bill_pkg->insert;
1185     if ( $error ) {
1186       $dbh->rollback if $oldAutoCommit;
1187       return "can't create invoice line item for customer #". $self->custnum.
1188              ": $error";
1189     }
1190   }
1191
1192   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1193   ''; #no error
1194 }
1195
1196 =item collect OPTIONS
1197
1198 (Attempt to) collect money for this customer's outstanding invoices (see
1199 L<FS::cust_bill>).  Usually used after the bill method.
1200
1201 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1202 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1203
1204 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1205 and the invoice events web interface.
1206
1207 If there is an error, returns the error, otherwise returns false.
1208
1209 Options are passed as name-value pairs.
1210
1211 Currently available options are:
1212
1213 invoice_time - Use this time when deciding when to print invoices and
1214 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>
1215 for conversion functions.
1216
1217 retry_card - Retry cards even when not scheduled by invoice events.
1218
1219 batch_card - This option is deprecated.  See the invoice events web interface
1220 to control whether cards are batched or run against a realtime gateway.
1221
1222 report_badcard - This option is deprecated.
1223
1224 force_print - This option is deprecated; see the invoice events web interface.
1225
1226 =cut
1227
1228 sub collect {
1229   my( $self, %options ) = @_;
1230   my $invoice_time = $options{'invoice_time'} || time;
1231
1232   #put below somehow?
1233   local $SIG{HUP} = 'IGNORE';
1234   local $SIG{INT} = 'IGNORE';
1235   local $SIG{QUIT} = 'IGNORE';
1236   local $SIG{TERM} = 'IGNORE';
1237   local $SIG{TSTP} = 'IGNORE';
1238   local $SIG{PIPE} = 'IGNORE';
1239
1240   my $oldAutoCommit = $FS::UID::AutoCommit;
1241   local $FS::UID::AutoCommit = 0;
1242   my $dbh = dbh;
1243
1244   my $balance = $self->balance;
1245   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1246   unless ( $balance > 0 ) { #redundant?????
1247     $dbh->rollback if $oldAutoCommit; #hmm
1248     return '';
1249   }
1250
1251   if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1252     #false laziness w/replace
1253     foreach my $cust_bill_event (
1254       grep {
1255              #$_->part_bill_event->plan eq 'realtime-card'
1256              $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1257                && $_->status eq 'done'
1258                && $_->statustext
1259            }
1260         map { $_->cust_bill_event }
1261           grep { $_->cust_bill_event }
1262             $self->open_cust_bill
1263     ) {
1264       my $error = $cust_bill_event->retry;
1265       if ( $error ) {
1266         $dbh->rollback if $oldAutoCommit;
1267         return "error scheduling invoice events for retry: $error";
1268       }
1269     }
1270     #eslaf
1271   }
1272
1273   foreach my $cust_bill ( $self->cust_bill ) {
1274
1275     #this has to be before next's
1276     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1277                                   ? $balance
1278                                   : $cust_bill->owed
1279     );
1280     $balance = sprintf( "%.2f", $balance - $amount );
1281
1282     next unless $cust_bill->owed > 0;
1283
1284     # don't try to charge for the same invoice if it's already in a batch
1285     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1286
1287     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1288
1289     next unless $amount > 0;
1290
1291
1292     foreach my $part_bill_event (
1293       sort {    $a->seconds   <=> $b->seconds
1294              || $a->weight    <=> $b->weight
1295              || $a->eventpart <=> $b->eventpart }
1296         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1297                && ! qsearchs( 'cust_bill_event', {
1298                                 'invnum'    => $cust_bill->invnum,
1299                                 'eventpart' => $_->eventpart,
1300                                 'status'    => 'done',
1301                                                                    } )
1302              }
1303           qsearch('part_bill_event', { 'payby'    => $self->payby,
1304                                        'disabled' => '',           } )
1305     ) {
1306
1307       last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1308
1309       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1310         if $Debug;
1311       my $cust_main = $self; #for callback
1312       my $error = eval $part_bill_event->eventcode;
1313
1314       my $status = '';
1315       my $statustext = '';
1316       if ( $@ ) {
1317         $status = 'failed';
1318         $statustext = $@;
1319       } elsif ( $error ) {
1320         $status = 'done';
1321         $statustext = $error;
1322       } else {
1323         $status = 'done'
1324       }
1325
1326       #add cust_bill_event
1327       my $cust_bill_event = new FS::cust_bill_event {
1328         'invnum'     => $cust_bill->invnum,
1329         'eventpart'  => $part_bill_event->eventpart,
1330         '_date'      => $invoice_time,
1331         'status'     => $status,
1332         'statustext' => $statustext,
1333       };
1334       $error = $cust_bill_event->insert;
1335       if ( $error ) {
1336         #$dbh->rollback if $oldAutoCommit;
1337         #return "error: $error";
1338
1339         # gah, even with transactions.
1340         $dbh->commit if $oldAutoCommit; #well.
1341         my $e = 'WARNING: Event run but database not updated - '.
1342                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1343                 ', eventpart '. $part_bill_event->eventpart.
1344                 ": $error";
1345         warn $e;
1346         return $e;
1347       }
1348
1349
1350     }
1351
1352   }
1353
1354   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1355   '';
1356
1357 }
1358
1359 =item total_owed
1360
1361 Returns the total owed for this customer on all invoices
1362 (see L<FS::cust_bill/owed>).
1363
1364 =cut
1365
1366 sub total_owed {
1367   my $self = shift;
1368   $self->total_owed_date(2145859200); #12/31/2037
1369 }
1370
1371 =item total_owed_date TIME
1372
1373 Returns the total owed for this customer on all invoices with date earlier than
1374 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1375 see L<Time::Local> and L<Date::Parse> for conversion functions.
1376
1377 =cut
1378
1379 sub total_owed_date {
1380   my $self = shift;
1381   my $time = shift;
1382   my $total_bill = 0;
1383   foreach my $cust_bill (
1384     grep { $_->_date <= $time }
1385       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1386   ) {
1387     $total_bill += $cust_bill->owed;
1388   }
1389   sprintf( "%.2f", $total_bill );
1390 }
1391
1392 =item apply_credits
1393
1394 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1395 to outstanding invoice balances in chronological order and returns the value
1396 of any remaining unapplied credits available for refund
1397 (see L<FS::cust_refund>).
1398
1399 =cut
1400
1401 sub apply_credits {
1402   my $self = shift;
1403
1404   return 0 unless $self->total_credited;
1405
1406   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1407       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1408
1409   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1410       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1411
1412   my $credit;
1413
1414   foreach my $cust_bill ( @invoices ) {
1415     my $amount;
1416
1417     if ( !defined($credit) || $credit->credited == 0) {
1418       $credit = pop @credits or last;
1419     }
1420
1421     if ($cust_bill->owed >= $credit->credited) {
1422       $amount=$credit->credited;
1423     }else{
1424       $amount=$cust_bill->owed;
1425     }
1426
1427     my $cust_credit_bill = new FS::cust_credit_bill ( {
1428       'crednum' => $credit->crednum,
1429       'invnum'  => $cust_bill->invnum,
1430       'amount'  => $amount,
1431     } );
1432     my $error = $cust_credit_bill->insert;
1433     die $error if $error;
1434
1435     redo if ($cust_bill->owed > 0);
1436
1437   }
1438
1439   return $self->total_credited;
1440 }
1441
1442 =item apply_payments
1443
1444 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1445 to outstanding invoice balances in chronological order.
1446
1447  #and returns the value of any remaining unapplied payments.
1448
1449 =cut
1450
1451 sub apply_payments {
1452   my $self = shift;
1453
1454   #return 0 unless
1455
1456   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1457       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1458
1459   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1460       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1461
1462   my $payment;
1463
1464   foreach my $cust_bill ( @invoices ) {
1465     my $amount;
1466
1467     if ( !defined($payment) || $payment->unapplied == 0 ) {
1468       $payment = pop @payments or last;
1469     }
1470
1471     if ( $cust_bill->owed >= $payment->unapplied ) {
1472       $amount = $payment->unapplied;
1473     } else {
1474       $amount = $cust_bill->owed;
1475     }
1476
1477     my $cust_bill_pay = new FS::cust_bill_pay ( {
1478       'paynum' => $payment->paynum,
1479       'invnum' => $cust_bill->invnum,
1480       'amount' => $amount,
1481     } );
1482     my $error = $cust_bill_pay->insert;
1483     die $error if $error;
1484
1485     redo if ( $cust_bill->owed > 0);
1486
1487   }
1488
1489   return $self->total_unapplied_payments;
1490 }
1491
1492 =item total_credited
1493
1494 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1495 customer.  See L<FS::cust_credit/credited>.
1496
1497 =cut
1498
1499 sub total_credited {
1500   my $self = shift;
1501   my $total_credit = 0;
1502   foreach my $cust_credit ( qsearch('cust_credit', {
1503     'custnum' => $self->custnum,
1504   } ) ) {
1505     $total_credit += $cust_credit->credited;
1506   }
1507   sprintf( "%.2f", $total_credit );
1508 }
1509
1510 =item total_unapplied_payments
1511
1512 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1513 See L<FS::cust_pay/unapplied>.
1514
1515 =cut
1516
1517 sub total_unapplied_payments {
1518   my $self = shift;
1519   my $total_unapplied = 0;
1520   foreach my $cust_pay ( qsearch('cust_pay', {
1521     'custnum' => $self->custnum,
1522   } ) ) {
1523     $total_unapplied += $cust_pay->unapplied;
1524   }
1525   sprintf( "%.2f", $total_unapplied );
1526 }
1527
1528 =item balance
1529
1530 Returns the balance for this customer (total_owed minus total_credited
1531 minus total_unapplied_payments).
1532
1533 =cut
1534
1535 sub balance {
1536   my $self = shift;
1537   sprintf( "%.2f",
1538     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1539   );
1540 }
1541
1542 =item balance_date TIME
1543
1544 Returns the balance for this customer, only considering invoices with date
1545 earlier than TIME (total_owed_date minus total_credited minus
1546 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1547 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1548 functions.
1549
1550 =cut
1551
1552 sub balance_date {
1553   my $self = shift;
1554   my $time = shift;
1555   sprintf( "%.2f",
1556     $self->total_owed_date($time)
1557       - $self->total_credited
1558       - $self->total_unapplied_payments
1559   );
1560 }
1561
1562 =item invoicing_list [ ARRAYREF ]
1563
1564 If an arguement is given, sets these email addresses as invoice recipients
1565 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1566 (except as warnings), so use check_invoicing_list first.
1567
1568 Returns a list of email addresses (with svcnum entries expanded).
1569
1570 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1571 check it without disturbing anything by passing nothing.
1572
1573 This interface may change in the future.
1574
1575 =cut
1576
1577 sub invoicing_list {
1578   my( $self, $arrayref ) = @_;
1579   if ( $arrayref ) {
1580     my @cust_main_invoice;
1581     if ( $self->custnum ) {
1582       @cust_main_invoice =
1583         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1584     } else {
1585       @cust_main_invoice = ();
1586     }
1587     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1588       #warn $cust_main_invoice->destnum;
1589       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1590         #warn $cust_main_invoice->destnum;
1591         my $error = $cust_main_invoice->delete;
1592         warn $error if $error;
1593       }
1594     }
1595     if ( $self->custnum ) {
1596       @cust_main_invoice =
1597         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1598     } else {
1599       @cust_main_invoice = ();
1600     }
1601     my %seen = map { $_->address => 1 } @cust_main_invoice;
1602     foreach my $address ( @{$arrayref} ) {
1603       next if exists $seen{$address} && $seen{$address};
1604       $seen{$address} = 1;
1605       my $cust_main_invoice = new FS::cust_main_invoice ( {
1606         'custnum' => $self->custnum,
1607         'dest'    => $address,
1608       } );
1609       my $error = $cust_main_invoice->insert;
1610       warn $error if $error;
1611     }
1612   }
1613   if ( $self->custnum ) {
1614     map { $_->address }
1615       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1616   } else {
1617     ();
1618   }
1619 }
1620
1621 =item check_invoicing_list ARRAYREF
1622
1623 Checks these arguements as valid input for the invoicing_list method.  If there
1624 is an error, returns the error, otherwise returns false.
1625
1626 =cut
1627
1628 sub check_invoicing_list {
1629   my( $self, $arrayref ) = @_;
1630   foreach my $address ( @{$arrayref} ) {
1631     my $cust_main_invoice = new FS::cust_main_invoice ( {
1632       'custnum' => $self->custnum,
1633       'dest'    => $address,
1634     } );
1635     my $error = $self->custnum
1636                 ? $cust_main_invoice->check
1637                 : $cust_main_invoice->checkdest
1638     ;
1639     return $error if $error;
1640   }
1641   '';
1642 }
1643
1644 =item set_default_invoicing_list
1645
1646 Sets the invoicing list to all accounts associated with this customer,
1647 overwriting any previous invoicing list.
1648
1649 =cut
1650
1651 sub set_default_invoicing_list {
1652   my $self = shift;
1653   $self->invoicing_list($self->all_emails);
1654 }
1655
1656 =item all_emails
1657
1658 Returns the email addresses of all accounts provisioned for this customer.
1659
1660 =cut
1661
1662 sub all_emails {
1663   my $self = shift;
1664   my %list;
1665   foreach my $cust_pkg ( $self->all_pkgs ) {
1666     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1667     my @svc_acct =
1668       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1669         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1670           @cust_svc;
1671     $list{$_}=1 foreach map { $_->email } @svc_acct;
1672   }
1673   keys %list;
1674 }
1675
1676 =item invoicing_list_addpost
1677
1678 Adds postal invoicing to this customer.  If this customer is already configured
1679 to receive postal invoices, does nothing.
1680
1681 =cut
1682
1683 sub invoicing_list_addpost {
1684   my $self = shift;
1685   return if grep { $_ eq 'POST' } $self->invoicing_list;
1686   my @invoicing_list = $self->invoicing_list;
1687   push @invoicing_list, 'POST';
1688   $self->invoicing_list(\@invoicing_list);
1689 }
1690
1691 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1692
1693 Returns an array of customers referred by this customer (referral_custnum set
1694 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1695 customers referred by customers referred by this customer and so on, inclusive.
1696 The default behavior is DEPTH 1 (no recursion).
1697
1698 =cut
1699
1700 sub referral_cust_main {
1701   my $self = shift;
1702   my $depth = @_ ? shift : 1;
1703   my $exclude = @_ ? shift : {};
1704
1705   my @cust_main =
1706     map { $exclude->{$_->custnum}++; $_; }
1707       grep { ! $exclude->{ $_->custnum } }
1708         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1709
1710   if ( $depth > 1 ) {
1711     push @cust_main,
1712       map { $_->referral_cust_main($depth-1, $exclude) }
1713         @cust_main;
1714   }
1715
1716   @cust_main;
1717 }
1718
1719 =item referral_cust_main_ncancelled
1720
1721 Same as referral_cust_main, except only returns customers with uncancelled
1722 packages.
1723
1724 =cut
1725
1726 sub referral_cust_main_ncancelled {
1727   my $self = shift;
1728   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1729 }
1730
1731 =item referral_cust_pkg [ DEPTH ]
1732
1733 Like referral_cust_main, except returns a flat list of all unsuspended (and
1734 uncancelled) packages for each customer.  The number of items in this list may
1735 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1736
1737 =cut
1738
1739 sub referral_cust_pkg {
1740   my $self = shift;
1741   my $depth = @_ ? shift : 1;
1742
1743   map { $_->unsuspended_pkgs }
1744     grep { $_->unsuspended_pkgs }
1745       $self->referral_cust_main($depth);
1746 }
1747
1748 =item credit AMOUNT, REASON
1749
1750 Applies a credit to this customer.  If there is an error, returns the error,
1751 otherwise returns false.
1752
1753 =cut
1754
1755 sub credit {
1756   my( $self, $amount, $reason ) = @_;
1757   my $cust_credit = new FS::cust_credit {
1758     'custnum' => $self->custnum,
1759     'amount'  => $amount,
1760     'reason'  => $reason,
1761   };
1762   $cust_credit->insert;
1763 }
1764
1765 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
1766
1767 Creates a one-time charge for this customer.  If there is an error, returns
1768 the error, otherwise returns false.
1769
1770 =cut
1771
1772 sub charge {
1773   my ( $self, $amount ) = ( shift, shift );
1774   my $pkg      = @_ ? shift : 'One-time charge';
1775   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
1776   my $taxclass = @_ ? shift : '';
1777
1778   local $SIG{HUP} = 'IGNORE';
1779   local $SIG{INT} = 'IGNORE';
1780   local $SIG{QUIT} = 'IGNORE';
1781   local $SIG{TERM} = 'IGNORE';
1782   local $SIG{TSTP} = 'IGNORE';
1783   local $SIG{PIPE} = 'IGNORE';
1784
1785   my $oldAutoCommit = $FS::UID::AutoCommit;
1786   local $FS::UID::AutoCommit = 0;
1787   my $dbh = dbh;
1788
1789   my $part_pkg = new FS::part_pkg ( {
1790     'pkg'      => $pkg,
1791     'comment'  => $comment,
1792     'setup'    => $amount,
1793     'freq'     => 0,
1794     'recur'    => '0',
1795     'disabled' => 'Y',
1796     'taxclass' => $taxclass,
1797   } );
1798
1799   my $error = $part_pkg->insert;
1800   if ( $error ) {
1801     $dbh->rollback if $oldAutoCommit;
1802     return $error;
1803   }
1804
1805   my $pkgpart = $part_pkg->pkgpart;
1806   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
1807   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
1808     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
1809     $error = $type_pkgs->insert;
1810     if ( $error ) {
1811       $dbh->rollback if $oldAutoCommit;
1812       return $error;
1813     }
1814   }
1815
1816   my $cust_pkg = new FS::cust_pkg ( {
1817     'custnum' => $self->custnum,
1818     'pkgpart' => $pkgpart,
1819   } );
1820
1821   $error = $cust_pkg->insert;
1822   if ( $error ) {
1823     $dbh->rollback if $oldAutoCommit;
1824     return $error;
1825   }
1826
1827   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1828   '';
1829
1830 }
1831
1832 =item cust_bill
1833
1834 Returns all the invoices (see L<FS::cust_bill>) for this customer.
1835
1836 =cut
1837
1838 sub cust_bill {
1839   my $self = shift;
1840   sort { $a->_date <=> $b->_date }
1841     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1842 }
1843
1844 =item open_cust_bill
1845
1846 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
1847 customer.
1848
1849 =cut
1850
1851 sub open_cust_bill {
1852   my $self = shift;
1853   grep { $_->owed > 0 } $self->cust_bill;
1854 }
1855
1856 =back
1857
1858 =head1 SUBROUTINES
1859
1860 =over 4
1861
1862 =item check_and_rebuild_fuzzyfiles
1863
1864 =cut
1865
1866 sub check_and_rebuild_fuzzyfiles {
1867   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1868   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1869     or &rebuild_fuzzyfiles;
1870 }
1871
1872 =item rebuild_fuzzyfiles
1873
1874 =cut
1875
1876 sub rebuild_fuzzyfiles {
1877
1878   use Fcntl qw(:flock);
1879
1880   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1881
1882   #last
1883
1884   open(LASTLOCK,">>$dir/cust_main.last")
1885     or die "can't open $dir/cust_main.last: $!";
1886   flock(LASTLOCK,LOCK_EX)
1887     or die "can't lock $dir/cust_main.last: $!";
1888
1889   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1890   push @all_last,
1891                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1892     if defined dbdef->table('cust_main')->column('ship_last');
1893
1894   open (LASTCACHE,">$dir/cust_main.last.tmp")
1895     or die "can't open $dir/cust_main.last.tmp: $!";
1896   print LASTCACHE join("\n", @all_last), "\n";
1897   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1898
1899   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1900   close LASTLOCK;
1901
1902   #company
1903
1904   open(COMPANYLOCK,">>$dir/cust_main.company")
1905     or die "can't open $dir/cust_main.company: $!";
1906   flock(COMPANYLOCK,LOCK_EX)
1907     or die "can't lock $dir/cust_main.company: $!";
1908
1909   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1910   push @all_company,
1911        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1912     if defined dbdef->table('cust_main')->column('ship_last');
1913
1914   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1915     or die "can't open $dir/cust_main.company.tmp: $!";
1916   print COMPANYCACHE join("\n", @all_company), "\n";
1917   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1918
1919   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1920   close COMPANYLOCK;
1921
1922 }
1923
1924 =item all_last
1925
1926 =cut
1927
1928 sub all_last {
1929   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1930   open(LASTCACHE,"<$dir/cust_main.last")
1931     or die "can't open $dir/cust_main.last: $!";
1932   my @array = map { chomp; $_; } <LASTCACHE>;
1933   close LASTCACHE;
1934   \@array;
1935 }
1936
1937 =item all_company
1938
1939 =cut
1940
1941 sub all_company {
1942   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1943   open(COMPANYCACHE,"<$dir/cust_main.company")
1944     or die "can't open $dir/cust_main.last: $!";
1945   my @array = map { chomp; $_; } <COMPANYCACHE>;
1946   close COMPANYCACHE;
1947   \@array;
1948 }
1949
1950 =item append_fuzzyfiles LASTNAME COMPANY
1951
1952 =cut
1953
1954 sub append_fuzzyfiles {
1955   my( $last, $company ) = @_;
1956
1957   &check_and_rebuild_fuzzyfiles;
1958
1959   use Fcntl qw(:flock);
1960
1961   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1962
1963   if ( $last ) {
1964
1965     open(LAST,">>$dir/cust_main.last")
1966       or die "can't open $dir/cust_main.last: $!";
1967     flock(LAST,LOCK_EX)
1968       or die "can't lock $dir/cust_main.last: $!";
1969
1970     print LAST "$last\n";
1971
1972     flock(LAST,LOCK_UN)
1973       or die "can't unlock $dir/cust_main.last: $!";
1974     close LAST;
1975   }
1976
1977   if ( $company ) {
1978
1979     open(COMPANY,">>$dir/cust_main.company")
1980       or die "can't open $dir/cust_main.company: $!";
1981     flock(COMPANY,LOCK_EX)
1982       or die "can't lock $dir/cust_main.company: $!";
1983
1984     print COMPANY "$company\n";
1985
1986     flock(COMPANY,LOCK_UN)
1987       or die "can't unlock $dir/cust_main.company: $!";
1988
1989     close COMPANY;
1990   }
1991
1992   1;
1993 }
1994
1995 =item batch_import
1996
1997 =cut
1998
1999 sub batch_import {
2000   my $param = shift;
2001   #warn join('-',keys %$param);
2002   my $fh = $param->{filehandle};
2003   my $agentnum = $param->{agentnum};
2004   my $refnum = $param->{refnum};
2005   my $pkgpart = $param->{pkgpart};
2006   my @fields = @{$param->{fields}};
2007
2008   eval "use Date::Parse;";
2009   die $@ if $@;
2010   eval "use Text::CSV_XS;";
2011   die $@ if $@;
2012
2013   my $csv = new Text::CSV_XS;
2014   #warn $csv;
2015   #warn $fh;
2016
2017   my $imported = 0;
2018   #my $columns;
2019
2020   local $SIG{HUP} = 'IGNORE';
2021   local $SIG{INT} = 'IGNORE';
2022   local $SIG{QUIT} = 'IGNORE';
2023   local $SIG{TERM} = 'IGNORE';
2024   local $SIG{TSTP} = 'IGNORE';
2025   local $SIG{PIPE} = 'IGNORE';
2026
2027   my $oldAutoCommit = $FS::UID::AutoCommit;
2028   local $FS::UID::AutoCommit = 0;
2029   my $dbh = dbh;
2030
2031   #while ( $columns = $csv->getline($fh) ) {
2032   my $line;
2033   while ( defined($line=<$fh>) ) {
2034
2035     $csv->parse($line) or do {
2036       $dbh->rollback if $oldAutoCommit;
2037       return "can't parse: ". $csv->error_input();
2038     };
2039
2040     my @columns = $csv->fields();
2041     #warn join('-',@columns);
2042
2043     my %cust_main = (
2044       agentnum => $agentnum,
2045       refnum   => $refnum,
2046       country  => 'US', #default
2047       payby    => 'BILL', #default
2048       paydate  => '12/2037', #default
2049     );
2050     my $billtime = time;
2051     my %cust_pkg = ( pkgpart => $pkgpart );
2052     foreach my $field ( @fields ) {
2053       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2054         #$cust_pkg{$1} = str2time( shift @$columns );
2055         if ( $1 eq 'setup' ) {
2056           $billtime = str2time(shift @columns);
2057         } else {
2058           $cust_pkg{$1} = str2time( shift @columns );
2059         }
2060       } else {
2061         #$cust_main{$field} = shift @$columns;
2062         $cust_main{$field} = shift @columns;
2063       }
2064     }
2065
2066     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2067     my $cust_main = new FS::cust_main ( \%cust_main );
2068     use Tie::RefHash;
2069     tie my %hash, 'Tie::RefHash'; #this part is important
2070     $hash{$cust_pkg} = [] if $pkgpart;
2071     my $error = $cust_main->insert( \%hash );
2072
2073     if ( $error ) {
2074       $dbh->rollback if $oldAutoCommit;
2075       return "can't insert customer for $line: $error";
2076     }
2077
2078     #false laziness w/bill.cgi
2079     $error = $cust_main->bill( 'time' => $billtime );
2080     if ( $error ) {
2081       $dbh->rollback if $oldAutoCommit;
2082       return "can't bill customer for $line: $error";
2083     }
2084
2085     $cust_main->apply_payments;
2086     $cust_main->apply_credits;
2087
2088     $error = $cust_main->collect();
2089     if ( $error ) {
2090       $dbh->rollback if $oldAutoCommit;
2091       return "can't collect customer for $line: $error";
2092     }
2093
2094     $imported++;
2095   }
2096
2097   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2098
2099   return "Empty file!" unless $imported;
2100
2101   ''; #no error
2102
2103 }
2104
2105 =item batch_charge
2106
2107 =cut
2108
2109 sub batch_charge {
2110   my $param = shift;
2111   #warn join('-',keys %$param);
2112   my $fh = $param->{filehandle};
2113   my @fields = @{$param->{fields}};
2114
2115   eval "use Date::Parse;";
2116   die $@ if $@;
2117   eval "use Text::CSV_XS;";
2118   die $@ if $@;
2119
2120   my $csv = new Text::CSV_XS;
2121   #warn $csv;
2122   #warn $fh;
2123
2124   my $imported = 0;
2125   #my $columns;
2126
2127   local $SIG{HUP} = 'IGNORE';
2128   local $SIG{INT} = 'IGNORE';
2129   local $SIG{QUIT} = 'IGNORE';
2130   local $SIG{TERM} = 'IGNORE';
2131   local $SIG{TSTP} = 'IGNORE';
2132   local $SIG{PIPE} = 'IGNORE';
2133
2134   my $oldAutoCommit = $FS::UID::AutoCommit;
2135   local $FS::UID::AutoCommit = 0;
2136   my $dbh = dbh;
2137
2138   #while ( $columns = $csv->getline($fh) ) {
2139   my $line;
2140   while ( defined($line=<$fh>) ) {
2141
2142     $csv->parse($line) or do {
2143       $dbh->rollback if $oldAutoCommit;
2144       return "can't parse: ". $csv->error_input();
2145     };
2146
2147     my @columns = $csv->fields();
2148     #warn join('-',@columns);
2149
2150     my %row = ();
2151     foreach my $field ( @fields ) {
2152       $row{$field} = shift @columns;
2153     }
2154
2155     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2156     unless ( $cust_main ) {
2157       $dbh->rollback if $oldAutoCommit;
2158       return "unknown custnum $row{'custnum'}";
2159     }
2160
2161     if ( $row{'amount'} > 0 ) {
2162       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2163       if ( $error ) {
2164         $dbh->rollback if $oldAutoCommit;
2165         return $error;
2166       }
2167       $imported++;
2168     } elsif ( $row{'amount'} < 0 ) {
2169       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2170                                       $row{'pkg'}                         );
2171       if ( $error ) {
2172         $dbh->rollback if $oldAutoCommit;
2173         return $error;
2174       }
2175       $imported++;
2176     } else {
2177       #hmm?
2178     }
2179
2180   }
2181
2182   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2183
2184   return "Empty file!" unless $imported;
2185
2186   ''; #no error
2187
2188 }
2189
2190 =back
2191
2192 =head1 BUGS
2193
2194 The delete method.
2195
2196 The delete method should possibly take an FS::cust_main object reference
2197 instead of a scalar customer number.
2198
2199 Bill and collect options should probably be passed as references instead of a
2200 list.
2201
2202 There should probably be a configuration file with a list of allowed credit
2203 card types.
2204
2205 No multiple currency support (probably a larger project than just this module).
2206
2207 =head1 SEE ALSO
2208
2209 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2210 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2211 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2212
2213 =cut
2214
2215 1;
2216
2217