FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $Debug $import );
   5 use vars qw( $realtime_bop_decline_quiet ); #ugh
   6 use Safe;
   7 use Carp;
   8 BEGIN {
   9   eval "use Time::Local;";
  10   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  11     if $] < 5.006 && !defined($Time::Local::VERSION);
  12   eval "use Time::Local qw(timelocal timelocal_nocheck);";
  13 }
  14 use Date::Format;
  15 #use Date::Manip;
  16 use Business::CreditCard;
  17 use FS::UID qw( getotaker dbh );
  18 use FS::Record qw( qsearchs qsearch dbdef );
  19 use FS::Misc qw( send_email );
  20 use FS::cust_pkg;
  21 use FS::cust_bill;
  22 use FS::cust_bill_pkg;
  23 use FS::cust_pay;
  24 use FS::cust_credit;
  25 use FS::cust_refund;
  26 use FS::part_referral;
  27 use FS::cust_main_county;
  28 use FS::agent;
  29 use FS::cust_main_invoice;
  30 use FS::cust_credit_bill;
  31 use FS::cust_bill_pay;
  32 use FS::prepay_credit;
  33 use FS::queue;
  34 use FS::part_pkg;
  35 use FS::part_bill_event;
  36 use FS::cust_bill_event;
  37 use FS::cust_tax_exempt;
  38 use FS::type_pkgs;
  39 use FS::Msgcat qw(gettext);
  40
  41 @ISA = qw( FS::Record );
  42
  43 $realtime_bop_decline_quiet = 0;
  44
  45 $Debug = 0;
  46 #$Debug = 1;
  47
  48 $import = 0;
  49
  50 #ask FS::UID to run this stuff for us later
  51 #$FS::UID::callback{'FS::cust_main'} = sub {
  52 install_callback FS::UID sub {
  53   $conf = new FS::Conf;
  54   #yes, need it for stuff below (prolly should be cached)
  55 };
  56
  57 sub _cache {
  58   my $self = shift;
  59   my ( $hashref, $cache ) = @_;
  60   if ( exists $hashref->{'pkgnum'} ) {
  61 #    #@{ $self->{'_pkgnum'} } = ();
  62     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  63     $self->{'_pkgnum'} = $subcache;
  64     #push @{ $self->{'_pkgnum'} },
  65     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  66   }
  67 }
  68
  69 =head1 NAME
  70
  71 FS::cust_main - Object methods for cust_main records
  72
  73 =head1 SYNOPSIS
  74
  75   use FS::cust_main;
  76
  77   $record = new FS::cust_main \%hash;
  78   $record = new FS::cust_main { 'column' => 'value' };
  79
  80   $error = $record->insert;
  81
  82   $error = $new_record->replace($old_record);
  83
  84   $error = $record->delete;
  85
  86   $error = $record->check;
  87
  88   @cust_pkg = $record->all_pkgs;
  89
  90   @cust_pkg = $record->ncancelled_pkgs;
  91
  92   @cust_pkg = $record->suspended_pkgs;
  93
  94   $error = $record->bill;
  95   $error = $record->bill %options;
  96   $error = $record->bill 'time' => $time;
  97
  98   $error = $record->collect;
  99   $error = $record->collect %options;
 100   $error = $record->collect 'invoice_time'   => $time,
 101                             'batch_card'     => 'yes',
 102                             'report_badcard' => 'yes',
 103                           ;
 104
 105 =head1 DESCRIPTION
 106
 107 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 108 FS::Record.  The following fields are currently supported:
 109
 110 =over 4
 111
 112 =item custnum - primary key (assigned automatically for new customers)
 113
 114 =item agentnum - agent (see L<FS::agent>)
 115
 116 =item refnum - Advertising source (see L<FS::part_referral>)
 117
 118 =item first - name
 119
 120 =item last - name
 121
 122 =item ss - social security number (optional)
 123
 124 =item company - (optional)
 125
 126 =item address1
 127
 128 =item address2 - (optional)
 129
 130 =item city
 131
 132 =item county - (optional, see L<FS::cust_main_county>)
 133
 134 =item state - (see L<FS::cust_main_county>)
 135
 136 =item zip
 137
 138 =item country - (see L<FS::cust_main_county>)
 139
 140 =item daytime - phone (optional)
 141
 142 =item night - phone (optional)
 143
 144 =item fax - phone (optional)
 145
 146 =item ship_first - name
 147
 148 =item ship_last - name
 149
 150 =item ship_company - (optional)
 151
 152 =item ship_address1
 153
 154 =item ship_address2 - (optional)
 155
 156 =item ship_city
 157
 158 =item ship_county - (optional, see L<FS::cust_main_county>)
 159
 160 =item ship_state - (see L<FS::cust_main_county>)
 161
 162 =item ship_zip
 163
 164 =item ship_country - (see L<FS::cust_main_county>)
 165
 166 =item ship_daytime - phone (optional)
 167
 168 =item ship_night - phone (optional)
 169
 170 =item ship_fax - phone (optional)
 171
 172 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
 173
 174 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 175
 176 =item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
 177
 178 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 179
 180 =item payname - name on card or billing name
 181
 182 =item tax - tax exempt, empty or `Y'
 183
 184 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 185
 186 =item comments - comments (optional)
 187
 188 =item referral_custnum - referring customer number
 189
 190 =back
 191
 192 =head1 METHODS
 193
 194 =over 4
 195
 196 =item new HASHREF
 197
 198 Creates a new customer.  To add the customer to the database, see L<"insert">.
 199
 200 Note that this stores the hash reference, not a distinct copy of the hash it
 201 points to.  You can ask the object for a copy with the I<hash> method.
 202
 203 =cut
 204
 205 sub table { 'cust_main'; }
 206
 207 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 208
 209 Adds this customer to the database.  If there is an error, returns the error,
 210 otherwise returns false.
 211
 212 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 213 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 214 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 215 hash reference is equivalent to not supplying this parameter.  There should be
 216 a better explanation of this, but until then, here's an example:
 217
 218   use Tie::RefHash;
 219   tie %hash, 'Tie::RefHash'; #this part is important
 220   %hash = (
 221     $cust_pkg => [ $svc_acct ],
 222     ...
 223   );
 224   $cust_main->insert( \%hash );
 225
 226 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 227 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 228 expected and rollback the entire transaction; it is not necessary to call
 229 check_invoicing_list first.  The invoicing_list is set after the records in the
 230 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 231 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 232
 233   $cust_main->insert( {}, [ $email, 'POST' ] );
 234
 235 Currently available options are: I<noexport>
 236
 237 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
 238 (You can schedule them later with the B<reexport> method.)
 239
 240 =cut
 241
 242 sub insert {
 243   my $self = shift;
 244   my $cust_pkgs = @_ ? shift : {};
 245   my $invoicing_list = @_ ? shift : '';
 246   my %options = @_;
 247
 248   local $SIG{HUP} = 'IGNORE';
 249   local $SIG{INT} = 'IGNORE';
 250   local $SIG{QUIT} = 'IGNORE';
 251   local $SIG{TERM} = 'IGNORE';
 252   local $SIG{TSTP} = 'IGNORE';
 253   local $SIG{PIPE} = 'IGNORE';
 254
 255   my $oldAutoCommit = $FS::UID::AutoCommit;
 256   local $FS::UID::AutoCommit = 0;
 257   my $dbh = dbh;
 258
 259   my $amount = 0;
 260   my $seconds = 0;
 261   if ( $self->payby eq 'PREPAY' ) {
 262     $self->payby('BILL');
 263     my $prepay_credit = qsearchs(
 264       'prepay_credit',
 265       { 'identifier' => $self->payinfo },
 266       '',
 267       'FOR UPDATE'
 268     );
 269     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 270       unless $prepay_credit;
 271     $amount = $prepay_credit->amount;
 272     $seconds = $prepay_credit->seconds;
 273     my $error = $prepay_credit->delete;
 274     if ( $error ) {
 275       $dbh->rollback if $oldAutoCommit;
 276       return "removing prepay_credit (transaction rolled back): $error";
 277     }
 278   }
 279
 280   my $error = $self->SUPER::insert;
 281   if ( $error ) {
 282     $dbh->rollback if $oldAutoCommit;
 283     #return "inserting cust_main record (transaction rolled back): $error";
 284     return $error;
 285   }
 286
 287   # invoicing list
 288   if ( $invoicing_list ) {
 289     $error = $self->check_invoicing_list( $invoicing_list );
 290     if ( $error ) {
 291       $dbh->rollback if $oldAutoCommit;
 292       return "checking invoicing_list (transaction rolled back): $error";
 293     }
 294     $self->invoicing_list( $invoicing_list );
 295   }
 296
 297   # packages
 298   #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 299   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 300   if ( $error ) {
 301     $dbh->rollback if $oldAutoCommit;
 302     return $error;
 303   }
 304
 305   if ( $seconds ) {
 306     $dbh->rollback if $oldAutoCommit;
 307     return "No svc_acct record to apply pre-paid time";
 308   }
 309
 310   if ( $amount ) {
 311     my $cust_credit = new FS::cust_credit {
 312       'custnum' => $self->custnum,
 313       'amount'  => $amount,
 314     };
 315     $error = $cust_credit->insert;
 316     if ( $error ) {
 317       $dbh->rollback if $oldAutoCommit;
 318       return "inserting credit (transaction rolled back): $error";
 319     }
 320   }
 321
 322   $error = $self->queue_fuzzyfiles_update;
 323   if ( $error ) {
 324     $dbh->rollback if $oldAutoCommit;
 325     return "updating fuzzy search cache: $error";
 326   }
 327
 328   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 329   '';
 330
 331 }
 332
 333 =item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
 334
 335 Like the insert method on an existing record, this method orders a package
 336 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 337 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 338 be a better explanation of this, but until then, here's an example:
 339
 340   use Tie::RefHash;
 341   tie %hash, 'Tie::RefHash'; #this part is important
 342   %hash = (
 343     $cust_pkg => [ $svc_acct ],
 344     ...
 345   );
 346   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 347
 348 Currently available options are: I<noexport>
 349
 350 If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
 351 (You can schedule them later with the B<reexport> method for each
 352 cust_pkg object.  Using the B<reexport> method on the cust_main object is not
 353 recommended, as existing services will also be reexported.)
 354
 355 =cut
 356
 357 sub order_pkgs {
 358   my $self = shift;
 359   my $cust_pkgs = shift;
 360   my $seconds = shift;
 361   my %options = @_;
 362
 363   local $SIG{HUP} = 'IGNORE';
 364   local $SIG{INT} = 'IGNORE';
 365   local $SIG{QUIT} = 'IGNORE';
 366   local $SIG{TERM} = 'IGNORE';
 367   local $SIG{TSTP} = 'IGNORE';
 368   local $SIG{PIPE} = 'IGNORE';
 369
 370   my $oldAutoCommit = $FS::UID::AutoCommit;
 371   local $FS::UID::AutoCommit = 0;
 372   my $dbh = dbh;
 373
 374   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 375
 376   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 377     $cust_pkg->custnum( $self->custnum );
 378     my $error = $cust_pkg->insert;
 379     if ( $error ) {
 380       $dbh->rollback if $oldAutoCommit;
 381       return "inserting cust_pkg (transaction rolled back): $error";
 382     }
 383     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 384       $svc_something->pkgnum( $cust_pkg->pkgnum );
 385       if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 386         $svc_something->seconds( $svc_something->seconds + $$seconds );
 387         $$seconds = 0;
 388       }
 389       $error = $svc_something->insert;
 390       if ( $error ) {
 391         $dbh->rollback if $oldAutoCommit;
 392         #return "inserting svc_ (transaction rolled back): $error";
 393         return $error;
 394       }
 395     }
 396   }
 397
 398   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 399   ''; #no error
 400 }
 401
 402 =item reexport
 403
 404 Re-schedules all exports by calling the B<reexport> method of all associated
 405 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 406 otherwise returns false.
 407
 408 =cut
 409
 410 sub reexport {
 411   my $self = shift;
 412
 413   local $SIG{HUP} = 'IGNORE';
 414   local $SIG{INT} = 'IGNORE';
 415   local $SIG{QUIT} = 'IGNORE';
 416   local $SIG{TERM} = 'IGNORE';
 417   local $SIG{TSTP} = 'IGNORE';
 418   local $SIG{PIPE} = 'IGNORE';
 419
 420   my $oldAutoCommit = $FS::UID::AutoCommit;
 421   local $FS::UID::AutoCommit = 0;
 422   my $dbh = dbh;
 423
 424   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 425     my $error = $cust_pkg->reexport;
 426     if ( $error ) {
 427       $dbh->rollback if $oldAutoCommit;
 428       return $error;
 429     }
 430   }
 431
 432   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 433   '';
 434
 435 }
 436
 437 =item delete NEW_CUSTNUM
 438
 439 This deletes the customer.  If there is an error, returns the error, otherwise
 440 returns false.
 441
 442 This will completely remove all traces of the customer record.  This is not
 443 what you want when a customer cancels service; for that, cancel all of the
 444 customer's packages (see L</cancel>).
 445
 446 If the customer has any uncancelled packages, you need to pass a new (valid)
 447 customer number for those packages to be transferred to.  Cancelled packages
 448 will be deleted.  Did I mention that this is NOT what you want when a customer
 449 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 450
 451 You can't delete a customer with invoices (see L<FS::cust_bill>),
 452 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 453 refunds (see L<FS::cust_refund>).
 454
 455 =cut
 456
 457 sub delete {
 458   my $self = shift;
 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   if ( $self->cust_bill ) {
 472     $dbh->rollback if $oldAutoCommit;
 473     return "Can't delete a customer with invoices";
 474   }
 475   if ( $self->cust_credit ) {
 476     $dbh->rollback if $oldAutoCommit;
 477     return "Can't delete a customer with credits";
 478   }
 479   if ( $self->cust_pay ) {
 480     $dbh->rollback if $oldAutoCommit;
 481     return "Can't delete a customer with payments";
 482   }
 483   if ( $self->cust_refund ) {
 484     $dbh->rollback if $oldAutoCommit;
 485     return "Can't delete a customer with refunds";
 486   }
 487
 488   my @cust_pkg = $self->ncancelled_pkgs;
 489   if ( @cust_pkg ) {
 490     my $new_custnum = shift;
 491     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 492       $dbh->rollback if $oldAutoCommit;
 493       return "Invalid new customer number: $new_custnum";
 494     }
 495     foreach my $cust_pkg ( @cust_pkg ) {
 496       my %hash = $cust_pkg->hash;
 497       $hash{'custnum'} = $new_custnum;
 498       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 499       my $error = $new_cust_pkg->replace($cust_pkg);
 500       if ( $error ) {
 501         $dbh->rollback if $oldAutoCommit;
 502         return $error;
 503       }
 504     }
 505   }
 506   my @cancelled_cust_pkg = $self->all_pkgs;
 507   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 508     my $error = $cust_pkg->delete;
 509     if ( $error ) {
 510       $dbh->rollback if $oldAutoCommit;
 511       return $error;
 512     }
 513   }
 514
 515   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 516     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 517   ) {
 518     my $error = $cust_main_invoice->delete;
 519     if ( $error ) {
 520       $dbh->rollback if $oldAutoCommit;
 521       return $error;
 522     }
 523   }
 524
 525   my $error = $self->SUPER::delete;
 526   if ( $error ) {
 527     $dbh->rollback if $oldAutoCommit;
 528     return $error;
 529   }
 530
 531   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 532   '';
 533
 534 }
 535
 536 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 537
 538 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 539 returns the error, otherwise returns false.
 540
 541 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 542 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 543 expected and rollback the entire transaction; it is not necessary to call
 544 check_invoicing_list first.  Here's an example:
 545
 546   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 547
 548 =cut
 549
 550 sub replace {
 551   my $self = shift;
 552   my $old = shift;
 553   my @param = @_;
 554
 555   local $SIG{HUP} = 'IGNORE';
 556   local $SIG{INT} = 'IGNORE';
 557   local $SIG{QUIT} = 'IGNORE';
 558   local $SIG{TERM} = 'IGNORE';
 559   local $SIG{TSTP} = 'IGNORE';
 560   local $SIG{PIPE} = 'IGNORE';
 561
 562   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 563        && $conf->config('users-allow_comp')                  ) {
 564     return "You are not permitted to create complimentary accounts."
 565       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 566   }
 567
 568   my $oldAutoCommit = $FS::UID::AutoCommit;
 569   local $FS::UID::AutoCommit = 0;
 570   my $dbh = dbh;
 571
 572   my $error = $self->SUPER::replace($old);
 573
 574   if ( $error ) {
 575     $dbh->rollback if $oldAutoCommit;
 576     return $error;
 577   }
 578
 579   if ( @param ) { # INVOICING_LIST_ARYREF
 580     my $invoicing_list = shift @param;
 581     $error = $self->check_invoicing_list( $invoicing_list );
 582     if ( $error ) {
 583       $dbh->rollback if $oldAutoCommit;
 584       return $error;
 585     }
 586     $self->invoicing_list( $invoicing_list );
 587   }
 588
 589   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 590        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 591     # card/check/lec info has changed, want to retry realtime_ invoice events
 592     my $error = $self->retry_realtime;
 593     if ( $error ) {
 594       $dbh->rollback if $oldAutoCommit;
 595       return $error;
 596     }
 597   }
 598
 599   $error = $self->queue_fuzzyfiles_update;
 600   if ( $error ) {
 601     $dbh->rollback if $oldAutoCommit;
 602     return "updating fuzzy search cache: $error";
 603   }
 604
 605   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 606   '';
 607
 608 }
 609
 610 =item queue_fuzzyfiles_update
 611
 612 Used by insert & replace to update the fuzzy search cache
 613
 614 =cut
 615
 616 sub queue_fuzzyfiles_update {
 617   my $self = shift;
 618
 619   local $SIG{HUP} = 'IGNORE';
 620   local $SIG{INT} = 'IGNORE';
 621   local $SIG{QUIT} = 'IGNORE';
 622   local $SIG{TERM} = 'IGNORE';
 623   local $SIG{TSTP} = 'IGNORE';
 624   local $SIG{PIPE} = 'IGNORE';
 625
 626   my $oldAutoCommit = $FS::UID::AutoCommit;
 627   local $FS::UID::AutoCommit = 0;
 628   my $dbh = dbh;
 629
 630   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 631   my $error = $queue->insert($self->getfield('last'), $self->company);
 632   if ( $error ) {
 633     $dbh->rollback if $oldAutoCommit;
 634     return "queueing job (transaction rolled back): $error";
 635   }
 636
 637   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 638     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 639     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
 640     if ( $error ) {
 641       $dbh->rollback if $oldAutoCommit;
 642       return "queueing job (transaction rolled back): $error";
 643     }
 644   }
 645
 646   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 647   '';
 648
 649 }
 650
 651 =item check
 652
 653 Checks all fields to make sure this is a valid customer record.  If there is
 654 an error, returns the error, otherwise returns false.  Called by the insert
 655 and repalce methods.
 656
 657 =cut
 658
 659 sub check {
 660   my $self = shift;
 661
 662   #warn "BEFORE: \n". $self->_dump;
 663
 664   my $error =
 665     $self->ut_numbern('custnum')
 666     || $self->ut_number('agentnum')
 667     || $self->ut_number('refnum')
 668     || $self->ut_name('last')
 669     || $self->ut_name('first')
 670     || $self->ut_textn('company')
 671     || $self->ut_text('address1')
 672     || $self->ut_textn('address2')
 673     || $self->ut_text('city')
 674     || $self->ut_textn('county')
 675     || $self->ut_textn('state')
 676     || $self->ut_country('country')
 677     || $self->ut_anything('comments')
 678     || $self->ut_numbern('referral_custnum')
 679   ;
 680   #barf.  need message catalogs.  i18n.  etc.
 681   $error .= "Please select an advertising source."
 682     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 683   return $error if $error;
 684
 685   return "Unknown agent"
 686     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 687
 688   return "Unknown refnum"
 689     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 690
 691   return "Unknown referring custnum ". $self->referral_custnum
 692     unless ! $self->referral_custnum
 693            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 694
 695   if ( $self->ss eq '' ) {
 696     $self->ss('');
 697   } else {
 698     my $ss = $self->ss;
 699     $ss =~ s/\D//g;
 700     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 701       or return "Illegal social security number: ". $self->ss;
 702     $self->ss("$1-$2-$3");
 703   }
 704
 705
 706 # bad idea to disable, causes billing to fail because of no tax rates later
 707 #  unless ( $import ) {
 708     unless ( qsearch('cust_main_county', {
 709       'country' => $self->country,
 710       'state'   => '',
 711      } ) ) {
 712       return "Unknown state/county/country: ".
 713         $self->state. "/". $self->county. "/". $self->country
 714         unless qsearch('cust_main_county',{
 715           'state'   => $self->state,
 716           'county'  => $self->county,
 717           'country' => $self->country,
 718         } );
 719     }
 720 #  }
 721
 722   $error =
 723     $self->ut_phonen('daytime', $self->country)
 724     || $self->ut_phonen('night', $self->country)
 725     || $self->ut_phonen('fax', $self->country)
 726     || $self->ut_zip('zip', $self->country)
 727   ;
 728   return $error if $error;
 729
 730   my @addfields = qw(
 731     last first company address1 address2 city county state zip
 732     country daytime night fax
 733   );
 734
 735   if ( defined $self->dbdef_table->column('ship_last') ) {
 736     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 737                        @addfields )
 738          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 739        )
 740     {
 741       my $error =
 742         $self->ut_name('ship_last')
 743         || $self->ut_name('ship_first')
 744         || $self->ut_textn('ship_company')
 745         || $self->ut_text('ship_address1')
 746         || $self->ut_textn('ship_address2')
 747         || $self->ut_text('ship_city')
 748         || $self->ut_textn('ship_county')
 749         || $self->ut_textn('ship_state')
 750         || $self->ut_country('ship_country')
 751       ;
 752       return $error if $error;
 753
 754       #false laziness with above
 755       unless ( qsearchs('cust_main_county', {
 756         'country' => $self->ship_country,
 757         'state'   => '',
 758        } ) ) {
 759         return "Unknown ship_state/ship_county/ship_country: ".
 760           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 761           unless qsearchs('cust_main_county',{
 762             'state'   => $self->ship_state,
 763             'county'  => $self->ship_county,
 764             'country' => $self->ship_country,
 765           } );
 766       }
 767       #eofalse
 768
 769       $error =
 770         $self->ut_phonen('ship_daytime', $self->ship_country)
 771         || $self->ut_phonen('ship_night', $self->ship_country)
 772         || $self->ut_phonen('ship_fax', $self->ship_country)
 773         || $self->ut_zip('ship_zip', $self->ship_country)
 774       ;
 775       return $error if $error;
 776
 777     } else { # ship_ info eq billing info, so don't store dup info in database
 778       $self->setfield("ship_$_", '')
 779         foreach qw( last first company address1 address2 city county state zip
 780                     country daytime night fax );
 781     }
 782   }
 783
 784   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
 785     or return "Illegal payby: ". $self->payby;
 786   $self->payby($1);
 787
 788   if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
 789
 790     my $payinfo = $self->payinfo;
 791     $payinfo =~ s/\D//g;
 792     $payinfo =~ /^(\d{13,16})$/
 793       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 794     $payinfo = $1;
 795     $self->payinfo($payinfo);
 796     validate($payinfo)
 797       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 798     return gettext('unknown_card_type')
 799       if cardtype($self->payinfo) eq "Unknown";
 800     if ( defined $self->dbdef_table->column('paycvv') ) {
 801       if ( length($self->paycvv) ) {
 802         if ( cardtype($self->payinfo) eq 'American Express card' ) {
 803           $self->paycvv =~ /^(\d{4})$/
 804             or return "CVV2 (CID) for American Express cards is four digits.";
 805           $self->paycvv($1);
 806         } else {
 807           $self->paycvv =~ /^(\d{3})$/
 808             or return "CVV2 (CVC2/CID) is three digits.";
 809           $self->paycvv($1);
 810         }
 811       } else {
 812         $self->paycvv('');
 813       }
 814     }
 815
 816   } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
 817
 818     my $payinfo = $self->payinfo;
 819     $payinfo =~ s/[^\d\@]//g;
 820     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 821     $payinfo = "$1\@$2";
 822     $self->payinfo($payinfo);
 823     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 824
 825   } elsif ( $self->payby eq 'LECB' ) {
 826
 827     my $payinfo = $self->payinfo;
 828     $payinfo =~ s/\D//g;
 829     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 830     $payinfo = $1;
 831     $self->payinfo($payinfo);
 832     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 833
 834   } elsif ( $self->payby eq 'BILL' ) {
 835
 836     $error = $self->ut_textn('payinfo');
 837     return "Illegal P.O. number: ". $self->payinfo if $error;
 838     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 839
 840   } elsif ( $self->payby eq 'COMP' ) {
 841
 842     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 843       return "You are not permitted to create complimentary accounts."
 844         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 845     }
 846
 847     $error = $self->ut_textn('payinfo');
 848     return "Illegal comp account issuer: ". $self->payinfo if $error;
 849     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 850
 851   } elsif ( $self->payby eq 'PREPAY' ) {
 852
 853     my $payinfo = $self->payinfo;
 854     $payinfo =~ s/\W//g; #anything else would just confuse things
 855     $self->payinfo($payinfo);
 856     $error = $self->ut_alpha('payinfo');
 857     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 858     return "Unknown prepayment identifier"
 859       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 860     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 861
 862   }
 863
 864   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 865     return "Expriation date required"
 866       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 867     $self->paydate('');
 868   } else {
 869     my( $m, $y );
 870     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 871       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 872     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
 873       ( $m, $y ) = ( $3, "20$2" );
 874     } else {
 875       return "Illegal expiration date: ". $self->paydate;
 876     }
 877     $self->paydate("$y-$m-01");
 878     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 879     return gettext('expired_card')
 880       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 881   }
 882
 883   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
 884        ( ! $conf->exists('require_cardname')
 885          || $self->payby !~ /^(CARD|DCRD)$/  )
 886   ) {
 887     $self->payname( $self->first. " ". $self->getfield('last') );
 888   } else {
 889     $self->payname =~ /^([\w \,\.\-\']+)$/
 890       or return gettext('illegal_name'). " payname: ". $self->payname;
 891     $self->payname($1);
 892   }
 893
 894   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 895   $self->tax($1);
 896
 897   $self->otaker(getotaker) unless $self->otaker;
 898
 899   #warn "AFTER: \n". $self->_dump;
 900
 901   $self->SUPER::check;
 902 }
 903
 904 =item all_pkgs
 905
 906 Returns all packages (see L<FS::cust_pkg>) for this customer.
 907
 908 =cut
 909
 910 sub all_pkgs {
 911   my $self = shift;
 912   if ( $self->{'_pkgnum'} ) {
 913     values %{ $self->{'_pkgnum'}->cache };
 914   } else {
 915     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 916   }
 917 }
 918
 919 =item ncancelled_pkgs
 920
 921 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 922
 923 =cut
 924
 925 sub ncancelled_pkgs {
 926   my $self = shift;
 927   if ( $self->{'_pkgnum'} ) {
 928     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 929   } else {
 930     @{ [ # force list context
 931       qsearch( 'cust_pkg', {
 932         'custnum' => $self->custnum,
 933         'cancel'  => '',
 934       }),
 935       qsearch( 'cust_pkg', {
 936         'custnum' => $self->custnum,
 937         'cancel'  => 0,
 938       }),
 939     ] };
 940   }
 941 }
 942
 943 =item suspended_pkgs
 944
 945 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 946
 947 =cut
 948
 949 sub suspended_pkgs {
 950   my $self = shift;
 951   grep { $_->susp } $self->ncancelled_pkgs;
 952 }
 953
 954 =item unflagged_suspended_pkgs
 955
 956 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 957 customer (thouse packages without the `manual_flag' set).
 958
 959 =cut
 960
 961 sub unflagged_suspended_pkgs {
 962   my $self = shift;
 963   return $self->suspended_pkgs
 964     unless dbdef->table('cust_pkg')->column('manual_flag');
 965   grep { ! $_->manual_flag } $self->suspended_pkgs;
 966 }
 967
 968 =item unsuspended_pkgs
 969
 970 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 971 this customer.
 972
 973 =cut
 974
 975 sub unsuspended_pkgs {
 976   my $self = shift;
 977   grep { ! $_->susp } $self->ncancelled_pkgs;
 978 }
 979
 980 =item unsuspend
 981
 982 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 983 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 984 on success or a list of errors.
 985
 986 =cut
 987
 988 sub unsuspend {
 989   my $self = shift;
 990   grep { $_->unsuspend } $self->suspended_pkgs;
 991 }
 992
 993 =item suspend
 994
 995 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 996 Always returns a list: an empty list on success or a list of errors.
 997
 998 =cut
 999
1000 sub suspend {
1001   my $self = shift;
1002   grep { $_->suspend } $self->unsuspended_pkgs;
1003 }
1004
1005 =item cancel [ OPTION => VALUE ... ]
1006
1007 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1008
1009 Available options are: I<quiet>
1010
1011 I<quiet> can be set true to supress email cancellation notices.
1012
1013 Always returns a list: an empty list on success or a list of errors.
1014
1015 =cut
1016
1017 sub cancel {
1018   my $self = shift;
1019   grep { $_->cancel(@_) } $self->ncancelled_pkgs;
1020 }
1021
1022 =item agent
1023
1024 Returns the agent (see L<FS::agent>) for this customer.
1025
1026 =cut
1027
1028 sub agent {
1029   my $self = shift;
1030   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1031 }
1032
1033 =item bill OPTIONS
1034
1035 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1036 conjunction with the collect method.
1037
1038 Options are passed as name-value pairs.
1039
1040 Currently available options are:
1041
1042 resetup - if set true, re-charges setup fees.
1043
1044 time - bills the customer as if it were that time.  Specified as a UNIX
1045 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1046 L<Date::Parse> for conversion functions.  For example:
1047
1048  use Date::Parse;
1049  ...
1050  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1051
1052
1053 If there is an error, returns the error, otherwise returns false.
1054
1055 =cut
1056
1057 sub bill {
1058   my( $self, %options ) = @_;
1059   my $time = $options{'time'} || time;
1060
1061   my $error;
1062
1063   #put below somehow?
1064   local $SIG{HUP} = 'IGNORE';
1065   local $SIG{INT} = 'IGNORE';
1066   local $SIG{QUIT} = 'IGNORE';
1067   local $SIG{TERM} = 'IGNORE';
1068   local $SIG{TSTP} = 'IGNORE';
1069   local $SIG{PIPE} = 'IGNORE';
1070
1071   my $oldAutoCommit = $FS::UID::AutoCommit;
1072   local $FS::UID::AutoCommit = 0;
1073   my $dbh = dbh;
1074
1075   # find the packages which are due for billing, find out how much they are
1076   # & generate invoice database.
1077
1078   my( $total_setup, $total_recur ) = ( 0, 0 );
1079   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1080   my @cust_bill_pkg = ();
1081   #my $tax = 0;##
1082   #my $taxable_charged = 0;##
1083   #my $charged = 0;##
1084
1085   my %tax;
1086
1087   foreach my $cust_pkg (
1088     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1089   ) {
1090
1091     #NO!! next if $cust_pkg->cancel;
1092     next if $cust_pkg->getfield('cancel');
1093
1094     #? to avoid use of uninitialized value errors... ?
1095     $cust_pkg->setfield('bill', '')
1096       unless defined($cust_pkg->bill);
1097
1098     my $part_pkg = $cust_pkg->part_pkg;
1099
1100     #so we don't modify cust_pkg record unnecessarily
1101     my $cust_pkg_mod_flag = 0;
1102     my %hash = $cust_pkg->hash;
1103     my $old_cust_pkg = new FS::cust_pkg \%hash;
1104
1105     my @details = ();
1106
1107     # bill setup
1108     my $setup = 0;
1109     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1110       my $setup_prog = $part_pkg->getfield('setup');
1111       $setup_prog =~ /^(.*)$/ or do {
1112         $dbh->rollback if $oldAutoCommit;
1113         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1114                ": $setup_prog";
1115       };
1116       $setup_prog = $1;
1117       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1118
1119         #my $cpt = new Safe;
1120         ##$cpt->permit(); #what is necessary?
1121         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1122         #$setup = $cpt->reval($setup_prog);
1123       $setup = eval $setup_prog;
1124       unless ( defined($setup) ) {
1125         $dbh->rollback if $oldAutoCommit;
1126         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1127                "(expression $setup_prog): $@";
1128       }
1129       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1130       $cust_pkg_mod_flag=1;
1131     }
1132
1133     #bill recurring fee
1134     my $recur = 0;
1135     my $sdate;
1136     if ( $part_pkg->getfield('freq') ne '0' &&
1137          ! $cust_pkg->getfield('susp') &&
1138          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1139     ) {
1140       my $recur_prog = $part_pkg->getfield('recur');
1141       $recur_prog =~ /^(.*)$/ or do {
1142         $dbh->rollback if $oldAutoCommit;
1143         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1144                ": $recur_prog";
1145       };
1146       $recur_prog = $1;
1147       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1148
1149       # shared with $recur_prog
1150       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1151
1152         #my $cpt = new Safe;
1153         ##$cpt->permit(); #what is necessary?
1154         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1155         #$recur = $cpt->reval($recur_prog);
1156       $recur = eval $recur_prog;
1157       unless ( defined($recur) ) {
1158         $dbh->rollback if $oldAutoCommit;
1159         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1160                "(expression $recur_prog): $@";
1161       }
1162       #change this bit to use Date::Manip? CAREFUL with timezones (see
1163       # mailing list archive)
1164       my ($sec,$min,$hour,$mday,$mon,$year) =
1165         (localtime($sdate) )[0,1,2,3,4,5];
1166
1167       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1168       # only for figuring next bill date, nothing else, so, reset $sdate again
1169       # here
1170       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1171       $cust_pkg->last_bill($sdate)
1172         if $cust_pkg->dbdef_table->column('last_bill');
1173
1174       if ( $part_pkg->freq =~ /^\d+$/ ) {
1175         $mon += $part_pkg->freq;
1176         until ( $mon < 12 ) { $mon -= 12; $year++; }
1177       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1178         my $weeks = $1;
1179         $mday += $weeks * 7;
1180       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1181         my $days = $1;
1182         $mday += $days;
1183       } else {
1184         $dbh->rollback if $oldAutoCommit;
1185         return "unparsable frequency: ". $part_pkg->freq;
1186       }
1187       $cust_pkg->setfield('bill',
1188         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1189       $cust_pkg_mod_flag = 1;
1190     }
1191
1192     warn "\$setup is undefined" unless defined($setup);
1193     warn "\$recur is undefined" unless defined($recur);
1194     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1195
1196     if ( $cust_pkg_mod_flag ) {
1197       $error=$cust_pkg->replace($old_cust_pkg);
1198       if ( $error ) { #just in case
1199         $dbh->rollback if $oldAutoCommit;
1200         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1201       }
1202       $setup = sprintf( "%.2f", $setup );
1203       $recur = sprintf( "%.2f", $recur );
1204       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1205         $dbh->rollback if $oldAutoCommit;
1206         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1207       }
1208       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1209         $dbh->rollback if $oldAutoCommit;
1210         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1211       }
1212       if ( $setup != 0 || $recur != 0 ) {
1213         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1214           'pkgnum'  => $cust_pkg->pkgnum,
1215           'setup'   => $setup,
1216           'recur'   => $recur,
1217           'sdate'   => $sdate,
1218           'edate'   => $cust_pkg->bill,
1219           'details' => \@details,
1220         });
1221         push @cust_bill_pkg, $cust_bill_pkg;
1222         $total_setup += $setup;
1223         $total_recur += $recur;
1224
1225         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1226
1227           my @taxes = qsearch( 'cust_main_county', {
1228                                  'state'    => $self->state,
1229                                  'county'   => $self->county,
1230                                  'country'  => $self->country,
1231                                  'taxclass' => $part_pkg->taxclass,
1232                                                                       } );
1233           unless ( @taxes ) {
1234             @taxes =  qsearch( 'cust_main_county', {
1235                                   'state'    => $self->state,
1236                                   'county'   => $self->county,
1237                                   'country'  => $self->country,
1238                                   'taxclass' => '',
1239                                                                       } );
1240           }
1241
1242           #one more try at a whole-country tax rate
1243           unless ( @taxes ) {
1244             @taxes =  qsearch( 'cust_main_county', {
1245                                   'state'    => '',
1246                                   'county'   => '',
1247                                   'country'  => $self->country,
1248                                   'taxclass' => '',
1249                                                                       } );
1250           }
1251
1252           # maybe eliminate this entirely, along with all the 0% records
1253           unless ( @taxes ) {
1254             $dbh->rollback if $oldAutoCommit;
1255             return
1256               "fatal: can't find tax rate for state/county/country/taxclass ".
1257               join('/', ( map $self->$_(), qw(state county country) ),
1258                         $part_pkg->taxclass ).  "\n";
1259           }
1260
1261           foreach my $tax ( @taxes ) {
1262
1263             my $taxable_charged = 0;
1264             $taxable_charged += $setup
1265               unless $part_pkg->setuptax =~ /^Y$/i
1266                   || $tax->setuptax =~ /^Y$/i;
1267             $taxable_charged += $recur
1268               unless $part_pkg->recurtax =~ /^Y$/i
1269                   || $tax->recurtax =~ /^Y$/i;
1270             next unless $taxable_charged;
1271
1272             if ( $tax->exempt_amount > 0 ) {
1273               my ($mon,$year) = (localtime($sdate) )[4,5];
1274               $mon++;
1275               my $freq = $part_pkg->freq || 1;
1276               if ( $freq !~ /(\d+)$/ ) {
1277                 $dbh->rollback if $oldAutoCommit;
1278                 return "daily/weekly package definitions not (yet?)".
1279                        " compatible with monthly tax exemptions";
1280               }
1281               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1282               foreach my $which_month ( 1 .. $freq ) {
1283                 my %hash = (
1284                   'custnum' => $self->custnum,
1285                   'taxnum'  => $tax->taxnum,
1286                   'year'    => 1900+$year,
1287                   'month'   => $mon++,
1288                 );
1289                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1290                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1291                 my $cust_tax_exempt =
1292                   qsearchs('cust_tax_exempt', \%hash)
1293                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1294                 my $remaining_exemption = sprintf("%.2f",
1295                   $tax->exempt_amount - $cust_tax_exempt->amount );
1296                 if ( $remaining_exemption > 0 ) {
1297                   my $addl = $remaining_exemption > $taxable_per_month
1298                     ? $taxable_per_month
1299                     : $remaining_exemption;
1300                   $taxable_charged -= $addl;
1301                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1302                     $cust_tax_exempt->hash,
1303                     'amount' =>
1304                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1305                   } );
1306                   $error = $new_cust_tax_exempt->exemptnum
1307                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1308                     : $new_cust_tax_exempt->insert;
1309                   if ( $error ) {
1310                     $dbh->rollback if $oldAutoCommit;
1311                     return "fatal: can't update cust_tax_exempt: $error";
1312                   }
1313
1314                 } # if $remaining_exemption > 0
1315
1316               } #foreach $which_month
1317
1318             } #if $tax->exempt_amount
1319
1320             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1321
1322             #$tax += $taxable_charged * $cust_main_county->tax / 100
1323             $tax{ $tax->taxname || 'Tax' } +=
1324               $taxable_charged * $tax->tax / 100
1325
1326           } #foreach my $tax ( @taxes )
1327
1328         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1329
1330       } #if $setup != 0 || $recur != 0
1331
1332     } #if $cust_pkg_mod_flag
1333
1334   } #foreach my $cust_pkg
1335
1336   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1337 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1338
1339   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1340     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1341     return '';
1342   }
1343
1344 #  unless ( $self->tax =~ /Y/i
1345 #           || $self->payby eq 'COMP'
1346 #           || $taxable_charged == 0 ) {
1347 #    my $cust_main_county = qsearchs('cust_main_county',{
1348 #        'state'   => $self->state,
1349 #        'county'  => $self->county,
1350 #        'country' => $self->country,
1351 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1352 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1353 #    my $tax = sprintf( "%.2f",
1354 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1355 #    );
1356
1357   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1358
1359     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1360       my $tax = sprintf("%.2f", $tax{$taxname} );
1361       $charged = sprintf( "%.2f", $charged+$tax );
1362
1363       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1364         'pkgnum'   => 0,
1365         'setup'    => $tax,
1366         'recur'    => 0,
1367         'sdate'    => '',
1368         'edate'    => '',
1369         'itemdesc' => $taxname,
1370       });
1371       push @cust_bill_pkg, $cust_bill_pkg;
1372     }
1373
1374   } else { #1.4 schema
1375
1376     my $tax = 0;
1377     foreach ( values %tax ) { $tax += $_ };
1378     $tax = sprintf("%.2f", $tax);
1379     if ( $tax > 0 ) {
1380       $charged = sprintf( "%.2f", $charged+$tax );
1381
1382       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1383         'pkgnum' => 0,
1384         'setup'  => $tax,
1385         'recur'  => 0,
1386         'sdate'  => '',
1387         'edate'  => '',
1388       });
1389       push @cust_bill_pkg, $cust_bill_pkg;
1390     }
1391
1392   }
1393
1394   my $cust_bill = new FS::cust_bill ( {
1395     'custnum' => $self->custnum,
1396     '_date'   => $time,
1397     'charged' => $charged,
1398   } );
1399   $error = $cust_bill->insert;
1400   if ( $error ) {
1401     $dbh->rollback if $oldAutoCommit;
1402     return "can't create invoice for customer #". $self->custnum. ": $error";
1403   }
1404
1405   my $invnum = $cust_bill->invnum;
1406   my $cust_bill_pkg;
1407   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1408     #warn $invnum;
1409     $cust_bill_pkg->invnum($invnum);
1410     $error = $cust_bill_pkg->insert;
1411     if ( $error ) {
1412       $dbh->rollback if $oldAutoCommit;
1413       return "can't create invoice line item for customer #". $self->custnum.
1414              ": $error";
1415     }
1416   }
1417
1418   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1419   ''; #no error
1420 }
1421
1422 =item collect OPTIONS
1423
1424 (Attempt to) collect money for this customer's outstanding invoices (see
1425 L<FS::cust_bill>).  Usually used after the bill method.
1426
1427 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1428 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1429 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1430
1431 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1432 and the invoice events web interface.
1433
1434 If there is an error, returns the error, otherwise returns false.
1435
1436 Options are passed as name-value pairs.
1437
1438 Currently available options are:
1439
1440 invoice_time - Use this time when deciding when to print invoices and
1441 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>
1442 for conversion functions.
1443
1444 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1445 events.
1446
1447 retry_card - Deprecated alias for 'retry'
1448
1449 batch_card - This option is deprecated.  See the invoice events web interface
1450 to control whether cards are batched or run against a realtime gateway.
1451
1452 report_badcard - This option is deprecated.
1453
1454 force_print - This option is deprecated; see the invoice events web interface.
1455
1456 quiet - set true to surpress email card/ACH decline notices.
1457
1458 =cut
1459
1460 sub collect {
1461   my( $self, %options ) = @_;
1462   my $invoice_time = $options{'invoice_time'} || time;
1463
1464   #put below somehow?
1465   local $SIG{HUP} = 'IGNORE';
1466   local $SIG{INT} = 'IGNORE';
1467   local $SIG{QUIT} = 'IGNORE';
1468   local $SIG{TERM} = 'IGNORE';
1469   local $SIG{TSTP} = 'IGNORE';
1470   local $SIG{PIPE} = 'IGNORE';
1471
1472   my $oldAutoCommit = $FS::UID::AutoCommit;
1473   local $FS::UID::AutoCommit = 0;
1474   my $dbh = dbh;
1475
1476   my $balance = $self->balance;
1477   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1478   unless ( $balance > 0 ) { #redundant?????
1479     $dbh->rollback if $oldAutoCommit; #hmm
1480     return '';
1481   }
1482
1483   if ( exists($options{'retry_card'}) ) {
1484     carp 'retry_card option passed to collect is deprecated; use retry';
1485     $options{'retry'} ||= $options{'retry_card'};
1486   }
1487   if ( exists($options{'retry'}) && $options{'retry'} ) {
1488     my $error = $self->retry_realtime;
1489     if ( $error ) {
1490       $dbh->rollback if $oldAutoCommit;
1491       return $error;
1492     }
1493   }
1494
1495   foreach my $cust_bill ( $self->open_cust_bill ) {
1496
1497     # don't try to charge for the same invoice if it's already in a batch
1498     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1499
1500     last if $self->balance <= 0;
1501
1502     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1503       if $Debug;
1504
1505     foreach my $part_bill_event (
1506       sort {    $a->seconds   <=> $b->seconds
1507              || $a->weight    <=> $b->weight
1508              || $a->eventpart <=> $b->eventpart }
1509         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1510                && ! qsearchs( 'cust_bill_event', {
1511                                 'invnum'    => $cust_bill->invnum,
1512                                 'eventpart' => $_->eventpart,
1513                                 'status'    => 'done',
1514                                                                    } )
1515              }
1516           qsearch('part_bill_event', { 'payby'    => $self->payby,
1517                                        'disabled' => '',           } )
1518     ) {
1519
1520       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1521            || $self->balance   <= 0; # or if balance<=0
1522
1523       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1524         if $Debug;
1525       my $cust_main = $self; #for callback
1526
1527       my $error;
1528       {
1529         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1530         $error = eval $part_bill_event->eventcode;
1531       }
1532
1533       my $status = '';
1534       my $statustext = '';
1535       if ( $@ ) {
1536         $status = 'failed';
1537         $statustext = $@;
1538       } elsif ( $error ) {
1539         $status = 'done';
1540         $statustext = $error;
1541       } else {
1542         $status = 'done'
1543       }
1544
1545       #add cust_bill_event
1546       my $cust_bill_event = new FS::cust_bill_event {
1547         'invnum'     => $cust_bill->invnum,
1548         'eventpart'  => $part_bill_event->eventpart,
1549         #'_date'      => $invoice_time,
1550         '_date'      => time,
1551         'status'     => $status,
1552         'statustext' => $statustext,
1553       };
1554       $error = $cust_bill_event->insert;
1555       if ( $error ) {
1556         #$dbh->rollback if $oldAutoCommit;
1557         #return "error: $error";
1558
1559         # gah, even with transactions.
1560         $dbh->commit if $oldAutoCommit; #well.
1561         my $e = 'WARNING: Event run but database not updated - '.
1562                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1563                 ', eventpart '. $part_bill_event->eventpart.
1564                 ": $error";
1565         warn $e;
1566         return $e;
1567       }
1568
1569
1570     }
1571
1572   }
1573
1574   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1575   '';
1576
1577 }
1578
1579 =item retry_realtime
1580
1581 Schedules realtime credit card / electronic check / LEC billing events for
1582 for retry.  Useful if card information has changed or manual retry is desired.
1583 The 'collect' method must be called to actually retry the transaction.
1584
1585 Implementation details: For each of this customer's open invoices, changes
1586 the status of the first "done" (with statustext error) realtime processing
1587 event to "failed".
1588
1589 =cut
1590
1591 sub retry_realtime {
1592   my $self = shift;
1593
1594   local $SIG{HUP} = 'IGNORE';
1595   local $SIG{INT} = 'IGNORE';
1596   local $SIG{QUIT} = 'IGNORE';
1597   local $SIG{TERM} = 'IGNORE';
1598   local $SIG{TSTP} = 'IGNORE';
1599   local $SIG{PIPE} = 'IGNORE';
1600
1601   my $oldAutoCommit = $FS::UID::AutoCommit;
1602   local $FS::UID::AutoCommit = 0;
1603   my $dbh = dbh;
1604
1605   foreach my $cust_bill (
1606     grep { $_->cust_bill_event }
1607       $self->open_cust_bill
1608   ) {
1609     my @cust_bill_event =
1610       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1611         grep {
1612                #$_->part_bill_event->plan eq 'realtime-card'
1613                $_->part_bill_event->eventcode =~
1614                    /\$cust_bill\->realtime_(card|ach|lec)/
1615                  && $_->status eq 'done'
1616                  && $_->statustext
1617              }
1618           $cust_bill->cust_bill_event;
1619     next unless @cust_bill_event;
1620     my $error = $cust_bill_event[0]->retry;
1621     if ( $error ) {
1622       $dbh->rollback if $oldAutoCommit;
1623       return "error scheduling invoice event for retry: $error";
1624     }
1625
1626   }
1627
1628   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1629   '';
1630
1631 }
1632
1633 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1634
1635 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1636 via a Business::OnlinePayment realtime gateway.  See
1637 L<http://420.am/business-onlinepayment> for supported gateways.
1638
1639 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1640
1641 Available options are: I<description>, I<invnum>, I<quiet>
1642
1643 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1644 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1645 if set, will override the value from the customer record.
1646
1647 I<description> is a free-text field passed to the gateway.  It defaults to
1648 "Internet services".
1649
1650 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1651 specified invoice.  If you don't specify an I<invnum> you might want to
1652 call the B<apply_payments> method.
1653
1654 I<quiet> can be set true to surpress email decline notices.
1655
1656 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1657
1658 =cut
1659
1660 sub realtime_bop {
1661   my( $self, $method, $amount, %options ) = @_;
1662   if ( $Debug ) {
1663     warn "$self $method $amount\n";
1664     warn "  $_ => $options{$_}\n" foreach keys %options;
1665   }
1666
1667   $options{'description'} ||= 'Internet services';
1668
1669   #pre-requisites
1670   die "Real-time processing not enabled\n"
1671     unless $conf->exists('business-onlinepayment');
1672   eval "use Business::OnlinePayment";
1673   die $@ if $@;
1674
1675   #overrides
1676   $self->set( $_ => $options{$_} )
1677     foreach grep { exists($options{$_}) }
1678             qw( payname address1 address2 city state zip payinfo paydate );
1679
1680   #load up config
1681   my $bop_config = 'business-onlinepayment';
1682   $bop_config .= '-ach'
1683     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1684   my ( $processor, $login, $password, $action, @bop_options ) =
1685     $conf->config($bop_config);
1686   $action ||= 'normal authorization';
1687   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1688
1689   #massage data
1690
1691   my $address = $self->address1;
1692   $address .= ", ". $self->address2 if $self->address2;
1693
1694   my($payname, $payfirst, $paylast);
1695   if ( $self->payname && $method ne 'ECHECK' ) {
1696     $payname = $self->payname;
1697     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1698       or return "Illegal payname $payname";
1699     ($payfirst, $paylast) = ($1, $2);
1700   } else {
1701     $payfirst = $self->getfield('first');
1702     $paylast = $self->getfield('last');
1703     $payname =  "$payfirst $paylast";
1704   }
1705
1706   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1707   if ( $conf->exists('emailinvoiceauto')
1708        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1709     push @invoicing_list, $self->all_emails;
1710   }
1711   my $email = $invoicing_list[0];
1712
1713   my %content;
1714   if ( $method eq 'CC' ) {
1715
1716     $content{card_number} = $self->payinfo;
1717     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1718     $content{expiration} = "$2/$1";
1719
1720     $content{cvv2} = $self->paycvv
1721       if defined $self->dbdef_table->column('paycvv')
1722          && length($self->paycvv);
1723
1724     $content{recurring_billing} = 'YES'
1725       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1726                                'payby'   => 'CARD',
1727                                'payinfo' => $self->payinfo, } );
1728
1729   } elsif ( $method eq 'ECHECK' ) {
1730     my($account_number,$routing_code) = $self->payinfo;
1731     ( $content{account_number}, $content{routing_code} ) =
1732       split('@', $self->payinfo);
1733     $content{bank_name} = $self->payname;
1734     $content{account_type} = 'CHECKING';
1735     $content{account_name} = $payname;
1736     $content{customer_org} = $self->company ? 'B' : 'I';
1737     $content{customer_ssn} = $self->ss;
1738   } elsif ( $method eq 'LEC' ) {
1739     $content{phone} = $self->payinfo;
1740   }
1741
1742   #transaction(s)
1743
1744   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1745
1746   my $transaction =
1747     new Business::OnlinePayment( $processor, @bop_options );
1748   $transaction->content(
1749     'type'           => $method,
1750     'login'          => $login,
1751     'password'       => $password,
1752     'action'         => $action1,
1753     'description'    => $options{'description'},
1754     'amount'         => $amount,
1755     'invoice_number' => $options{'invnum'},
1756     'customer_id'    => $self->custnum,
1757     'last_name'      => $paylast,
1758     'first_name'     => $payfirst,
1759     'name'           => $payname,
1760     'address'        => $address,
1761     'city'           => $self->city,
1762     'state'          => $self->state,
1763     'zip'            => $self->zip,
1764     'country'        => $self->country,
1765     'referer'        => 'http://cleanwhisker.420.am/',
1766     'email'          => $email,
1767     'phone'          => $self->daytime || $self->night,
1768     %content, #after
1769   );
1770   $transaction->submit();
1771
1772   if ( $transaction->is_success() && $action2 ) {
1773     my $auth = $transaction->authorization;
1774     my $ordernum = $transaction->can('order_number')
1775                    ? $transaction->order_number
1776                    : '';
1777
1778     my $capture =
1779       new Business::OnlinePayment( $processor, @bop_options );
1780
1781     my %capture = (
1782       %content,
1783       type           => $method,
1784       action         => $action2,
1785       login          => $login,
1786       password       => $password,
1787       order_number   => $ordernum,
1788       amount         => $amount,
1789       authorization  => $auth,
1790       description    => $options{'description'},
1791     );
1792
1793     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1794                            transaction_sequence_num local_transaction_date
1795                            local_transaction_time AVS_result_code          )) {
1796       $capture{$field} = $transaction->$field() if $transaction->can($field);
1797     }
1798
1799     $capture->content( %capture );
1800
1801     $capture->submit();
1802
1803     unless ( $capture->is_success ) {
1804       my $e = "Authorization sucessful but capture failed, custnum #".
1805               $self->custnum. ': '.  $capture->result_code.
1806               ": ". $capture->error_message;
1807       warn $e;
1808       return $e;
1809     }
1810
1811   }
1812
1813   #remove paycvv after initial transaction
1814   #make this disable-able via a config option if anyone insists?
1815   # (though that probably violates cardholder agreements)
1816   if ( defined $self->dbdef_table->column('paycvv')
1817        && length($self->paycvv)
1818        && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1819   ) {
1820     my $new = new FS::cust_main { $self->hash };
1821     $new->paycvv('');
1822     my $error = $new->replace($self);
1823     if ( $error ) {
1824       warn "error removing cvv: $error\n";
1825     }
1826   }
1827
1828   #result handling
1829   if ( $transaction->is_success() ) {
1830
1831     my %method2payby = (
1832       'CC'     => 'CARD',
1833       'ECHECK' => 'CHEK',
1834       'LEC'    => 'LECB',
1835     );
1836
1837     my $cust_pay = new FS::cust_pay ( {
1838        'custnum'  => $self->custnum,
1839        'invnum'   => $options{'invnum'},
1840        'paid'     => $amount,
1841        '_date'     => '',
1842        'payby'    => $method2payby{$method},
1843        'payinfo'  => $self->payinfo,
1844        'paybatch' => "$processor:". $transaction->authorization,
1845     } );
1846     my $error = $cust_pay->insert;
1847     if ( $error ) {
1848       # gah, even with transactions.
1849       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1850               'error applying payment, invnum #' . $self->invnum.
1851               " ($processor): $error";
1852       warn $e;
1853       return $e;
1854     } else {
1855       return '';
1856     }
1857
1858   } else {
1859
1860     my $perror = "$processor error: ". $transaction->error_message;
1861
1862     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1863          && $conf->exists('emaildecline')
1864          && grep { $_ ne 'POST' } $self->invoicing_list
1865          && ! grep { $_ eq $transaction->error_message }
1866                    $conf->config('emaildecline-exclude')
1867     ) {
1868       my @templ = $conf->config('declinetemplate');
1869       my $template = new Text::Template (
1870         TYPE   => 'ARRAY',
1871         SOURCE => [ map "$_\n", @templ ],
1872       ) or return "($perror) can't create template: $Text::Template::ERROR";
1873       $template->compile()
1874         or return "($perror) can't compile template: $Text::Template::ERROR";
1875
1876       my $templ_hash = { error => $transaction->error_message };
1877
1878       my $error = send_email(
1879         'from'    => $conf->config('invoice_from'),
1880         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1881         'subject' => 'Your payment could not be processed',
1882         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1883       );
1884
1885       $perror .= " (also received error sending decline notification: $error)"
1886         if $error;
1887
1888     }
1889
1890     return $perror;
1891   }
1892
1893 }
1894
1895 =item total_owed
1896
1897 Returns the total owed for this customer on all invoices
1898 (see L<FS::cust_bill/owed>).
1899
1900 =cut
1901
1902 sub total_owed {
1903   my $self = shift;
1904   $self->total_owed_date(2145859200); #12/31/2037
1905 }
1906
1907 =item total_owed_date TIME
1908
1909 Returns the total owed for this customer on all invoices with date earlier than
1910 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1911 see L<Time::Local> and L<Date::Parse> for conversion functions.
1912
1913 =cut
1914
1915 sub total_owed_date {
1916   my $self = shift;
1917   my $time = shift;
1918   my $total_bill = 0;
1919   foreach my $cust_bill (
1920     grep { $_->_date <= $time }
1921       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1922   ) {
1923     $total_bill += $cust_bill->owed;
1924   }
1925   sprintf( "%.2f", $total_bill );
1926 }
1927
1928 =item apply_credits
1929
1930 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1931 to outstanding invoice balances in chronological order and returns the value
1932 of any remaining unapplied credits available for refund
1933 (see L<FS::cust_refund>).
1934
1935 =cut
1936
1937 sub apply_credits {
1938   my $self = shift;
1939
1940   return 0 unless $self->total_credited;
1941
1942   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1943       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1944
1945   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1946       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1947
1948   my $credit;
1949
1950   foreach my $cust_bill ( @invoices ) {
1951     my $amount;
1952
1953     if ( !defined($credit) || $credit->credited == 0) {
1954       $credit = pop @credits or last;
1955     }
1956
1957     if ($cust_bill->owed >= $credit->credited) {
1958       $amount=$credit->credited;
1959     }else{
1960       $amount=$cust_bill->owed;
1961     }
1962
1963     my $cust_credit_bill = new FS::cust_credit_bill ( {
1964       'crednum' => $credit->crednum,
1965       'invnum'  => $cust_bill->invnum,
1966       'amount'  => $amount,
1967     } );
1968     my $error = $cust_credit_bill->insert;
1969     die $error if $error;
1970
1971     redo if ($cust_bill->owed > 0);
1972
1973   }
1974
1975   return $self->total_credited;
1976 }
1977
1978 =item apply_payments
1979
1980 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1981 to outstanding invoice balances in chronological order.
1982
1983  #and returns the value of any remaining unapplied payments.
1984
1985 =cut
1986
1987 sub apply_payments {
1988   my $self = shift;
1989
1990   #return 0 unless
1991
1992   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1993       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1994
1995   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1996       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1997
1998   my $payment;
1999
2000   foreach my $cust_bill ( @invoices ) {
2001     my $amount;
2002
2003     if ( !defined($payment) || $payment->unapplied == 0 ) {
2004       $payment = pop @payments or last;
2005     }
2006
2007     if ( $cust_bill->owed >= $payment->unapplied ) {
2008       $amount = $payment->unapplied;
2009     } else {
2010       $amount = $cust_bill->owed;
2011     }
2012
2013     my $cust_bill_pay = new FS::cust_bill_pay ( {
2014       'paynum' => $payment->paynum,
2015       'invnum' => $cust_bill->invnum,
2016       'amount' => $amount,
2017     } );
2018     my $error = $cust_bill_pay->insert;
2019     die $error if $error;
2020
2021     redo if ( $cust_bill->owed > 0);
2022
2023   }
2024
2025   return $self->total_unapplied_payments;
2026 }
2027
2028 =item total_credited
2029
2030 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2031 customer.  See L<FS::cust_credit/credited>.
2032
2033 =cut
2034
2035 sub total_credited {
2036   my $self = shift;
2037   my $total_credit = 0;
2038   foreach my $cust_credit ( qsearch('cust_credit', {
2039     'custnum' => $self->custnum,
2040   } ) ) {
2041     $total_credit += $cust_credit->credited;
2042   }
2043   sprintf( "%.2f", $total_credit );
2044 }
2045
2046 =item total_unapplied_payments
2047
2048 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2049 See L<FS::cust_pay/unapplied>.
2050
2051 =cut
2052
2053 sub total_unapplied_payments {
2054   my $self = shift;
2055   my $total_unapplied = 0;
2056   foreach my $cust_pay ( qsearch('cust_pay', {
2057     'custnum' => $self->custnum,
2058   } ) ) {
2059     $total_unapplied += $cust_pay->unapplied;
2060   }
2061   sprintf( "%.2f", $total_unapplied );
2062 }
2063
2064 =item balance
2065
2066 Returns the balance for this customer (total_owed minus total_credited
2067 minus total_unapplied_payments).
2068
2069 =cut
2070
2071 sub balance {
2072   my $self = shift;
2073   sprintf( "%.2f",
2074     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2075   );
2076 }
2077
2078 =item balance_date TIME
2079
2080 Returns the balance for this customer, only considering invoices with date
2081 earlier than TIME (total_owed_date minus total_credited minus
2082 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2083 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2084 functions.
2085
2086 =cut
2087
2088 sub balance_date {
2089   my $self = shift;
2090   my $time = shift;
2091   sprintf( "%.2f",
2092     $self->total_owed_date($time)
2093       - $self->total_credited
2094       - $self->total_unapplied_payments
2095   );
2096 }
2097
2098 =item invoicing_list [ ARRAYREF ]
2099
2100 If an arguement is given, sets these email addresses as invoice recipients
2101 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2102 (except as warnings), so use check_invoicing_list first.
2103
2104 Returns a list of email addresses (with svcnum entries expanded).
2105
2106 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2107 check it without disturbing anything by passing nothing.
2108
2109 This interface may change in the future.
2110
2111 =cut
2112
2113 sub invoicing_list {
2114   my( $self, $arrayref ) = @_;
2115   if ( $arrayref ) {
2116     my @cust_main_invoice;
2117     if ( $self->custnum ) {
2118       @cust_main_invoice =
2119         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2120     } else {
2121       @cust_main_invoice = ();
2122     }
2123     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2124       #warn $cust_main_invoice->destnum;
2125       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2126         #warn $cust_main_invoice->destnum;
2127         my $error = $cust_main_invoice->delete;
2128         warn $error if $error;
2129       }
2130     }
2131     if ( $self->custnum ) {
2132       @cust_main_invoice =
2133         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2134     } else {
2135       @cust_main_invoice = ();
2136     }
2137     my %seen = map { $_->address => 1 } @cust_main_invoice;
2138     foreach my $address ( @{$arrayref} ) {
2139       next if exists $seen{$address} && $seen{$address};
2140       $seen{$address} = 1;
2141       my $cust_main_invoice = new FS::cust_main_invoice ( {
2142         'custnum' => $self->custnum,
2143         'dest'    => $address,
2144       } );
2145       my $error = $cust_main_invoice->insert;
2146       warn $error if $error;
2147     }
2148   }
2149   if ( $self->custnum ) {
2150     map { $_->address }
2151       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2152   } else {
2153     ();
2154   }
2155 }
2156
2157 =item check_invoicing_list ARRAYREF
2158
2159 Checks these arguements as valid input for the invoicing_list method.  If there
2160 is an error, returns the error, otherwise returns false.
2161
2162 =cut
2163
2164 sub check_invoicing_list {
2165   my( $self, $arrayref ) = @_;
2166   foreach my $address ( @{$arrayref} ) {
2167     my $cust_main_invoice = new FS::cust_main_invoice ( {
2168       'custnum' => $self->custnum,
2169       'dest'    => $address,
2170     } );
2171     my $error = $self->custnum
2172                 ? $cust_main_invoice->check
2173                 : $cust_main_invoice->checkdest
2174     ;
2175     return $error if $error;
2176   }
2177   '';
2178 }
2179
2180 =item set_default_invoicing_list
2181
2182 Sets the invoicing list to all accounts associated with this customer,
2183 overwriting any previous invoicing list.
2184
2185 =cut
2186
2187 sub set_default_invoicing_list {
2188   my $self = shift;
2189   $self->invoicing_list($self->all_emails);
2190 }
2191
2192 =item all_emails
2193
2194 Returns the email addresses of all accounts provisioned for this customer.
2195
2196 =cut
2197
2198 sub all_emails {
2199   my $self = shift;
2200   my %list;
2201   foreach my $cust_pkg ( $self->all_pkgs ) {
2202     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2203     my @svc_acct =
2204       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2205         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2206           @cust_svc;
2207     $list{$_}=1 foreach map { $_->email } @svc_acct;
2208   }
2209   keys %list;
2210 }
2211
2212 =item invoicing_list_addpost
2213
2214 Adds postal invoicing to this customer.  If this customer is already configured
2215 to receive postal invoices, does nothing.
2216
2217 =cut
2218
2219 sub invoicing_list_addpost {
2220   my $self = shift;
2221   return if grep { $_ eq 'POST' } $self->invoicing_list;
2222   my @invoicing_list = $self->invoicing_list;
2223   push @invoicing_list, 'POST';
2224   $self->invoicing_list(\@invoicing_list);
2225 }
2226
2227 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2228
2229 Returns an array of customers referred by this customer (referral_custnum set
2230 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2231 customers referred by customers referred by this customer and so on, inclusive.
2232 The default behavior is DEPTH 1 (no recursion).
2233
2234 =cut
2235
2236 sub referral_cust_main {
2237   my $self = shift;
2238   my $depth = @_ ? shift : 1;
2239   my $exclude = @_ ? shift : {};
2240
2241   my @cust_main =
2242     map { $exclude->{$_->custnum}++; $_; }
2243       grep { ! $exclude->{ $_->custnum } }
2244         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2245
2246   if ( $depth > 1 ) {
2247     push @cust_main,
2248       map { $_->referral_cust_main($depth-1, $exclude) }
2249         @cust_main;
2250   }
2251
2252   @cust_main;
2253 }
2254
2255 =item referral_cust_main_ncancelled
2256
2257 Same as referral_cust_main, except only returns customers with uncancelled
2258 packages.
2259
2260 =cut
2261
2262 sub referral_cust_main_ncancelled {
2263   my $self = shift;
2264   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2265 }
2266
2267 =item referral_cust_pkg [ DEPTH ]
2268
2269 Like referral_cust_main, except returns a flat list of all unsuspended (and
2270 uncancelled) packages for each customer.  The number of items in this list may
2271 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2272
2273 =cut
2274
2275 sub referral_cust_pkg {
2276   my $self = shift;
2277   my $depth = @_ ? shift : 1;
2278
2279   map { $_->unsuspended_pkgs }
2280     grep { $_->unsuspended_pkgs }
2281       $self->referral_cust_main($depth);
2282 }
2283
2284 =item credit AMOUNT, REASON
2285
2286 Applies a credit to this customer.  If there is an error, returns the error,
2287 otherwise returns false.
2288
2289 =cut
2290
2291 sub credit {
2292   my( $self, $amount, $reason ) = @_;
2293   my $cust_credit = new FS::cust_credit {
2294     'custnum' => $self->custnum,
2295     'amount'  => $amount,
2296     'reason'  => $reason,
2297   };
2298   $cust_credit->insert;
2299 }
2300
2301 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2302
2303 Creates a one-time charge for this customer.  If there is an error, returns
2304 the error, otherwise returns false.
2305
2306 =cut
2307
2308 sub charge {
2309   my ( $self, $amount ) = ( shift, shift );
2310   my $pkg      = @_ ? shift : 'One-time charge';
2311   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2312   my $taxclass = @_ ? shift : '';
2313
2314   local $SIG{HUP} = 'IGNORE';
2315   local $SIG{INT} = 'IGNORE';
2316   local $SIG{QUIT} = 'IGNORE';
2317   local $SIG{TERM} = 'IGNORE';
2318   local $SIG{TSTP} = 'IGNORE';
2319   local $SIG{PIPE} = 'IGNORE';
2320
2321   my $oldAutoCommit = $FS::UID::AutoCommit;
2322   local $FS::UID::AutoCommit = 0;
2323   my $dbh = dbh;
2324
2325   my $part_pkg = new FS::part_pkg ( {
2326     'pkg'      => $pkg,
2327     'comment'  => $comment,
2328     'setup'    => $amount,
2329     'freq'     => 0,
2330     'recur'    => '0',
2331     'disabled' => 'Y',
2332     'taxclass' => $taxclass,
2333   } );
2334
2335   my $error = $part_pkg->insert;
2336   if ( $error ) {
2337     $dbh->rollback if $oldAutoCommit;
2338     return $error;
2339   }
2340
2341   my $pkgpart = $part_pkg->pkgpart;
2342   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2343   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2344     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2345     $error = $type_pkgs->insert;
2346     if ( $error ) {
2347       $dbh->rollback if $oldAutoCommit;
2348       return $error;
2349     }
2350   }
2351
2352   my $cust_pkg = new FS::cust_pkg ( {
2353     'custnum' => $self->custnum,
2354     'pkgpart' => $pkgpart,
2355   } );
2356
2357   $error = $cust_pkg->insert;
2358   if ( $error ) {
2359     $dbh->rollback if $oldAutoCommit;
2360     return $error;
2361   }
2362
2363   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2364   '';
2365
2366 }
2367
2368 =item cust_bill
2369
2370 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2371
2372 =cut
2373
2374 sub cust_bill {
2375   my $self = shift;
2376   sort { $a->_date <=> $b->_date }
2377     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2378 }
2379
2380 =item open_cust_bill
2381
2382 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2383 customer.
2384
2385 =cut
2386
2387 sub open_cust_bill {
2388   my $self = shift;
2389   grep { $_->owed > 0 } $self->cust_bill;
2390 }
2391
2392 =item cust_credit
2393
2394 Returns all the credits (see L<FS::cust_credit>) for this customer.
2395
2396 =cut
2397
2398 sub cust_credit {
2399   my $self = shift;
2400   sort { $a->_date <=> $b->_date }
2401     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2402 }
2403
2404 =item cust_pay
2405
2406 Returns all the payments (see L<FS::cust_pay>) for this customer.
2407
2408 =cut
2409
2410 sub cust_pay {
2411   my $self = shift;
2412   sort { $a->_date <=> $b->_date }
2413     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2414 }
2415
2416 =item cust_refund
2417
2418 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2419
2420 =cut
2421
2422 sub cust_refund {
2423   my $self = shift;
2424   sort { $a->_date <=> $b->_date }
2425     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2426 }
2427
2428 =back
2429
2430 =head1 SUBROUTINES
2431
2432 =over 4
2433
2434 =item check_and_rebuild_fuzzyfiles
2435
2436 =cut
2437
2438 sub check_and_rebuild_fuzzyfiles {
2439   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2440   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2441     or &rebuild_fuzzyfiles;
2442 }
2443
2444 =item rebuild_fuzzyfiles
2445
2446 =cut
2447
2448 sub rebuild_fuzzyfiles {
2449
2450   use Fcntl qw(:flock);
2451
2452   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2453
2454   #last
2455
2456   open(LASTLOCK,">>$dir/cust_main.last")
2457     or die "can't open $dir/cust_main.last: $!";
2458   flock(LASTLOCK,LOCK_EX)
2459     or die "can't lock $dir/cust_main.last: $!";
2460
2461   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2462   push @all_last,
2463                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2464     if defined dbdef->table('cust_main')->column('ship_last');
2465
2466   open (LASTCACHE,">$dir/cust_main.last.tmp")
2467     or die "can't open $dir/cust_main.last.tmp: $!";
2468   print LASTCACHE join("\n", @all_last), "\n";
2469   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2470
2471   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2472   close LASTLOCK;
2473
2474   #company
2475
2476   open(COMPANYLOCK,">>$dir/cust_main.company")
2477     or die "can't open $dir/cust_main.company: $!";
2478   flock(COMPANYLOCK,LOCK_EX)
2479     or die "can't lock $dir/cust_main.company: $!";
2480
2481   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2482   push @all_company,
2483        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2484     if defined dbdef->table('cust_main')->column('ship_last');
2485
2486   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2487     or die "can't open $dir/cust_main.company.tmp: $!";
2488   print COMPANYCACHE join("\n", @all_company), "\n";
2489   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2490
2491   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2492   close COMPANYLOCK;
2493
2494 }
2495
2496 =item all_last
2497
2498 =cut
2499
2500 sub all_last {
2501   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2502   open(LASTCACHE,"<$dir/cust_main.last")
2503     or die "can't open $dir/cust_main.last: $!";
2504   my @array = map { chomp; $_; } <LASTCACHE>;
2505   close LASTCACHE;
2506   \@array;
2507 }
2508
2509 =item all_company
2510
2511 =cut
2512
2513 sub all_company {
2514   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2515   open(COMPANYCACHE,"<$dir/cust_main.company")
2516     or die "can't open $dir/cust_main.last: $!";
2517   my @array = map { chomp; $_; } <COMPANYCACHE>;
2518   close COMPANYCACHE;
2519   \@array;
2520 }
2521
2522 =item append_fuzzyfiles LASTNAME COMPANY
2523
2524 =cut
2525
2526 sub append_fuzzyfiles {
2527   my( $last, $company ) = @_;
2528
2529   &check_and_rebuild_fuzzyfiles;
2530
2531   use Fcntl qw(:flock);
2532
2533   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2534
2535   if ( $last ) {
2536
2537     open(LAST,">>$dir/cust_main.last")
2538       or die "can't open $dir/cust_main.last: $!";
2539     flock(LAST,LOCK_EX)
2540       or die "can't lock $dir/cust_main.last: $!";
2541
2542     print LAST "$last\n";
2543
2544     flock(LAST,LOCK_UN)
2545       or die "can't unlock $dir/cust_main.last: $!";
2546     close LAST;
2547   }
2548
2549   if ( $company ) {
2550
2551     open(COMPANY,">>$dir/cust_main.company")
2552       or die "can't open $dir/cust_main.company: $!";
2553     flock(COMPANY,LOCK_EX)
2554       or die "can't lock $dir/cust_main.company: $!";
2555
2556     print COMPANY "$company\n";
2557
2558     flock(COMPANY,LOCK_UN)
2559       or die "can't unlock $dir/cust_main.company: $!";
2560
2561     close COMPANY;
2562   }
2563
2564   1;
2565 }
2566
2567 =item batch_import
2568
2569 =cut
2570
2571 sub batch_import {
2572   my $param = shift;
2573   #warn join('-',keys %$param);
2574   my $fh = $param->{filehandle};
2575   my $agentnum = $param->{agentnum};
2576   my $refnum = $param->{refnum};
2577   my $pkgpart = $param->{pkgpart};
2578   my @fields = @{$param->{fields}};
2579
2580   eval "use Date::Parse;";
2581   die $@ if $@;
2582   eval "use Text::CSV_XS;";
2583   die $@ if $@;
2584
2585   my $csv = new Text::CSV_XS;
2586   #warn $csv;
2587   #warn $fh;
2588
2589   my $imported = 0;
2590   #my $columns;
2591
2592   local $SIG{HUP} = 'IGNORE';
2593   local $SIG{INT} = 'IGNORE';
2594   local $SIG{QUIT} = 'IGNORE';
2595   local $SIG{TERM} = 'IGNORE';
2596   local $SIG{TSTP} = 'IGNORE';
2597   local $SIG{PIPE} = 'IGNORE';
2598
2599   my $oldAutoCommit = $FS::UID::AutoCommit;
2600   local $FS::UID::AutoCommit = 0;
2601   my $dbh = dbh;
2602
2603   #while ( $columns = $csv->getline($fh) ) {
2604   my $line;
2605   while ( defined($line=<$fh>) ) {
2606
2607     $csv->parse($line) or do {
2608       $dbh->rollback if $oldAutoCommit;
2609       return "can't parse: ". $csv->error_input();
2610     };
2611
2612     my @columns = $csv->fields();
2613     #warn join('-',@columns);
2614
2615     my %cust_main = (
2616       agentnum => $agentnum,
2617       refnum   => $refnum,
2618       country  => 'US', #default
2619       payby    => 'BILL', #default
2620       paydate  => '12/2037', #default
2621     );
2622     my $billtime = time;
2623     my %cust_pkg = ( pkgpart => $pkgpart );
2624     foreach my $field ( @fields ) {
2625       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2626         #$cust_pkg{$1} = str2time( shift @$columns );
2627         if ( $1 eq 'setup' ) {
2628           $billtime = str2time(shift @columns);
2629         } else {
2630           $cust_pkg{$1} = str2time( shift @columns );
2631         }
2632       } else {
2633         #$cust_main{$field} = shift @$columns;
2634         $cust_main{$field} = shift @columns;
2635       }
2636     }
2637
2638     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2639     my $cust_main = new FS::cust_main ( \%cust_main );
2640     use Tie::RefHash;
2641     tie my %hash, 'Tie::RefHash'; #this part is important
2642     $hash{$cust_pkg} = [] if $pkgpart;
2643     my $error = $cust_main->insert( \%hash );
2644
2645     if ( $error ) {
2646       $dbh->rollback if $oldAutoCommit;
2647       return "can't insert customer for $line: $error";
2648     }
2649
2650     #false laziness w/bill.cgi
2651     $error = $cust_main->bill( 'time' => $billtime );
2652     if ( $error ) {
2653       $dbh->rollback if $oldAutoCommit;
2654       return "can't bill customer for $line: $error";
2655     }
2656
2657     $cust_main->apply_payments;
2658     $cust_main->apply_credits;
2659
2660     $error = $cust_main->collect();
2661     if ( $error ) {
2662       $dbh->rollback if $oldAutoCommit;
2663       return "can't collect customer for $line: $error";
2664     }
2665
2666     $imported++;
2667   }
2668
2669   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2670
2671   return "Empty file!" unless $imported;
2672
2673   ''; #no error
2674
2675 }
2676
2677 =item batch_charge
2678
2679 =cut
2680
2681 sub batch_charge {
2682   my $param = shift;
2683   #warn join('-',keys %$param);
2684   my $fh = $param->{filehandle};
2685   my @fields = @{$param->{fields}};
2686
2687   eval "use Date::Parse;";
2688   die $@ if $@;
2689   eval "use Text::CSV_XS;";
2690   die $@ if $@;
2691
2692   my $csv = new Text::CSV_XS;
2693   #warn $csv;
2694   #warn $fh;
2695
2696   my $imported = 0;
2697   #my $columns;
2698
2699   local $SIG{HUP} = 'IGNORE';
2700   local $SIG{INT} = 'IGNORE';
2701   local $SIG{QUIT} = 'IGNORE';
2702   local $SIG{TERM} = 'IGNORE';
2703   local $SIG{TSTP} = 'IGNORE';
2704   local $SIG{PIPE} = 'IGNORE';
2705
2706   my $oldAutoCommit = $FS::UID::AutoCommit;
2707   local $FS::UID::AutoCommit = 0;
2708   my $dbh = dbh;
2709
2710   #while ( $columns = $csv->getline($fh) ) {
2711   my $line;
2712   while ( defined($line=<$fh>) ) {
2713
2714     $csv->parse($line) or do {
2715       $dbh->rollback if $oldAutoCommit;
2716       return "can't parse: ". $csv->error_input();
2717     };
2718
2719     my @columns = $csv->fields();
2720     #warn join('-',@columns);
2721
2722     my %row = ();
2723     foreach my $field ( @fields ) {
2724       $row{$field} = shift @columns;
2725     }
2726
2727     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2728     unless ( $cust_main ) {
2729       $dbh->rollback if $oldAutoCommit;
2730       return "unknown custnum $row{'custnum'}";
2731     }
2732
2733     if ( $row{'amount'} > 0 ) {
2734       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2735       if ( $error ) {
2736         $dbh->rollback if $oldAutoCommit;
2737         return $error;
2738       }
2739       $imported++;
2740     } elsif ( $row{'amount'} < 0 ) {
2741       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2742                                       $row{'pkg'}                         );
2743       if ( $error ) {
2744         $dbh->rollback if $oldAutoCommit;
2745         return $error;
2746       }
2747       $imported++;
2748     } else {
2749       #hmm?
2750     }
2751
2752   }
2753
2754   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2755
2756   return "Empty file!" unless $imported;
2757
2758   ''; #no error
2759
2760 }
2761
2762 =back
2763
2764 =head1 BUGS
2765
2766 The delete method.
2767
2768 The delete method should possibly take an FS::cust_main object reference
2769 instead of a scalar customer number.
2770
2771 Bill and collect options should probably be passed as references instead of a
2772 list.
2773
2774 There should probably be a configuration file with a list of allowed credit
2775 card types.
2776
2777 No multiple currency support (probably a larger project than just this module).
2778
2779 =head1 SEE ALSO
2780
2781 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2782 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2783 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2784
2785 =cut
2786
2787 1;
2788