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