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