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