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