FS/FS/cust_main.pm

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