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