FS/FS/cust_main.pm

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