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 ne 'CHEK' &&
 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 ) {
1205         $dbh->rollback if $oldAutoCommit;
1206         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1207       }
1208       if ( $recur < 0 ) {
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           # maybe eliminate this entirely, along with all the 0% records
1243           unless ( @taxes ) {
1244             $dbh->rollback if $oldAutoCommit;
1245             return
1246               "fatal: can't find tax rate for state/county/country/taxclass ".
1247               join('/', ( map $self->$_(), qw(state county country) ),
1248                         $part_pkg->taxclass ).  "\n";
1249           }
1250
1251           foreach my $tax ( @taxes ) {
1252
1253             my $taxable_charged = 0;
1254             $taxable_charged += $setup
1255               unless $part_pkg->setuptax =~ /^Y$/i
1256                   || $tax->setuptax =~ /^Y$/i;
1257             $taxable_charged += $recur
1258               unless $part_pkg->recurtax =~ /^Y$/i
1259                   || $tax->recurtax =~ /^Y$/i;
1260             next unless $taxable_charged;
1261
1262             if ( $tax->exempt_amount > 0 ) {
1263               my ($mon,$year) = (localtime($sdate) )[4,5];
1264               $mon++;
1265               my $freq = $part_pkg->freq || 1;
1266               if ( $freq !~ /(\d+)$/ ) {
1267                 $dbh->rollback if $oldAutoCommit;
1268                 return "daily/weekly package definitions not (yet?)".
1269                        " compatible with monthly tax exemptions";
1270               }
1271               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1272               foreach my $which_month ( 1 .. $freq ) {
1273                 my %hash = (
1274                   'custnum' => $self->custnum,
1275                   'taxnum'  => $tax->taxnum,
1276                   'year'    => 1900+$year,
1277                   'month'   => $mon++,
1278                 );
1279                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1280                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1281                 my $cust_tax_exempt =
1282                   qsearchs('cust_tax_exempt', \%hash)
1283                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1284                 my $remaining_exemption = sprintf("%.2f",
1285                   $tax->exempt_amount - $cust_tax_exempt->amount );
1286                 if ( $remaining_exemption > 0 ) {
1287                   my $addl = $remaining_exemption > $taxable_per_month
1288                     ? $taxable_per_month
1289                     : $remaining_exemption;
1290                   $taxable_charged -= $addl;
1291                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1292                     $cust_tax_exempt->hash,
1293                     'amount' =>
1294                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1295                   } );
1296                   $error = $new_cust_tax_exempt->exemptnum
1297                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1298                     : $new_cust_tax_exempt->insert;
1299                   if ( $error ) {
1300                     $dbh->rollback if $oldAutoCommit;
1301                     return "fatal: can't update cust_tax_exempt: $error";
1302                   }
1303
1304                 } # if $remaining_exemption > 0
1305
1306               } #foreach $which_month
1307
1308             } #if $tax->exempt_amount
1309
1310             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1311
1312             #$tax += $taxable_charged * $cust_main_county->tax / 100
1313             $tax{ $tax->taxname || 'Tax' } +=
1314               $taxable_charged * $tax->tax / 100
1315
1316           } #foreach my $tax ( @taxes )
1317
1318         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1319
1320       } #if $setup > 0 || $recur > 0
1321
1322     } #if $cust_pkg_mod_flag
1323
1324   } #foreach my $cust_pkg
1325
1326   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1327 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1328
1329   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1330     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1331     return '';
1332   }
1333
1334 #  unless ( $self->tax =~ /Y/i
1335 #           || $self->payby eq 'COMP'
1336 #           || $taxable_charged == 0 ) {
1337 #    my $cust_main_county = qsearchs('cust_main_county',{
1338 #        'state'   => $self->state,
1339 #        'county'  => $self->county,
1340 #        'country' => $self->country,
1341 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1342 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1343 #    my $tax = sprintf( "%.2f",
1344 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1345 #    );
1346
1347   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1348
1349     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1350       my $tax = sprintf("%.2f", $tax{$taxname} );
1351       $charged = sprintf( "%.2f", $charged+$tax );
1352
1353       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1354         'pkgnum'   => 0,
1355         'setup'    => $tax,
1356         'recur'    => 0,
1357         'sdate'    => '',
1358         'edate'    => '',
1359         'itemdesc' => $taxname,
1360       });
1361       push @cust_bill_pkg, $cust_bill_pkg;
1362     }
1363
1364   } else { #1.4 schema
1365
1366     my $tax = 0;
1367     foreach ( values %tax ) { $tax += $_ };
1368     $tax = sprintf("%.2f", $tax);
1369     if ( $tax > 0 ) {
1370       $charged = sprintf( "%.2f", $charged+$tax );
1371
1372       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1373         'pkgnum' => 0,
1374         'setup'  => $tax,
1375         'recur'  => 0,
1376         'sdate'  => '',
1377         'edate'  => '',
1378       });
1379       push @cust_bill_pkg, $cust_bill_pkg;
1380     }
1381
1382   }
1383
1384   my $cust_bill = new FS::cust_bill ( {
1385     'custnum' => $self->custnum,
1386     '_date'   => $time,
1387     'charged' => $charged,
1388   } );
1389   $error = $cust_bill->insert;
1390   if ( $error ) {
1391     $dbh->rollback if $oldAutoCommit;
1392     return "can't create invoice for customer #". $self->custnum. ": $error";
1393   }
1394
1395   my $invnum = $cust_bill->invnum;
1396   my $cust_bill_pkg;
1397   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1398     #warn $invnum;
1399     $cust_bill_pkg->invnum($invnum);
1400     $error = $cust_bill_pkg->insert;
1401     if ( $error ) {
1402       $dbh->rollback if $oldAutoCommit;
1403       return "can't create invoice line item for customer #". $self->custnum.
1404              ": $error";
1405     }
1406   }
1407
1408   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1409   ''; #no error
1410 }
1411
1412 =item collect OPTIONS
1413
1414 (Attempt to) collect money for this customer's outstanding invoices (see
1415 L<FS::cust_bill>).  Usually used after the bill method.
1416
1417 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1418 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1419 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1420
1421 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1422 and the invoice events web interface.
1423
1424 If there is an error, returns the error, otherwise returns false.
1425
1426 Options are passed as name-value pairs.
1427
1428 Currently available options are:
1429
1430 invoice_time - Use this time when deciding when to print invoices and
1431 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>
1432 for conversion functions.
1433
1434 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1435 events.
1436
1437 retry_card - Deprecated alias for 'retry'
1438
1439 batch_card - This option is deprecated.  See the invoice events web interface
1440 to control whether cards are batched or run against a realtime gateway.
1441
1442 report_badcard - This option is deprecated.
1443
1444 force_print - This option is deprecated; see the invoice events web interface.
1445
1446 quiet - set true to surpress email card/ACH decline notices.
1447
1448 =cut
1449
1450 sub collect {
1451   my( $self, %options ) = @_;
1452   my $invoice_time = $options{'invoice_time'} || time;
1453
1454   #put below somehow?
1455   local $SIG{HUP} = 'IGNORE';
1456   local $SIG{INT} = 'IGNORE';
1457   local $SIG{QUIT} = 'IGNORE';
1458   local $SIG{TERM} = 'IGNORE';
1459   local $SIG{TSTP} = 'IGNORE';
1460   local $SIG{PIPE} = 'IGNORE';
1461
1462   my $oldAutoCommit = $FS::UID::AutoCommit;
1463   local $FS::UID::AutoCommit = 0;
1464   my $dbh = dbh;
1465
1466   my $balance = $self->balance;
1467   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1468   unless ( $balance > 0 ) { #redundant?????
1469     $dbh->rollback if $oldAutoCommit; #hmm
1470     return '';
1471   }
1472
1473   if ( exists($options{'retry_card'}) ) {
1474     carp 'retry_card option passed to collect is deprecated; use retry';
1475     $options{'retry'} ||= $options{'retry_card'};
1476   }
1477   if ( exists($options{'retry'}) && $options{'retry'} ) {
1478     my $error = $self->retry_realtime;
1479     if ( $error ) {
1480       $dbh->rollback if $oldAutoCommit;
1481       return $error;
1482     }
1483   }
1484
1485   foreach my $cust_bill ( $self->open_cust_bill ) {
1486
1487     # don't try to charge for the same invoice if it's already in a batch
1488     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1489
1490     last if $self->balance <= 0;
1491
1492     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1493       if $Debug;
1494
1495     foreach my $part_bill_event (
1496       sort {    $a->seconds   <=> $b->seconds
1497              || $a->weight    <=> $b->weight
1498              || $a->eventpart <=> $b->eventpart }
1499         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1500                && ! qsearchs( 'cust_bill_event', {
1501                                 'invnum'    => $cust_bill->invnum,
1502                                 'eventpart' => $_->eventpart,
1503                                 'status'    => 'done',
1504                                                                    } )
1505              }
1506           qsearch('part_bill_event', { 'payby'    => $self->payby,
1507                                        'disabled' => '',           } )
1508     ) {
1509
1510       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1511            || $self->balance   <= 0; # or if balance<=0
1512
1513       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1514         if $Debug;
1515       my $cust_main = $self; #for callback
1516
1517       my $error;
1518       {
1519         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1520         $error = eval $part_bill_event->eventcode;
1521       }
1522
1523       my $status = '';
1524       my $statustext = '';
1525       if ( $@ ) {
1526         $status = 'failed';
1527         $statustext = $@;
1528       } elsif ( $error ) {
1529         $status = 'done';
1530         $statustext = $error;
1531       } else {
1532         $status = 'done'
1533       }
1534
1535       #add cust_bill_event
1536       my $cust_bill_event = new FS::cust_bill_event {
1537         'invnum'     => $cust_bill->invnum,
1538         'eventpart'  => $part_bill_event->eventpart,
1539         #'_date'      => $invoice_time,
1540         '_date'      => time,
1541         'status'     => $status,
1542         'statustext' => $statustext,
1543       };
1544       $error = $cust_bill_event->insert;
1545       if ( $error ) {
1546         #$dbh->rollback if $oldAutoCommit;
1547         #return "error: $error";
1548
1549         # gah, even with transactions.
1550         $dbh->commit if $oldAutoCommit; #well.
1551         my $e = 'WARNING: Event run but database not updated - '.
1552                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1553                 ', eventpart '. $part_bill_event->eventpart.
1554                 ": $error";
1555         warn $e;
1556         return $e;
1557       }
1558
1559
1560     }
1561
1562   }
1563
1564   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1565   '';
1566
1567 }
1568
1569 =item retry_realtime
1570
1571 Schedules realtime credit card / electronic check / LEC billing events for
1572 for retry.  Useful if card information has changed or manual retry is desired.
1573 The 'collect' method must be called to actually retry the transaction.
1574
1575 Implementation details: For each of this customer's open invoices, changes
1576 the status of the first "done" (with statustext error) realtime processing
1577 event to "failed".
1578
1579 =cut
1580
1581 sub retry_realtime {
1582   my $self = shift;
1583
1584   local $SIG{HUP} = 'IGNORE';
1585   local $SIG{INT} = 'IGNORE';
1586   local $SIG{QUIT} = 'IGNORE';
1587   local $SIG{TERM} = 'IGNORE';
1588   local $SIG{TSTP} = 'IGNORE';
1589   local $SIG{PIPE} = 'IGNORE';
1590
1591   my $oldAutoCommit = $FS::UID::AutoCommit;
1592   local $FS::UID::AutoCommit = 0;
1593   my $dbh = dbh;
1594
1595   foreach my $cust_bill (
1596     grep { $_->cust_bill_event }
1597       $self->open_cust_bill
1598   ) {
1599     my @cust_bill_event =
1600       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1601         grep {
1602                #$_->part_bill_event->plan eq 'realtime-card'
1603                $_->part_bill_event->eventcode =~
1604                    /\$cust_bill\->realtime_(card|ach|lec)/
1605                  && $_->status eq 'done'
1606                  && $_->statustext
1607              }
1608           $cust_bill->cust_bill_event;
1609     next unless @cust_bill_event;
1610     my $error = $cust_bill_event[0]->retry;
1611     if ( $error ) {
1612       $dbh->rollback if $oldAutoCommit;
1613       return "error scheduling invoice event for retry: $error";
1614     }
1615
1616   }
1617
1618   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1619   '';
1620
1621 }
1622
1623 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1624
1625 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1626 via a Business::OnlinePayment realtime gateway.  See
1627 L<http://420.am/business-onlinepayment> for supported gateways.
1628
1629 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1630
1631 Available options are: I<description>, I<invnum>, I<quiet>
1632
1633 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1634 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1635 if set, will override the value from the customer record.
1636
1637 I<description> is a free-text field passed to the gateway.  It defaults to
1638 "Internet services".
1639
1640 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1641 specified invoice.  If you don't specify an I<invnum> you might want to
1642 call the B<apply_payments> method.
1643
1644 I<quiet> can be set true to surpress email decline notices.
1645
1646 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1647
1648 =cut
1649
1650 sub realtime_bop {
1651   my( $self, $method, $amount, %options ) = @_;
1652   if ( $Debug ) {
1653     warn "$self $method $amount\n";
1654     warn "  $_ => $options{$_}\n" foreach keys %options;
1655   }
1656
1657   $options{'description'} ||= 'Internet services';
1658
1659   #pre-requisites
1660   die "Real-time processing not enabled\n"
1661     unless $conf->exists('business-onlinepayment');
1662   eval "use Business::OnlinePayment";
1663   die $@ if $@;
1664
1665   #overrides
1666   $self->set( $_ => $options{$_} )
1667     foreach grep { exists($options{$_}) }
1668             qw( payname address1 address2 city state zip payinfo paydate );
1669
1670   #load up config
1671   my $bop_config = 'business-onlinepayment';
1672   $bop_config .= '-ach'
1673     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1674   my ( $processor, $login, $password, $action, @bop_options ) =
1675     $conf->config($bop_config);
1676   $action ||= 'normal authorization';
1677   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1678
1679   #massage data
1680
1681   my $address = $self->address1;
1682   $address .= ", ". $self->address2 if $self->address2;
1683
1684   my($payname, $payfirst, $paylast);
1685   if ( $self->payname && $method ne 'ECHECK' ) {
1686     $payname = $self->payname;
1687     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1688       or return "Illegal payname $payname";
1689     ($payfirst, $paylast) = ($1, $2);
1690   } else {
1691     $payfirst = $self->getfield('first');
1692     $paylast = $self->getfield('last');
1693     $payname =  "$payfirst $paylast";
1694   }
1695
1696   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1697   if ( $conf->exists('emailinvoiceauto')
1698        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1699     push @invoicing_list, $self->all_emails;
1700   }
1701   my $email = $invoicing_list[0];
1702
1703   my %content;
1704   if ( $method eq 'CC' ) {
1705
1706     $content{card_number} = $self->payinfo;
1707     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1708     $content{expiration} = "$2/$1";
1709
1710     $content{cvv2} = $self->paycvv
1711       if defined $self->dbdef_table->column('paycvv')
1712          && length($self->paycvv);
1713
1714     $content{recurring_billing} = 'YES'
1715       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1716                                'payby'   => 'CARD',
1717                                'payinfo' => $self->payinfo, } );
1718
1719   } elsif ( $method eq 'ECHECK' ) {
1720     my($account_number,$routing_code) = $self->payinfo;
1721     ( $content{account_number}, $content{routing_code} ) =
1722       split('@', $self->payinfo);
1723     $content{bank_name} = $self->payname;
1724     $content{account_type} = 'CHECKING';
1725     $content{account_name} = $payname;
1726     $content{customer_org} = $self->company ? 'B' : 'I';
1727     $content{customer_ssn} = $self->ss;
1728   } elsif ( $method eq 'LEC' ) {
1729     $content{phone} = $self->payinfo;
1730   }
1731
1732   #transaction(s)
1733
1734   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1735
1736   my $transaction =
1737     new Business::OnlinePayment( $processor, @bop_options );
1738   $transaction->content(
1739     'type'           => $method,
1740     'login'          => $login,
1741     'password'       => $password,
1742     'action'         => $action1,
1743     'description'    => $options{'description'},
1744     'amount'         => $amount,
1745     'invoice_number' => $options{'invnum'},
1746     'customer_id'    => $self->custnum,
1747     'last_name'      => $paylast,
1748     'first_name'     => $payfirst,
1749     'name'           => $payname,
1750     'address'        => $address,
1751     'city'           => $self->city,
1752     'state'          => $self->state,
1753     'zip'            => $self->zip,
1754     'country'        => $self->country,
1755     'referer'        => 'http://cleanwhisker.420.am/',
1756     'email'          => $email,
1757     'phone'          => $self->daytime || $self->night,
1758     %content, #after
1759   );
1760   $transaction->submit();
1761
1762   if ( $transaction->is_success() && $action2 ) {
1763     my $auth = $transaction->authorization;
1764     my $ordernum = $transaction->can('order_number')
1765                    ? $transaction->order_number
1766                    : '';
1767
1768     my $capture =
1769       new Business::OnlinePayment( $processor, @bop_options );
1770
1771     my %capture = (
1772       %content,
1773       type           => $method,
1774       action         => $action2,
1775       login          => $login,
1776       password       => $password,
1777       order_number   => $ordernum,
1778       amount         => $amount,
1779       authorization  => $auth,
1780       description    => $options{'description'},
1781     );
1782
1783     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1784                            transaction_sequence_num local_transaction_date
1785                            local_transaction_time AVS_result_code          )) {
1786       $capture{$field} = $transaction->$field() if $transaction->can($field);
1787     }
1788
1789     $capture->content( %capture );
1790
1791     $capture->submit();
1792
1793     unless ( $capture->is_success ) {
1794       my $e = "Authorization sucessful but capture failed, custnum #".
1795               $self->custnum. ': '.  $capture->result_code.
1796               ": ". $capture->error_message;
1797       warn $e;
1798       return $e;
1799     }
1800
1801   }
1802
1803   #remove paycvv after initial transaction
1804   #make this disable-able via a config option if anyone insists?
1805   # (though that probably violates cardholder agreements)
1806   if ( defined $self->dbdef_table->column('paycvv')
1807        && length($self->paycvv)
1808        && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1809   ) {
1810     my $new = new FS::cust_main { $self->hash };
1811     $new->paycvv('');
1812     my $error = $new->replace($self);
1813     if ( $error ) {
1814       warn "error removing cvv: $error\n";
1815     }
1816   }
1817
1818   #result handling
1819   if ( $transaction->is_success() ) {
1820
1821     my %method2payby = (
1822       'CC'     => 'CARD',
1823       'ECHECK' => 'CHEK',
1824       'LEC'    => 'LECB',
1825     );
1826
1827     my $cust_pay = new FS::cust_pay ( {
1828        'custnum'  => $self->custnum,
1829        'invnum'   => $options{'invnum'},
1830        'paid'     => $amount,
1831        '_date'     => '',
1832        'payby'    => $method2payby{$method},
1833        'payinfo'  => $self->payinfo,
1834        'paybatch' => "$processor:". $transaction->authorization,
1835     } );
1836     my $error = $cust_pay->insert;
1837     if ( $error ) {
1838       # gah, even with transactions.
1839       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1840               'error applying payment, invnum #' . $self->invnum.
1841               " ($processor): $error";
1842       warn $e;
1843       return $e;
1844     } else {
1845       return '';
1846     }
1847
1848   } else {
1849
1850     my $perror = "$processor error: ". $transaction->error_message;
1851
1852     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1853          && $conf->exists('emaildecline')
1854          && grep { $_ ne 'POST' } $self->invoicing_list
1855          && ! grep { $_ eq $transaction->error_message }
1856                    $conf->config('emaildecline-exclude')
1857     ) {
1858       my @templ = $conf->config('declinetemplate');
1859       my $template = new Text::Template (
1860         TYPE   => 'ARRAY',
1861         SOURCE => [ map "$_\n", @templ ],
1862       ) or return "($perror) can't create template: $Text::Template::ERROR";
1863       $template->compile()
1864         or return "($perror) can't compile template: $Text::Template::ERROR";
1865
1866       my $templ_hash = { error => $transaction->error_message };
1867
1868       my $error = send_email(
1869         'from'    => $conf->config('invoice_from'),
1870         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1871         'subject' => 'Your payment could not be processed',
1872         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1873       );
1874
1875       $perror .= " (also received error sending decline notification: $error)"
1876         if $error;
1877
1878     }
1879
1880     return $perror;
1881   }
1882
1883 }
1884
1885 =item total_owed
1886
1887 Returns the total owed for this customer on all invoices
1888 (see L<FS::cust_bill/owed>).
1889
1890 =cut
1891
1892 sub total_owed {
1893   my $self = shift;
1894   $self->total_owed_date(2145859200); #12/31/2037
1895 }
1896
1897 =item total_owed_date TIME
1898
1899 Returns the total owed for this customer on all invoices with date earlier than
1900 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1901 see L<Time::Local> and L<Date::Parse> for conversion functions.
1902
1903 =cut
1904
1905 sub total_owed_date {
1906   my $self = shift;
1907   my $time = shift;
1908   my $total_bill = 0;
1909   foreach my $cust_bill (
1910     grep { $_->_date <= $time }
1911       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1912   ) {
1913     $total_bill += $cust_bill->owed;
1914   }
1915   sprintf( "%.2f", $total_bill );
1916 }
1917
1918 =item apply_credits
1919
1920 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1921 to outstanding invoice balances in chronological order and returns the value
1922 of any remaining unapplied credits available for refund
1923 (see L<FS::cust_refund>).
1924
1925 =cut
1926
1927 sub apply_credits {
1928   my $self = shift;
1929
1930   return 0 unless $self->total_credited;
1931
1932   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1933       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1934
1935   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1936       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1937
1938   my $credit;
1939
1940   foreach my $cust_bill ( @invoices ) {
1941     my $amount;
1942
1943     if ( !defined($credit) || $credit->credited == 0) {
1944       $credit = pop @credits or last;
1945     }
1946
1947     if ($cust_bill->owed >= $credit->credited) {
1948       $amount=$credit->credited;
1949     }else{
1950       $amount=$cust_bill->owed;
1951     }
1952
1953     my $cust_credit_bill = new FS::cust_credit_bill ( {
1954       'crednum' => $credit->crednum,
1955       'invnum'  => $cust_bill->invnum,
1956       'amount'  => $amount,
1957     } );
1958     my $error = $cust_credit_bill->insert;
1959     die $error if $error;
1960
1961     redo if ($cust_bill->owed > 0);
1962
1963   }
1964
1965   return $self->total_credited;
1966 }
1967
1968 =item apply_payments
1969
1970 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1971 to outstanding invoice balances in chronological order.
1972
1973  #and returns the value of any remaining unapplied payments.
1974
1975 =cut
1976
1977 sub apply_payments {
1978   my $self = shift;
1979
1980   #return 0 unless
1981
1982   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1983       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1984
1985   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1986       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1987
1988   my $payment;
1989
1990   foreach my $cust_bill ( @invoices ) {
1991     my $amount;
1992
1993     if ( !defined($payment) || $payment->unapplied == 0 ) {
1994       $payment = pop @payments or last;
1995     }
1996
1997     if ( $cust_bill->owed >= $payment->unapplied ) {
1998       $amount = $payment->unapplied;
1999     } else {
2000       $amount = $cust_bill->owed;
2001     }
2002
2003     my $cust_bill_pay = new FS::cust_bill_pay ( {
2004       'paynum' => $payment->paynum,
2005       'invnum' => $cust_bill->invnum,
2006       'amount' => $amount,
2007     } );
2008     my $error = $cust_bill_pay->insert;
2009     die $error if $error;
2010
2011     redo if ( $cust_bill->owed > 0);
2012
2013   }
2014
2015   return $self->total_unapplied_payments;
2016 }
2017
2018 =item total_credited
2019
2020 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2021 customer.  See L<FS::cust_credit/credited>.
2022
2023 =cut
2024
2025 sub total_credited {
2026   my $self = shift;
2027   my $total_credit = 0;
2028   foreach my $cust_credit ( qsearch('cust_credit', {
2029     'custnum' => $self->custnum,
2030   } ) ) {
2031     $total_credit += $cust_credit->credited;
2032   }
2033   sprintf( "%.2f", $total_credit );
2034 }
2035
2036 =item total_unapplied_payments
2037
2038 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2039 See L<FS::cust_pay/unapplied>.
2040
2041 =cut
2042
2043 sub total_unapplied_payments {
2044   my $self = shift;
2045   my $total_unapplied = 0;
2046   foreach my $cust_pay ( qsearch('cust_pay', {
2047     'custnum' => $self->custnum,
2048   } ) ) {
2049     $total_unapplied += $cust_pay->unapplied;
2050   }
2051   sprintf( "%.2f", $total_unapplied );
2052 }
2053
2054 =item balance
2055
2056 Returns the balance for this customer (total_owed minus total_credited
2057 minus total_unapplied_payments).
2058
2059 =cut
2060
2061 sub balance {
2062   my $self = shift;
2063   sprintf( "%.2f",
2064     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2065   );
2066 }
2067
2068 =item balance_date TIME
2069
2070 Returns the balance for this customer, only considering invoices with date
2071 earlier than TIME (total_owed_date minus total_credited minus
2072 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2073 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2074 functions.
2075
2076 =cut
2077
2078 sub balance_date {
2079   my $self = shift;
2080   my $time = shift;
2081   sprintf( "%.2f",
2082     $self->total_owed_date($time)
2083       - $self->total_credited
2084       - $self->total_unapplied_payments
2085   );
2086 }
2087
2088 =item invoicing_list [ ARRAYREF ]
2089
2090 If an arguement is given, sets these email addresses as invoice recipients
2091 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2092 (except as warnings), so use check_invoicing_list first.
2093
2094 Returns a list of email addresses (with svcnum entries expanded).
2095
2096 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2097 check it without disturbing anything by passing nothing.
2098
2099 This interface may change in the future.
2100
2101 =cut
2102
2103 sub invoicing_list {
2104   my( $self, $arrayref ) = @_;
2105   if ( $arrayref ) {
2106     my @cust_main_invoice;
2107     if ( $self->custnum ) {
2108       @cust_main_invoice =
2109         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2110     } else {
2111       @cust_main_invoice = ();
2112     }
2113     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2114       #warn $cust_main_invoice->destnum;
2115       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2116         #warn $cust_main_invoice->destnum;
2117         my $error = $cust_main_invoice->delete;
2118         warn $error if $error;
2119       }
2120     }
2121     if ( $self->custnum ) {
2122       @cust_main_invoice =
2123         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2124     } else {
2125       @cust_main_invoice = ();
2126     }
2127     my %seen = map { $_->address => 1 } @cust_main_invoice;
2128     foreach my $address ( @{$arrayref} ) {
2129       next if exists $seen{$address} && $seen{$address};
2130       $seen{$address} = 1;
2131       my $cust_main_invoice = new FS::cust_main_invoice ( {
2132         'custnum' => $self->custnum,
2133         'dest'    => $address,
2134       } );
2135       my $error = $cust_main_invoice->insert;
2136       warn $error if $error;
2137     }
2138   }
2139   if ( $self->custnum ) {
2140     map { $_->address }
2141       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2142   } else {
2143     ();
2144   }
2145 }
2146
2147 =item check_invoicing_list ARRAYREF
2148
2149 Checks these arguements as valid input for the invoicing_list method.  If there
2150 is an error, returns the error, otherwise returns false.
2151
2152 =cut
2153
2154 sub check_invoicing_list {
2155   my( $self, $arrayref ) = @_;
2156   foreach my $address ( @{$arrayref} ) {
2157     my $cust_main_invoice = new FS::cust_main_invoice ( {
2158       'custnum' => $self->custnum,
2159       'dest'    => $address,
2160     } );
2161     my $error = $self->custnum
2162                 ? $cust_main_invoice->check
2163                 : $cust_main_invoice->checkdest
2164     ;
2165     return $error if $error;
2166   }
2167   '';
2168 }
2169
2170 =item set_default_invoicing_list
2171
2172 Sets the invoicing list to all accounts associated with this customer,
2173 overwriting any previous invoicing list.
2174
2175 =cut
2176
2177 sub set_default_invoicing_list {
2178   my $self = shift;
2179   $self->invoicing_list($self->all_emails);
2180 }
2181
2182 =item all_emails
2183
2184 Returns the email addresses of all accounts provisioned for this customer.
2185
2186 =cut
2187
2188 sub all_emails {
2189   my $self = shift;
2190   my %list;
2191   foreach my $cust_pkg ( $self->all_pkgs ) {
2192     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2193     my @svc_acct =
2194       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2195         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2196           @cust_svc;
2197     $list{$_}=1 foreach map { $_->email } @svc_acct;
2198   }
2199   keys %list;
2200 }
2201
2202 =item invoicing_list_addpost
2203
2204 Adds postal invoicing to this customer.  If this customer is already configured
2205 to receive postal invoices, does nothing.
2206
2207 =cut
2208
2209 sub invoicing_list_addpost {
2210   my $self = shift;
2211   return if grep { $_ eq 'POST' } $self->invoicing_list;
2212   my @invoicing_list = $self->invoicing_list;
2213   push @invoicing_list, 'POST';
2214   $self->invoicing_list(\@invoicing_list);
2215 }
2216
2217 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2218
2219 Returns an array of customers referred by this customer (referral_custnum set
2220 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2221 customers referred by customers referred by this customer and so on, inclusive.
2222 The default behavior is DEPTH 1 (no recursion).
2223
2224 =cut
2225
2226 sub referral_cust_main {
2227   my $self = shift;
2228   my $depth = @_ ? shift : 1;
2229   my $exclude = @_ ? shift : {};
2230
2231   my @cust_main =
2232     map { $exclude->{$_->custnum}++; $_; }
2233       grep { ! $exclude->{ $_->custnum } }
2234         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2235
2236   if ( $depth > 1 ) {
2237     push @cust_main,
2238       map { $_->referral_cust_main($depth-1, $exclude) }
2239         @cust_main;
2240   }
2241
2242   @cust_main;
2243 }
2244
2245 =item referral_cust_main_ncancelled
2246
2247 Same as referral_cust_main, except only returns customers with uncancelled
2248 packages.
2249
2250 =cut
2251
2252 sub referral_cust_main_ncancelled {
2253   my $self = shift;
2254   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2255 }
2256
2257 =item referral_cust_pkg [ DEPTH ]
2258
2259 Like referral_cust_main, except returns a flat list of all unsuspended (and
2260 uncancelled) packages for each customer.  The number of items in this list may
2261 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2262
2263 =cut
2264
2265 sub referral_cust_pkg {
2266   my $self = shift;
2267   my $depth = @_ ? shift : 1;
2268
2269   map { $_->unsuspended_pkgs }
2270     grep { $_->unsuspended_pkgs }
2271       $self->referral_cust_main($depth);
2272 }
2273
2274 =item credit AMOUNT, REASON
2275
2276 Applies a credit to this customer.  If there is an error, returns the error,
2277 otherwise returns false.
2278
2279 =cut
2280
2281 sub credit {
2282   my( $self, $amount, $reason ) = @_;
2283   my $cust_credit = new FS::cust_credit {
2284     'custnum' => $self->custnum,
2285     'amount'  => $amount,
2286     'reason'  => $reason,
2287   };
2288   $cust_credit->insert;
2289 }
2290
2291 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2292
2293 Creates a one-time charge for this customer.  If there is an error, returns
2294 the error, otherwise returns false.
2295
2296 =cut
2297
2298 sub charge {
2299   my ( $self, $amount ) = ( shift, shift );
2300   my $pkg      = @_ ? shift : 'One-time charge';
2301   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2302   my $taxclass = @_ ? shift : '';
2303
2304   local $SIG{HUP} = 'IGNORE';
2305   local $SIG{INT} = 'IGNORE';
2306   local $SIG{QUIT} = 'IGNORE';
2307   local $SIG{TERM} = 'IGNORE';
2308   local $SIG{TSTP} = 'IGNORE';
2309   local $SIG{PIPE} = 'IGNORE';
2310
2311   my $oldAutoCommit = $FS::UID::AutoCommit;
2312   local $FS::UID::AutoCommit = 0;
2313   my $dbh = dbh;
2314
2315   my $part_pkg = new FS::part_pkg ( {
2316     'pkg'      => $pkg,
2317     'comment'  => $comment,
2318     'setup'    => $amount,
2319     'freq'     => 0,
2320     'recur'    => '0',
2321     'disabled' => 'Y',
2322     'taxclass' => $taxclass,
2323   } );
2324
2325   my $error = $part_pkg->insert;
2326   if ( $error ) {
2327     $dbh->rollback if $oldAutoCommit;
2328     return $error;
2329   }
2330
2331   my $pkgpart = $part_pkg->pkgpart;
2332   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2333   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2334     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2335     $error = $type_pkgs->insert;
2336     if ( $error ) {
2337       $dbh->rollback if $oldAutoCommit;
2338       return $error;
2339     }
2340   }
2341
2342   my $cust_pkg = new FS::cust_pkg ( {
2343     'custnum' => $self->custnum,
2344     'pkgpart' => $pkgpart,
2345   } );
2346
2347   $error = $cust_pkg->insert;
2348   if ( $error ) {
2349     $dbh->rollback if $oldAutoCommit;
2350     return $error;
2351   }
2352
2353   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2354   '';
2355
2356 }
2357
2358 =item cust_bill
2359
2360 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2361
2362 =cut
2363
2364 sub cust_bill {
2365   my $self = shift;
2366   sort { $a->_date <=> $b->_date }
2367     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2368 }
2369
2370 =item open_cust_bill
2371
2372 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2373 customer.
2374
2375 =cut
2376
2377 sub open_cust_bill {
2378   my $self = shift;
2379   grep { $_->owed > 0 } $self->cust_bill;
2380 }
2381
2382 =item cust_credit
2383
2384 Returns all the credits (see L<FS::cust_credit>) for this customer.
2385
2386 =cut
2387
2388 sub cust_credit {
2389   my $self = shift;
2390   sort { $a->_date <=> $b->_date }
2391     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2392 }
2393
2394 =item cust_pay
2395
2396 Returns all the payments (see L<FS::cust_pay>) for this customer.
2397
2398 =cut
2399
2400 sub cust_pay {
2401   my $self = shift;
2402   sort { $a->_date <=> $b->_date }
2403     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2404 }
2405
2406 =item cust_refund
2407
2408 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2409
2410 =cut
2411
2412 sub cust_refund {
2413   my $self = shift;
2414   sort { $a->_date <=> $b->_date }
2415     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2416 }
2417
2418 =back
2419
2420 =head1 SUBROUTINES
2421
2422 =over 4
2423
2424 =item check_and_rebuild_fuzzyfiles
2425
2426 =cut
2427
2428 sub check_and_rebuild_fuzzyfiles {
2429   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2430   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2431     or &rebuild_fuzzyfiles;
2432 }
2433
2434 =item rebuild_fuzzyfiles
2435
2436 =cut
2437
2438 sub rebuild_fuzzyfiles {
2439
2440   use Fcntl qw(:flock);
2441
2442   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2443
2444   #last
2445
2446   open(LASTLOCK,">>$dir/cust_main.last")
2447     or die "can't open $dir/cust_main.last: $!";
2448   flock(LASTLOCK,LOCK_EX)
2449     or die "can't lock $dir/cust_main.last: $!";
2450
2451   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2452   push @all_last,
2453                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2454     if defined dbdef->table('cust_main')->column('ship_last');
2455
2456   open (LASTCACHE,">$dir/cust_main.last.tmp")
2457     or die "can't open $dir/cust_main.last.tmp: $!";
2458   print LASTCACHE join("\n", @all_last), "\n";
2459   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2460
2461   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2462   close LASTLOCK;
2463
2464   #company
2465
2466   open(COMPANYLOCK,">>$dir/cust_main.company")
2467     or die "can't open $dir/cust_main.company: $!";
2468   flock(COMPANYLOCK,LOCK_EX)
2469     or die "can't lock $dir/cust_main.company: $!";
2470
2471   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2472   push @all_company,
2473        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2474     if defined dbdef->table('cust_main')->column('ship_last');
2475
2476   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2477     or die "can't open $dir/cust_main.company.tmp: $!";
2478   print COMPANYCACHE join("\n", @all_company), "\n";
2479   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2480
2481   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2482   close COMPANYLOCK;
2483
2484 }
2485
2486 =item all_last
2487
2488 =cut
2489
2490 sub all_last {
2491   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2492   open(LASTCACHE,"<$dir/cust_main.last")
2493     or die "can't open $dir/cust_main.last: $!";
2494   my @array = map { chomp; $_; } <LASTCACHE>;
2495   close LASTCACHE;
2496   \@array;
2497 }
2498
2499 =item all_company
2500
2501 =cut
2502
2503 sub all_company {
2504   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2505   open(COMPANYCACHE,"<$dir/cust_main.company")
2506     or die "can't open $dir/cust_main.last: $!";
2507   my @array = map { chomp; $_; } <COMPANYCACHE>;
2508   close COMPANYCACHE;
2509   \@array;
2510 }
2511
2512 =item append_fuzzyfiles LASTNAME COMPANY
2513
2514 =cut
2515
2516 sub append_fuzzyfiles {
2517   my( $last, $company ) = @_;
2518
2519   &check_and_rebuild_fuzzyfiles;
2520
2521   use Fcntl qw(:flock);
2522
2523   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2524
2525   if ( $last ) {
2526
2527     open(LAST,">>$dir/cust_main.last")
2528       or die "can't open $dir/cust_main.last: $!";
2529     flock(LAST,LOCK_EX)
2530       or die "can't lock $dir/cust_main.last: $!";
2531
2532     print LAST "$last\n";
2533
2534     flock(LAST,LOCK_UN)
2535       or die "can't unlock $dir/cust_main.last: $!";
2536     close LAST;
2537   }
2538
2539   if ( $company ) {
2540
2541     open(COMPANY,">>$dir/cust_main.company")
2542       or die "can't open $dir/cust_main.company: $!";
2543     flock(COMPANY,LOCK_EX)
2544       or die "can't lock $dir/cust_main.company: $!";
2545
2546     print COMPANY "$company\n";
2547
2548     flock(COMPANY,LOCK_UN)
2549       or die "can't unlock $dir/cust_main.company: $!";
2550
2551     close COMPANY;
2552   }
2553
2554   1;
2555 }
2556
2557 =item batch_import
2558
2559 =cut
2560
2561 sub batch_import {
2562   my $param = shift;
2563   #warn join('-',keys %$param);
2564   my $fh = $param->{filehandle};
2565   my $agentnum = $param->{agentnum};
2566   my $refnum = $param->{refnum};
2567   my $pkgpart = $param->{pkgpart};
2568   my @fields = @{$param->{fields}};
2569
2570   eval "use Date::Parse;";
2571   die $@ if $@;
2572   eval "use Text::CSV_XS;";
2573   die $@ if $@;
2574
2575   my $csv = new Text::CSV_XS;
2576   #warn $csv;
2577   #warn $fh;
2578
2579   my $imported = 0;
2580   #my $columns;
2581
2582   local $SIG{HUP} = 'IGNORE';
2583   local $SIG{INT} = 'IGNORE';
2584   local $SIG{QUIT} = 'IGNORE';
2585   local $SIG{TERM} = 'IGNORE';
2586   local $SIG{TSTP} = 'IGNORE';
2587   local $SIG{PIPE} = 'IGNORE';
2588
2589   my $oldAutoCommit = $FS::UID::AutoCommit;
2590   local $FS::UID::AutoCommit = 0;
2591   my $dbh = dbh;
2592
2593   #while ( $columns = $csv->getline($fh) ) {
2594   my $line;
2595   while ( defined($line=<$fh>) ) {
2596
2597     $csv->parse($line) or do {
2598       $dbh->rollback if $oldAutoCommit;
2599       return "can't parse: ". $csv->error_input();
2600     };
2601
2602     my @columns = $csv->fields();
2603     #warn join('-',@columns);
2604
2605     my %cust_main = (
2606       agentnum => $agentnum,
2607       refnum   => $refnum,
2608       country  => 'US', #default
2609       payby    => 'BILL', #default
2610       paydate  => '12/2037', #default
2611     );
2612     my $billtime = time;
2613     my %cust_pkg = ( pkgpart => $pkgpart );
2614     foreach my $field ( @fields ) {
2615       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2616         #$cust_pkg{$1} = str2time( shift @$columns );
2617         if ( $1 eq 'setup' ) {
2618           $billtime = str2time(shift @columns);
2619         } else {
2620           $cust_pkg{$1} = str2time( shift @columns );
2621         }
2622       } else {
2623         #$cust_main{$field} = shift @$columns;
2624         $cust_main{$field} = shift @columns;
2625       }
2626     }
2627
2628     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2629     my $cust_main = new FS::cust_main ( \%cust_main );
2630     use Tie::RefHash;
2631     tie my %hash, 'Tie::RefHash'; #this part is important
2632     $hash{$cust_pkg} = [] if $pkgpart;
2633     my $error = $cust_main->insert( \%hash );
2634
2635     if ( $error ) {
2636       $dbh->rollback if $oldAutoCommit;
2637       return "can't insert customer for $line: $error";
2638     }
2639
2640     #false laziness w/bill.cgi
2641     $error = $cust_main->bill( 'time' => $billtime );
2642     if ( $error ) {
2643       $dbh->rollback if $oldAutoCommit;
2644       return "can't bill customer for $line: $error";
2645     }
2646
2647     $cust_main->apply_payments;
2648     $cust_main->apply_credits;
2649
2650     $error = $cust_main->collect();
2651     if ( $error ) {
2652       $dbh->rollback if $oldAutoCommit;
2653       return "can't collect customer for $line: $error";
2654     }
2655
2656     $imported++;
2657   }
2658
2659   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2660
2661   return "Empty file!" unless $imported;
2662
2663   ''; #no error
2664
2665 }
2666
2667 =item batch_charge
2668
2669 =cut
2670
2671 sub batch_charge {
2672   my $param = shift;
2673   #warn join('-',keys %$param);
2674   my $fh = $param->{filehandle};
2675   my @fields = @{$param->{fields}};
2676
2677   eval "use Date::Parse;";
2678   die $@ if $@;
2679   eval "use Text::CSV_XS;";
2680   die $@ if $@;
2681
2682   my $csv = new Text::CSV_XS;
2683   #warn $csv;
2684   #warn $fh;
2685
2686   my $imported = 0;
2687   #my $columns;
2688
2689   local $SIG{HUP} = 'IGNORE';
2690   local $SIG{INT} = 'IGNORE';
2691   local $SIG{QUIT} = 'IGNORE';
2692   local $SIG{TERM} = 'IGNORE';
2693   local $SIG{TSTP} = 'IGNORE';
2694   local $SIG{PIPE} = 'IGNORE';
2695
2696   my $oldAutoCommit = $FS::UID::AutoCommit;
2697   local $FS::UID::AutoCommit = 0;
2698   my $dbh = dbh;
2699
2700   #while ( $columns = $csv->getline($fh) ) {
2701   my $line;
2702   while ( defined($line=<$fh>) ) {
2703
2704     $csv->parse($line) or do {
2705       $dbh->rollback if $oldAutoCommit;
2706       return "can't parse: ". $csv->error_input();
2707     };
2708
2709     my @columns = $csv->fields();
2710     #warn join('-',@columns);
2711
2712     my %row = ();
2713     foreach my $field ( @fields ) {
2714       $row{$field} = shift @columns;
2715     }
2716
2717     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2718     unless ( $cust_main ) {
2719       $dbh->rollback if $oldAutoCommit;
2720       return "unknown custnum $row{'custnum'}";
2721     }
2722
2723     if ( $row{'amount'} > 0 ) {
2724       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2725       if ( $error ) {
2726         $dbh->rollback if $oldAutoCommit;
2727         return $error;
2728       }
2729       $imported++;
2730     } elsif ( $row{'amount'} < 0 ) {
2731       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2732                                       $row{'pkg'}                         );
2733       if ( $error ) {
2734         $dbh->rollback if $oldAutoCommit;
2735         return $error;
2736       }
2737       $imported++;
2738     } else {
2739       #hmm?
2740     }
2741
2742   }
2743
2744   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2745
2746   return "Empty file!" unless $imported;
2747
2748   ''; #no error
2749
2750 }
2751
2752 =back
2753
2754 =head1 BUGS
2755
2756 The delete method.
2757
2758 The delete method should possibly take an FS::cust_main object reference
2759 instead of a scalar customer number.
2760
2761 Bill and collect options should probably be passed as references instead of a
2762 list.
2763
2764 There should probably be a configuration file with a list of allowed credit
2765 card types.
2766
2767 No multiple currency support (probably a larger project than just this module).
2768
2769 =head1 SEE ALSO
2770
2771 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2772 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2773 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2774
2775 =cut
2776
2777 1;
2778