FS/FS/cust_main.pm

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