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