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