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