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