FS/FS/cust_main.pm

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