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