FS/FS/cust_main.pm

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