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