FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
   5              $smtpmachine $Debug $bop_processor $bop_login $bop_password
   6              $bop_action @bop_options);
   7 use Safe;
   8 use Carp;
   9 use Time::Local;
  10 use Date::Format;
  11 #use Date::Manip;
  12 use Mail::Internet;
  13 use Mail::Header;
  14 use Business::CreditCard;
  15 use FS::UID qw( getotaker dbh );
  16 use FS::Record qw( qsearchs qsearch dbdef );
  17 use FS::cust_pkg;
  18 use FS::cust_bill;
  19 use FS::cust_bill_pkg;
  20 use FS::cust_pay;
  21 use FS::cust_credit;
  22 use FS::cust_pay_batch;
  23 use FS::part_referral;
  24 use FS::cust_main_county;
  25 use FS::agent;
  26 use FS::cust_main_invoice;
  27 use FS::cust_credit_bill;
  28 use FS::cust_bill_pay;
  29 use FS::prepay_credit;
  30 use FS::queue;
  31
  32 @ISA = qw( FS::Record );
  33
  34 $Debug = 0;
  35 #$Debug = 1;
  36
  37 #ask FS::UID to run this stuff for us later
  38 $FS::UID::callback{'FS::cust_main'} = sub {
  39   $conf = new FS::Conf;
  40   $lpr = $conf->config('lpr');
  41   $invoice_from = $conf->config('invoice_from');
  42   $smtpmachine = $conf->config('smtpmachine');
  43
  44   if ( $conf->exists('cybercash3.2') ) {
  45     require CCMckLib3_2;
  46       #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
  47     require CCMckDirectLib3_2;
  48       #qw(SendCC2_1Server);
  49     require CCMckErrno3_2;
  50       #qw(MCKGetErrorMessage $E_NoErr);
  51     import CCMckErrno3_2 qw($E_NoErr);
  52
  53     my $merchant_conf;
  54     ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
  55     my $status = &CCMckLib3_2::InitConfig($merchant_conf);
  56     if ( $status != $E_NoErr ) {
  57       warn "CCMckLib3_2::InitConfig error:\n";
  58       foreach my $key (keys %CCMckLib3_2::Config) {
  59         warn "  $key => $CCMckLib3_2::Config{$key}\n"
  60       }
  61       my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
  62       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
  63     }
  64     $processor='cybercash3.2';
  65   } elsif ( $conf->exists('business-onlinepayment') ) {
  66     ( $bop_processor,
  67       $bop_login,
  68       $bop_password,
  69       $bop_action,
  70       @bop_options
  71     ) = $conf->config('business-onlinepayment');
  72     $bop_action ||= 'normal authorization';
  73     eval "use Business::OnlinePayment";
  74     $processor="Business::OnlinePayment::$bop_processor";
  75   }
  76 };
  77
  78 =head1 NAME
  79
  80 FS::cust_main - Object methods for cust_main records
  81
  82 =head1 SYNOPSIS
  83
  84   use FS::cust_main;
  85
  86   $record = new FS::cust_main \%hash;
  87   $record = new FS::cust_main { 'column' => 'value' };
  88
  89   $error = $record->insert;
  90
  91   $error = $new_record->replace($old_record);
  92
  93   $error = $record->delete;
  94
  95   $error = $record->check;
  96
  97   @cust_pkg = $record->all_pkgs;
  98
  99   @cust_pkg = $record->ncancelled_pkgs;
 100
 101   $error = $record->bill;
 102   $error = $record->bill %options;
 103   $error = $record->bill 'time' => $time;
 104
 105   $error = $record->collect;
 106   $error = $record->collect %options;
 107   $error = $record->collect 'invoice_time'   => $time,
 108                             'batch_card'     => 'yes',
 109                             'report_badcard' => 'yes',
 110                           ;
 111
 112 =head1 DESCRIPTION
 113
 114 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 115 FS::Record.  The following fields are currently supported:
 116
 117 =over 4
 118
 119 =item custnum - primary key (assigned automatically for new customers)
 120
 121 =item agentnum - agent (see L<FS::agent>)
 122
 123 =item refnum - referral (see L<FS::part_referral>)
 124
 125 =item first - name
 126
 127 =item last - name
 128
 129 =item ss - social security number (optional)
 130
 131 =item company - (optional)
 132
 133 =item address1
 134
 135 =item address2 - (optional)
 136
 137 =item city
 138
 139 =item county - (optional, see L<FS::cust_main_county>)
 140
 141 =item state - (see L<FS::cust_main_county>)
 142
 143 =item zip
 144
 145 =item country - (see L<FS::cust_main_county>)
 146
 147 =item daytime - phone (optional)
 148
 149 =item night - phone (optional)
 150
 151 =item fax - phone (optional)
 152
 153 =item ship_first - name
 154
 155 =item ship_last - name
 156
 157 =item ship_company - (optional)
 158
 159 =item ship_address1
 160
 161 =item ship_address2 - (optional)
 162
 163 =item ship_city
 164
 165 =item ship_county - (optional, see L<FS::cust_main_county>)
 166
 167 =item ship_state - (see L<FS::cust_main_county>)
 168
 169 =item ship_zip
 170
 171 =item ship_country - (see L<FS::cust_main_county>)
 172
 173 =item ship_daytime - phone (optional)
 174
 175 =item ship_night - phone (optional)
 176
 177 =item ship_fax - phone (optional)
 178
 179 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 180
 181 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 182
 183 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 184
 185 =item payname - name on card or billing name
 186
 187 =item tax - tax exempt, empty or `Y'
 188
 189 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 190
 191 =item comments - comments (optional)
 192
 193 =back
 194
 195 =head1 METHODS
 196
 197 =over 4
 198
 199 =item new HASHREF
 200
 201 Creates a new customer.  To add the customer to the database, see L<"insert">.
 202
 203 Note that this stores the hash reference, not a distinct copy of the hash it
 204 points to.  You can ask the object for a copy with the I<hash> method.
 205
 206 =cut
 207
 208 sub table { 'cust_main'; }
 209
 210 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
 211
 212 Adds this customer to the database.  If there is an error, returns the error,
 213 otherwise returns false.
 214
 215 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 216 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 217 are inserted atomicly, or the transaction is rolled back (this requries a
 218 transactional database).  Passing an empty hash reference is equivalent to
 219 not supplying this parameter.  There should be a better explanation of this,
 220 but until then, here's an example:
 221
 222   use Tie::RefHash;
 223   tie %hash, 'Tie::RefHash'; #this part is important
 224   %hash = (
 225     $cust_pkg => [ $svc_acct ],
 226     ...
 227   );
 228   $cust_main->insert( \%hash );
 229
 230 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 231 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 232 expected and rollback the entire transaction; it is not necessary to call
 233 check_invoicing_list first.  The invoicing_list is set after the records in the
 234 CUST_PKG_HASHREF above are inserted, so it is now possible set set an
 235 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 236
 237   $cust_main->insert( {}, [ $email, 'POST' ] );
 238
 239 =cut
 240
 241 sub insert {
 242   my $self = shift;
 243   my @param = @_;
 244
 245   local $SIG{HUP} = 'IGNORE';
 246   local $SIG{INT} = 'IGNORE';
 247   local $SIG{QUIT} = 'IGNORE';
 248   local $SIG{TERM} = 'IGNORE';
 249   local $SIG{TSTP} = 'IGNORE';
 250   local $SIG{PIPE} = 'IGNORE';
 251
 252   my $oldAutoCommit = $FS::UID::AutoCommit;
 253   local $FS::UID::AutoCommit = 0;
 254   my $dbh = dbh;
 255
 256   my $amount = 0;
 257   my $seconds = 0;
 258   if ( $self->payby eq 'PREPAY' ) {
 259     $self->payby('BILL');
 260     my $prepay_credit = qsearchs(
 261       'prepay_credit',
 262       { 'identifier' => $self->payinfo },
 263       '',
 264       'FOR UPDATE'
 265     );
 266     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 267       unless $prepay_credit;
 268     $amount = $prepay_credit->amount;
 269     $seconds = $prepay_credit->seconds;
 270     my $error = $prepay_credit->delete;
 271     if ( $error ) {
 272       $dbh->rollback if $oldAutoCommit;
 273       return "removing prepay_credit (transaction rolled back): $error";
 274     }
 275   }
 276
 277   my $error = $self->SUPER::insert;
 278   if ( $error ) {
 279     $dbh->rollback if $oldAutoCommit;
 280     return "inserting cust_main record (transaction rolled back): $error";
 281   }
 282
 283   if ( @param ) { # CUST_PKG_HASHREF
 284     my $cust_pkgs = shift @param;
 285     foreach my $cust_pkg ( keys %$cust_pkgs ) {
 286       $cust_pkg->custnum( $self->custnum );
 287       $error = $cust_pkg->insert;
 288       if ( $error ) {
 289         $dbh->rollback if $oldAutoCommit;
 290         return "inserting cust_pkg (transaction rolled back): $error";
 291       }
 292       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 293         $svc_something->pkgnum( $cust_pkg->pkgnum );
 294         if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 295           $svc_something->seconds( $svc_something->seconds + $seconds );
 296           $seconds = 0;
 297         }
 298         $error = $svc_something->insert;
 299         if ( $error ) {
 300           $dbh->rollback if $oldAutoCommit;
 301           return "inserting svc_ (transaction rolled back): $error";
 302         }
 303       }
 304     }
 305   }
 306
 307   if ( $seconds ) {
 308     $dbh->rollback if $oldAutoCommit;
 309     return "No svc_acct record to apply pre-paid time";
 310   }
 311
 312   if ( @param ) { # INVOICING_LIST_ARYREF
 313     my $invoicing_list = shift @param;
 314     $error = $self->check_invoicing_list( $invoicing_list );
 315     if ( $error ) {
 316       $dbh->rollback if $oldAutoCommit;
 317       return "checking invoicing_list (transaction rolled back): $error";
 318     }
 319     $self->invoicing_list( $invoicing_list );
 320   }
 321
 322   if ( $amount ) {
 323     my $cust_credit = new FS::cust_credit {
 324       'custnum' => $self->custnum,
 325       'amount'  => $amount,
 326     };
 327     $error = $cust_credit->insert;
 328     if ( $error ) {
 329       $dbh->rollback if $oldAutoCommit;
 330       return "inserting credit (transaction rolled back): $error";
 331     }
 332   }
 333
 334   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 335   $error = $queue->insert($self->getfield('last'), $self->company);
 336   if ( $error ) {
 337     $dbh->rollback if $oldAutoCommit;
 338     return "queueing job (transaction rolled back): $error";
 339   }
 340
 341   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 342     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 343     $error = $queue->insert($self->getfield('last'), $self->company);
 344     if ( $error ) {
 345       $dbh->rollback if $oldAutoCommit;
 346       return "queueing job (transaction rolled back): $error";
 347     }
 348   }
 349
 350   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 351   '';
 352
 353 }
 354
 355 =item delete NEW_CUSTNUM
 356
 357 This deletes the customer.  If there is an error, returns the error, otherwise
 358 returns false.
 359
 360 This will completely remove all traces of the customer record.  This is not
 361 what you want when a customer cancels service; for that, cancel all of the
 362 customer's packages (see L<FS::cust_pkg/cancel>).
 363
 364 If the customer has any packages, you need to pass a new (valid) customer
 365 number for those packages to be transferred to.
 366
 367 You can't delete a customer with invoices (see L<FS::cust_bill>),
 368 or credits (see L<FS::cust_credit>).
 369
 370 =cut
 371
 372 sub delete {
 373   my $self = shift;
 374
 375   local $SIG{HUP} = 'IGNORE';
 376   local $SIG{INT} = 'IGNORE';
 377   local $SIG{QUIT} = 'IGNORE';
 378   local $SIG{TERM} = 'IGNORE';
 379   local $SIG{TSTP} = 'IGNORE';
 380   local $SIG{PIPE} = 'IGNORE';
 381
 382   my $oldAutoCommit = $FS::UID::AutoCommit;
 383   local $FS::UID::AutoCommit = 0;
 384   my $dbh = dbh;
 385
 386   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 387     $dbh->rollback if $oldAutoCommit;
 388     return "Can't delete a customer with invoices";
 389   }
 390   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 391     $dbh->rollback if $oldAutoCommit;
 392     return "Can't delete a customer with credits";
 393   }
 394
 395   my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
 396   if ( @cust_pkg ) {
 397     my $new_custnum = shift;
 398     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 399       $dbh->rollback if $oldAutoCommit;
 400       return "Invalid new customer number: $new_custnum";
 401     }
 402     foreach my $cust_pkg ( @cust_pkg ) {
 403       my %hash = $cust_pkg->hash;
 404       $hash{'custnum'} = $new_custnum;
 405       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 406       my $error = $new_cust_pkg->replace($cust_pkg);
 407       if ( $error ) {
 408         $dbh->rollback if $oldAutoCommit;
 409         return $error;
 410       }
 411     }
 412   }
 413   foreach my $cust_main_invoice (
 414     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 415   ) {
 416     my $error = $cust_main_invoice->delete;
 417     if ( $error ) {
 418       $dbh->rollback if $oldAutoCommit;
 419       return $error;
 420     }
 421   }
 422
 423   my $error = $self->SUPER::delete;
 424   if ( $error ) {
 425     $dbh->rollback if $oldAutoCommit;
 426     return $error;
 427   }
 428
 429   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 430   '';
 431
 432 }
 433
 434 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 435
 436 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 437 returns the error, otherwise returns false.
 438
 439 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 440 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 441 expected and rollback the entire transaction; it is not necessary to call
 442 check_invoicing_list first.  Here's an example:
 443
 444   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 445
 446 =cut
 447
 448 sub replace {
 449   my $self = shift;
 450   my $old = shift;
 451   my @param = @_;
 452
 453   local $SIG{HUP} = 'IGNORE';
 454   local $SIG{INT} = 'IGNORE';
 455   local $SIG{QUIT} = 'IGNORE';
 456   local $SIG{TERM} = 'IGNORE';
 457   local $SIG{TSTP} = 'IGNORE';
 458   local $SIG{PIPE} = 'IGNORE';
 459
 460   my $oldAutoCommit = $FS::UID::AutoCommit;
 461   local $FS::UID::AutoCommit = 0;
 462   my $dbh = dbh;
 463
 464   my $error = $self->SUPER::replace($old);
 465
 466   if ( $error ) {
 467     $dbh->rollback if $oldAutoCommit;
 468     return $error;
 469   }
 470
 471   if ( @param ) { # INVOICING_LIST_ARYREF
 472     my $invoicing_list = shift @param;
 473     $error = $self->check_invoicing_list( $invoicing_list );
 474     if ( $error ) {
 475       $dbh->rollback if $oldAutoCommit;
 476       return $error;
 477     }
 478     $self->invoicing_list( $invoicing_list );
 479   }
 480
 481   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 482   '';
 483
 484 }
 485
 486 =item check
 487
 488 Checks all fields to make sure this is a valid customer record.  If there is
 489 an error, returns the error, otherwise returns false.  Called by the insert
 490 and repalce methods.
 491
 492 =cut
 493
 494 sub check {
 495   my $self = shift;
 496
 497   my $error =
 498     $self->ut_numbern('custnum')
 499     || $self->ut_number('agentnum')
 500     || $self->ut_number('refnum')
 501     || $self->ut_name('last')
 502     || $self->ut_name('first')
 503     || $self->ut_textn('company')
 504     || $self->ut_text('address1')
 505     || $self->ut_textn('address2')
 506     || $self->ut_text('city')
 507     || $self->ut_textn('county')
 508     || $self->ut_textn('state')
 509     || $self->ut_country('country')
 510     || $self->ut_anything('comments')
 511     || $self->ut_numbern('referral_custnum')
 512   ;
 513   #barf.  need message catalogs.  i18n.  etc.
 514   $error .= "Please select a referral."
 515     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 516   return $error if $error;
 517
 518   return "Unknown agent"
 519     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 520
 521   return "Unknown referral"
 522     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 523
 524   return "Unknown referring custnum ". $self->referral_custnum
 525     unless ! $self->referral_custnum
 526            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 527
 528   if ( $self->ss eq '' ) {
 529     $self->ss('');
 530   } else {
 531     my $ss = $self->ss;
 532     $ss =~ s/\D//g;
 533     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 534       or return "Illegal social security number: ". $self->ss;
 535     $self->ss("$1-$2-$3");
 536   }
 537
 538   unless ( qsearchs('cust_main_county', {
 539     'country' => $self->country,
 540     'state'   => '',
 541    } ) ) {
 542     return "Unknown state/county/country: ".
 543       $self->state. "/". $self->county. "/". $self->country
 544       unless qsearchs('cust_main_county',{
 545         'state'   => $self->state,
 546         'county'  => $self->county,
 547         'country' => $self->country,
 548       } );
 549   }
 550
 551   $error =
 552     $self->ut_phonen('daytime', $self->country)
 553     || $self->ut_phonen('night', $self->country)
 554     || $self->ut_phonen('fax', $self->country)
 555     || $self->ut_zip('zip', $self->country)
 556   ;
 557   return $error if $error;
 558
 559   my @addfields = qw(
 560     last first company address1 address2 city county state zip
 561     country daytime night fax
 562   );
 563
 564   if ( defined $self->dbdef_table->column('ship_last') ) {
 565     if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
 566          && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
 567        )
 568     {
 569       my $error =
 570         $self->ut_name('ship_last')
 571         || $self->ut_name('ship_first')
 572         || $self->ut_textn('ship_company')
 573         || $self->ut_text('ship_address1')
 574         || $self->ut_textn('ship_address2')
 575         || $self->ut_text('ship_city')
 576         || $self->ut_textn('ship_county')
 577         || $self->ut_textn('ship_state')
 578         || $self->ut_country('ship_country')
 579       ;
 580       return $error if $error;
 581
 582       #false laziness with above
 583       unless ( qsearchs('cust_main_county', {
 584         'country' => $self->ship_country,
 585         'state'   => '',
 586        } ) ) {
 587         return "Unknown ship_state/ship_county/ship_country: ".
 588           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 589           unless qsearchs('cust_main_county',{
 590             'state'   => $self->ship_state,
 591             'county'  => $self->ship_county,
 592             'country' => $self->ship_country,
 593           } );
 594       }
 595       #eofalse
 596
 597       $error =
 598         $self->ut_phonen('ship_daytime', $self->ship_country)
 599         || $self->ut_phonen('ship_night', $self->ship_country)
 600         || $self->ut_phonen('ship_fax', $self->ship_country)
 601         || $self->ut_zip('ship_zip', $self->ship_country)
 602       ;
 603       return $error if $error;
 604
 605     } else { # ship_ info eq billing info, so don't store dup info in database
 606       $self->setfield("ship_$_", '')
 607         foreach qw( last first company address1 address2 city county state zip
 608                     country daytime night fax );
 609     }
 610   }
 611
 612   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
 613     or return "Illegal payby: ". $self->payby;
 614   $self->payby($1);
 615
 616   if ( $self->payby eq 'CARD' ) {
 617
 618     my $payinfo = $self->payinfo;
 619     $payinfo =~ s/\D//g;
 620     $payinfo =~ /^(\d{13,16})$/
 621       or return "Illegal credit card number: ". $self->payinfo;
 622     $payinfo = $1;
 623     $self->payinfo($payinfo);
 624     validate($payinfo)
 625       or return "Illegal credit card number: ". $self->payinfo;
 626     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 627
 628   } elsif ( $self->payby eq 'BILL' ) {
 629
 630     $error = $self->ut_textn('payinfo');
 631     return "Illegal P.O. number: ". $self->payinfo if $error;
 632
 633   } elsif ( $self->payby eq 'COMP' ) {
 634
 635     $error = $self->ut_textn('payinfo');
 636     return "Illegal comp account issuer: ". $self->payinfo if $error;
 637
 638   } elsif ( $self->payby eq 'PREPAY' ) {
 639
 640     my $payinfo = $self->payinfo;
 641     $payinfo =~ s/\W//g; #anything else would just confuse things
 642     $self->payinfo($payinfo);
 643     $error = $self->ut_alpha('payinfo');
 644     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 645     return "Unknown prepayment identifier"
 646       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 647
 648   }
 649
 650   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 651     return "Expriation date required"
 652       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
 653     $self->paydate('');
 654   } else {
 655     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 656       or return "Illegal expiration date: ". $self->paydate;
 657     if ( length($2) == 4 ) {
 658       $self->paydate("$2-$1-01");
 659     } else {
 660       $self->paydate("20$2-$1-01");
 661     }
 662   }
 663
 664   if ( $self->payname eq '' ) {
 665     $self->payname( $self->first. " ". $self->getfield('last') );
 666   } else {
 667     $self->payname =~ /^([\w \,\.\-\']+)$/
 668       or return "Illegal billing name: ". $self->payname;
 669     $self->payname($1);
 670   }
 671
 672   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 673   $self->tax($1);
 674
 675   $self->otaker(getotaker);
 676
 677   ''; #no error
 678 }
 679
 680 =item all_pkgs
 681
 682 Returns all packages (see L<FS::cust_pkg>) for this customer.
 683
 684 =cut
 685
 686 sub all_pkgs {
 687   my $self = shift;
 688   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 689 }
 690
 691 =item ncancelled_pkgs
 692
 693 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 694
 695 =cut
 696
 697 sub ncancelled_pkgs {
 698   my $self = shift;
 699   @{ [ # force list context
 700     qsearch( 'cust_pkg', {
 701       'custnum' => $self->custnum,
 702       'cancel'  => '',
 703     }),
 704     qsearch( 'cust_pkg', {
 705       'custnum' => $self->custnum,
 706       'cancel'  => 0,
 707     }),
 708   ] };
 709 }
 710
 711 =item bill OPTIONS
 712
 713 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 714 conjunction with the collect method.
 715
 716 Options are passed as name-value pairs.
 717
 718 The only currently available option is `time', which bills the customer as if
 719 it were that time.  It is specified as a UNIX timestamp; see
 720 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 721 functions.  For example:
 722
 723  use Date::Parse;
 724  ...
 725  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 726
 727 If there is an error, returns the error, otherwise returns false.
 728
 729 =cut
 730
 731 sub bill {
 732   my( $self, %options ) = @_;
 733   my $time = $options{'time'} || time;
 734
 735   my $error;
 736
 737   #put below somehow?
 738   local $SIG{HUP} = 'IGNORE';
 739   local $SIG{INT} = 'IGNORE';
 740   local $SIG{QUIT} = 'IGNORE';
 741   local $SIG{TERM} = 'IGNORE';
 742   local $SIG{TSTP} = 'IGNORE';
 743   local $SIG{PIPE} = 'IGNORE';
 744
 745   my $oldAutoCommit = $FS::UID::AutoCommit;
 746   local $FS::UID::AutoCommit = 0;
 747   my $dbh = dbh;
 748
 749   # find the packages which are due for billing, find out how much they are
 750   # & generate invoice database.
 751
 752   my( $total_setup, $total_recur ) = ( 0, 0 );
 753   my @cust_bill_pkg = ();
 754
 755   foreach my $cust_pkg (
 756     qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
 757   ) {
 758
 759     next if $cust_pkg->getfield('cancel');
 760
 761     #? to avoid use of uninitialized value errors... ?
 762     $cust_pkg->setfield('bill', '')
 763       unless defined($cust_pkg->bill);
 764
 765     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 766
 767     #so we don't modify cust_pkg record unnecessarily
 768     my $cust_pkg_mod_flag = 0;
 769     my %hash = $cust_pkg->hash;
 770     my $old_cust_pkg = new FS::cust_pkg \%hash;
 771
 772     # bill setup
 773     my $setup = 0;
 774     unless ( $cust_pkg->setup ) {
 775       my $setup_prog = $part_pkg->getfield('setup');
 776       $setup_prog =~ /^(.*)$/ or do {
 777         $dbh->rollback if $oldAutoCommit;
 778         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 779                ": $setup_prog";
 780       };
 781       $setup_prog = $1;
 782
 783       my $cpt = new Safe;
 784       #$cpt->permit(); #what is necessary?
 785       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 786       $setup = $cpt->reval($setup_prog);
 787       unless ( defined($setup) ) {
 788         $dbh->rollback if $oldAutoCommit;
 789         return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 790                ": $@";
 791       }
 792       $cust_pkg->setfield('setup',$time);
 793       $cust_pkg_mod_flag=1;
 794     }
 795
 796     #bill recurring fee
 797     my $recur = 0;
 798     my $sdate;
 799     if ( $part_pkg->getfield('freq') > 0 &&
 800          ! $cust_pkg->getfield('susp') &&
 801          ( $cust_pkg->getfield('bill') || 0 ) < $time
 802     ) {
 803       my $recur_prog = $part_pkg->getfield('recur');
 804       $recur_prog =~ /^(.*)$/ or do {
 805         $dbh->rollback if $oldAutoCommit;
 806         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
 807                ": $recur_prog";
 808       };
 809       $recur_prog = $1;
 810
 811       my $cpt = new Safe;
 812       #$cpt->permit(); #what is necessary?
 813       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 814       $recur = $cpt->reval($recur_prog);
 815       unless ( defined($recur) ) {
 816         $dbh->rollback if $oldAutoCommit;
 817         return "Error reval-ing part_pkg->recur pkgpart ".
 818                $part_pkg->pkgpart. ": $@";
 819       }
 820       #change this bit to use Date::Manip? CAREFUL with timezones (see
 821       # mailing list archive)
 822       #$sdate=$cust_pkg->bill || time;
 823       #$sdate=$cust_pkg->bill || $time;
 824       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 825       my ($sec,$min,$hour,$mday,$mon,$year) =
 826         (localtime($sdate) )[0,1,2,3,4,5];
 827       $mon += $part_pkg->getfield('freq');
 828       until ( $mon < 12 ) { $mon -= 12; $year++; }
 829       $cust_pkg->setfield('bill',
 830         timelocal($sec,$min,$hour,$mday,$mon,$year));
 831       $cust_pkg_mod_flag = 1;
 832     }
 833
 834     warn "\$setup is undefined" unless defined($setup);
 835     warn "\$recur is undefined" unless defined($recur);
 836     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 837
 838     if ( $cust_pkg_mod_flag ) {
 839       $error=$cust_pkg->replace($old_cust_pkg);
 840       if ( $error ) { #just in case
 841         $dbh->rollback if $oldAutoCommit;
 842         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
 843       }
 844       $setup = sprintf( "%.2f", $setup );
 845       $recur = sprintf( "%.2f", $recur );
 846       if ( $setup < 0 ) {
 847         $dbh->rollback if $oldAutoCommit;
 848         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 849       }
 850       if ( $recur < 0 ) {
 851         $dbh->rollback if $oldAutoCommit;
 852         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 853       }
 854       if ( $setup > 0 || $recur > 0 ) {
 855         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 856           'pkgnum' => $cust_pkg->pkgnum,
 857           'setup'  => $setup,
 858           'recur'  => $recur,
 859           'sdate'  => $sdate,
 860           'edate'  => $cust_pkg->bill,
 861         });
 862         push @cust_bill_pkg, $cust_bill_pkg;
 863         $total_setup += $setup;
 864         $total_recur += $recur;
 865       }
 866     }
 867
 868   }
 869
 870   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 871
 872   unless ( @cust_bill_pkg ) {
 873     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 874     return '';
 875   }
 876
 877   unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
 878     my $cust_main_county = qsearchs('cust_main_county',{
 879         'state'   => $self->state,
 880         'county'  => $self->county,
 881         'country' => $self->country,
 882     } );
 883     my $tax = sprintf( "%.2f",
 884       $charged * ( $cust_main_county->getfield('tax') / 100 )
 885     );
 886     $charged = sprintf( "%.2f", $charged+$tax );
 887
 888     my $cust_bill_pkg = new FS::cust_bill_pkg ({
 889       'pkgnum' => 0,
 890       'setup'  => $tax,
 891       'recur'  => 0,
 892       'sdate'  => '',
 893       'edate'  => '',
 894     });
 895     push @cust_bill_pkg, $cust_bill_pkg;
 896   }
 897
 898   my $cust_bill = new FS::cust_bill ( {
 899     'custnum' => $self->custnum,
 900     '_date'   => $time,
 901     'charged' => $charged,
 902   } );
 903   $error = $cust_bill->insert;
 904   if ( $error ) {
 905     $dbh->rollback if $oldAutoCommit;
 906     return "can't create invoice for customer #". $self->custnum. ": $error";
 907   }
 908
 909   my $invnum = $cust_bill->invnum;
 910   my $cust_bill_pkg;
 911   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
 912     warn $cust_bill_pkg->invnum($invnum);
 913     $error = $cust_bill_pkg->insert;
 914     if ( $error ) {
 915       $dbh->rollback if $oldAutoCommit;
 916       return "can't create invoice line item for customer #". $self->custnum.
 917              ": $error";
 918     }
 919   }
 920
 921   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 922   ''; #no error
 923 }
 924
 925 =item collect OPTIONS
 926
 927 (Attempt to) collect money for this customer's outstanding invoices (see
 928 L<FS::cust_bill>).  Usually used after the bill method.
 929
 930 Depending on the value of `payby', this may print an invoice (`BILL'), charge
 931 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 932
 933 If there is an error, returns the error, otherwise returns false.
 934
 935 Options are passed as name-value pairs.
 936
 937 Currently available options are:
 938
 939 invoice_time - Use this time when deciding when to print invoices and
 940 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>
 941 for conversion functions.
 942
 943 batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
 944 default, cards are processed immediately, which will generate an error if
 945 CyberCash is not installed.
 946
 947 report_badcard - Set this true if you want bad card transactions to
 948 return an error.  By default, they don't.
 949
 950 =cut
 951
 952 sub collect {
 953   my( $self, %options ) = @_;
 954   my $invoice_time = $options{'invoice_time'} || time;
 955
 956   #put below somehow?
 957   local $SIG{HUP} = 'IGNORE';
 958   local $SIG{INT} = 'IGNORE';
 959   local $SIG{QUIT} = 'IGNORE';
 960   local $SIG{TERM} = 'IGNORE';
 961   local $SIG{TSTP} = 'IGNORE';
 962   local $SIG{PIPE} = 'IGNORE';
 963
 964   my $oldAutoCommit = $FS::UID::AutoCommit;
 965   local $FS::UID::AutoCommit = 0;
 966   my $dbh = dbh;
 967
 968   my $balance = $self->balance;
 969   warn "collect: balance $balance" if $Debug;
 970   unless ( $balance > 0 ) { #redundant?????
 971     $dbh->rollback if $oldAutoCommit; #hmm
 972     return '';
 973   }
 974
 975   foreach my $cust_bill (
 976     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 977   ) {
 978
 979     #this has to be before next's
 980     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
 981                                   ? $balance
 982                                   : $cust_bill->owed
 983     );
 984     $balance = sprintf( "%.2f", $balance - $amount );
 985
 986     next unless $cust_bill->owed > 0;
 987
 988     # don't try to charge for the same invoice if it's already in a batch
 989     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 990
 991     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
 992
 993     next unless $amount > 0;
 994
 995     if ( $self->payby eq 'BILL' ) {
 996
 997       #30 days 2592000
 998       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 999       #warn "$invoice_time ", $cust_bill->_date, " $since";
1000       if ( $since >= 0 #don't print future invoices
1001            && ( $cust_bill->printed * 2592000 ) <= $since
1002       ) {
1003
1004         #my @print_text = $cust_bill->print_text; #( date )
1005         my @invoicing_list = $self->invoicing_list;
1006         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1007           $ENV{SMTPHOSTS} = $smtpmachine;
1008           $ENV{MAILADDRESS} = $invoice_from;
1009           my $header = new Mail::Header ( [
1010             "From: $invoice_from",
1011             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1012             "Sender: $invoice_from",
1013             "Reply-To: $invoice_from",
1014             "Date: ". time2str("%a, %d %b %Y %X %z", time),
1015             "Subject: Invoice",
1016           ] );
1017           my $message = new Mail::Internet (
1018             'Header' => $header,
1019             'Body' => [ $cust_bill->print_text ], #( date)
1020           );
1021           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
1022
1023         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1024           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1025           print LPR $cust_bill->print_text; #( date )
1026           close LPR
1027             or die $! ? "Error closing $lpr: $!"
1028                          : "Exit status $? from $lpr";
1029         }
1030
1031         my %hash = $cust_bill->hash;
1032         $hash{'printed'}++;
1033         my $new_cust_bill = new FS::cust_bill(\%hash);
1034         my $error = $new_cust_bill->replace($cust_bill);
1035         warn "Error updating $cust_bill->printed: $error" if $error;
1036
1037       }
1038
1039     } elsif ( $self->payby eq 'COMP' ) {
1040       my $cust_pay = new FS::cust_pay ( {
1041          'invnum' => $cust_bill->invnum,
1042          'paid' => $amount,
1043          '_date' => '',
1044          'payby' => 'COMP',
1045          'payinfo' => $self->payinfo,
1046          'paybatch' => ''
1047       } );
1048       my $error = $cust_pay->insert;
1049       if ( $error ) {
1050         $dbh->rollback if $oldAutoCommit;
1051         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1052       }
1053
1054
1055     } elsif ( $self->payby eq 'CARD' ) {
1056
1057       if ( $options{'batch_card'} ne 'yes' ) {
1058
1059         unless ( $processor ) {
1060           $dbh->rollback if $oldAutoCommit;
1061           return "Real time card processing not enabled!";
1062         }
1063
1064         my $address = $self->address1;
1065         $address .= ", ". $self->address2 if $self->address2;
1066
1067         #fix exp. date
1068         #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1069         $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1070         my $exp = "$2/$1";
1071
1072         if ( $processor eq 'cybercash3.2' ) {
1073
1074           #fix exp. date for cybercash
1075           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1076           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1077           my $exp = "$2/$1";
1078
1079           my $paybatch = $cust_bill->invnum.
1080                          '-' . time2str("%y%m%d%H%M%S", time);
1081
1082           my $payname = $self->payname ||
1083                         $self->getfield('first'). ' '. $self->getfield('last');
1084
1085
1086           my $country = $self->country eq 'US' ? 'USA' : $self->country;
1087
1088           my @full_xaction = ( $xaction,
1089             'Order-ID'     => $paybatch,
1090             'Amount'       => "usd $amount",
1091             'Card-Number'  => $self->getfield('payinfo'),
1092             'Card-Name'    => $payname,
1093             'Card-Address' => $address,
1094             'Card-City'    => $self->getfield('city'),
1095             'Card-State'   => $self->getfield('state'),
1096             'Card-Zip'     => $self->getfield('zip'),
1097             'Card-Country' => $country,
1098             'Card-Exp'     => $exp,
1099           );
1100
1101           my %result;
1102           %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1103
1104           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1105           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1106           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1107             my $cust_pay = new FS::cust_pay ( {
1108                'invnum'   => $cust_bill->invnum,
1109                'paid'     => $amount,
1110                '_date'     => '',
1111                'payby'    => 'CARD',
1112                'payinfo'  => $self->payinfo,
1113                'paybatch' => "$processor:$paybatch",
1114             } );
1115             my $error = $cust_pay->insert;
1116             if ( $error ) {
1117               # gah, even with transactions.
1118               $dbh->commit if $oldAutoCommit; #well.
1119               my $e = 'WARNING: Card debited but database not updated - '.
1120                       'error applying payment, invnum #' . $cust_bill->invnum.
1121                       " (CyberCash Order-ID $paybatch): $error";
1122               warn $e;
1123               return $e;
1124             }
1125           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1126                  || $options{'report_badcard'} ) {
1127              $dbh->commit if $oldAutoCommit;
1128              return 'Cybercash error, invnum #' .
1129                $cust_bill->invnum. ':'. $result{'MErrMsg'};
1130           } else {
1131             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1132             return '';
1133           }
1134
1135         } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1136
1137           my $bop_processor = $1;
1138
1139           my($payname, $payfirst, $paylast);
1140           if ( $self->payname ) {
1141             $payname = $self->payname;
1142             $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1143               or do {
1144                       $dbh->rollback if $oldAutoCommit;
1145                       return "Illegal payname $payname";
1146                     };
1147             ($payfirst, $paylast) = ($1, $2);
1148           } else {
1149             $payfirst = $self->getfield('first');
1150             $paylast = $self->getfield('first');
1151             $payname =  "$payfirst $paylast";
1152           }
1153
1154           my $transaction =
1155             new Business::OnlinePayment( $bop_processor, @bop_options );
1156           $transaction->content(
1157             'type'           => 'CC',
1158             'login'          => $bop_login,
1159             'password'       => $bop_password,
1160             'action'         => $bop_action,
1161             'amount'         => $amount,
1162             'invoice_number' => $cust_bill->invnum,
1163             'customer_id'    => $self->custnum,
1164             'last_name'      => $paylast,
1165             'first_name'     => $payfirst,
1166             'name'           => $payname,
1167             'address'        => $address,
1168             'city'           => $self->city,
1169             'state'          => $self->state,
1170             'zip'            => $self->zip,
1171             'country'        => $self->country,
1172             'card_number'    => $self->payinfo,
1173             'expiration'     => $exp,
1174           );
1175           $transaction->submit();
1176
1177           if ( $transaction->is_success()) {
1178             my $cust_pay = new FS::cust_pay ( {
1179                'invnum'   => $cust_bill->invnum,
1180                'paid'     => $amount,
1181                '_date'     => '',
1182                'payby'    => 'CARD',
1183                'payinfo'  => $self->payinfo,
1184                'paybatch' => "$processor:". $transaction->authorization,
1185             } );
1186             my $error = $cust_pay->insert;
1187             if ( $error ) {
1188               # gah, even with transactions.
1189               $dbh->commit if $oldAutoCommit; #well.
1190               my $e = 'WARNING: Card debited but database not updated - '.
1191                       'error applying payment, invnum #' . $cust_bill->invnum.
1192                       " ($processor): $error";
1193               warn $e;
1194               return $e;
1195             }
1196           } elsif ( $options{'report_badcard'} ) {
1197             $dbh->commit if $oldAutoCommit;
1198             return "$processor error, invnum #". $cust_bill->invnum. ': '.
1199                    $transaction->result_code. ": ". $transaction->error_message;
1200           } else {
1201             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1202             #return '';
1203           }
1204
1205         } else {
1206           $dbh->rollback if $oldAutoCommit;
1207           return "Unknown real-time processor $processor\n";
1208         }
1209
1210       } else { #batch card
1211
1212        my $cust_pay_batch = new FS::cust_pay_batch ( {
1213          'invnum'   => $cust_bill->getfield('invnum'),
1214          'custnum'  => $self->getfield('custnum'),
1215          'last'     => $self->getfield('last'),
1216          'first'    => $self->getfield('first'),
1217          'address1' => $self->getfield('address1'),
1218          'address2' => $self->getfield('address2'),
1219          'city'     => $self->getfield('city'),
1220          'state'    => $self->getfield('state'),
1221          'zip'      => $self->getfield('zip'),
1222          'country'  => $self->getfield('country'),
1223          'trancode' => 77,
1224          'cardnum'  => $self->getfield('payinfo'),
1225          'exp'      => $self->getfield('paydate'),
1226          'payname'  => $self->getfield('payname'),
1227          'amount'   => $amount,
1228        } );
1229        my $error = $cust_pay_batch->insert;
1230        if ( $error ) {
1231          $dbh->rollback if $oldAutoCommit;
1232          return "Error adding to cust_pay_batch: $error";
1233        }
1234
1235       }
1236
1237     } else {
1238       $dbh->rollback if $oldAutoCommit;
1239       return "Unknown payment type ". $self->payby;
1240     }
1241
1242   }
1243   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1244   '';
1245
1246 }
1247
1248 =item total_owed
1249
1250 Returns the total owed for this customer on all invoices
1251 (see L<FS::cust_bill/owed>).
1252
1253 =cut
1254
1255 sub total_owed {
1256   my $self = shift;
1257   my $total_bill = 0;
1258   foreach my $cust_bill ( qsearch('cust_bill', {
1259     'custnum' => $self->custnum,
1260   } ) ) {
1261     $total_bill += $cust_bill->owed;
1262   }
1263   sprintf( "%.2f", $total_bill );
1264 }
1265
1266 =item apply_credits
1267
1268 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1269 to outstanding invoice balances in chronological order and returns the value
1270 of any remaining unapplied credits available for refund
1271 (see L<FS::cust_refund>).
1272
1273 =cut
1274
1275 sub apply_credits {
1276   my $self = shift;
1277
1278   return 0 unless $self->total_credited;
1279
1280   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1281       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1282
1283   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1284       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1285
1286   my $credit;
1287
1288   foreach my $cust_bill ( @invoices ) {
1289     my $amount;
1290
1291     if ( !defined($credit) || $credit->credited == 0) {
1292       $credit = pop @credits or last;
1293     }
1294
1295     if ($cust_bill->owed >= $credit->credited) {
1296       $amount=$credit->credited;
1297     }else{
1298       $amount=$cust_bill->owed;
1299     }
1300
1301     my $cust_credit_bill = new FS::cust_credit_bill ( {
1302       'crednum' => $credit->crednum,
1303       'invnum'  => $cust_bill->invnum,
1304       'amount'  => $amount,
1305     } );
1306     my $error = $cust_credit_bill->insert;
1307     die $error if $error;
1308
1309     redo if ($cust_bill->owed > 0);
1310
1311   }
1312
1313   return $self->total_credited;
1314 }
1315
1316 =item apply_payments
1317
1318 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1319 to outstanding invoice balances in chronological order.
1320
1321  #and returns the value of any remaining unapplied payments.
1322
1323 =cut
1324
1325 sub apply_payments {
1326   my $self = shift;
1327
1328   #return 0 unless
1329
1330   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1331       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1332
1333   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1334       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1335
1336   my $payment;
1337
1338   foreach my $cust_bill ( @invoices ) {
1339     my $amount;
1340
1341     if ( !defined($payment) || $payment->unapplied == 0 ) {
1342       $payment = pop @payments or last;
1343     }
1344
1345     if ( $cust_bill->owed >= $payment->unapplied ) {
1346       $amount = $payment->unapplied;
1347     } else {
1348       $amount = $cust_bill->owed;
1349     }
1350
1351     my $cust_bill_pay = new FS::cust_bill_pay ( {
1352       'paynum' => $payment->paynum,
1353       'invnum' => $cust_bill->invnum,
1354       'amount' => $amount,
1355     } );
1356     my $error = $cust_bill_pay->insert;
1357     die $error if $error;
1358
1359     redo if ( $cust_bill->owed > 0);
1360
1361   }
1362
1363   # return 0;
1364 }
1365
1366 =item total_credited
1367
1368 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1369 customer.  See L<FS::cust_credit/credited>.
1370
1371 =cut
1372
1373 sub total_credited {
1374   my $self = shift;
1375   my $total_credit = 0;
1376   foreach my $cust_credit ( qsearch('cust_credit', {
1377     'custnum' => $self->custnum,
1378   } ) ) {
1379     $total_credit += $cust_credit->credited;
1380   }
1381   sprintf( "%.2f", $total_credit );
1382 }
1383
1384 =item total_unapplied_payments
1385
1386 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1387 See L<FS::cust_pay/unapplied>.
1388
1389 =cut
1390
1391 sub total_unapplied_payments {
1392   my $self = shift;
1393   my $total_unapplied = 0;
1394   foreach my $cust_pay ( qsearch('cust_pay', {
1395     'custnum' => $self->custnum,
1396   } ) ) {
1397     $total_unapplied += $cust_pay->unapplied;
1398   }
1399   sprintf( "%.2f", $total_unapplied );
1400 }
1401
1402 =item balance
1403
1404 Returns the balance for this customer (total_owed minus total_credited
1405 minus total_unapplied_payments).
1406
1407 =cut
1408
1409 sub balance {
1410   my $self = shift;
1411   sprintf( "%.2f",
1412     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1413   );
1414 }
1415
1416 =item invoicing_list [ ARRAYREF ]
1417
1418 If an arguement is given, sets these email addresses as invoice recipients
1419 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1420 (except as warnings), so use check_invoicing_list first.
1421
1422 Returns a list of email addresses (with svcnum entries expanded).
1423
1424 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1425 check it without disturbing anything by passing nothing.
1426
1427 This interface may change in the future.
1428
1429 =cut
1430
1431 sub invoicing_list {
1432   my( $self, $arrayref ) = @_;
1433   if ( $arrayref ) {
1434     my @cust_main_invoice;
1435     if ( $self->custnum ) {
1436       @cust_main_invoice =
1437         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1438     } else {
1439       @cust_main_invoice = ();
1440     }
1441     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1442       #warn $cust_main_invoice->destnum;
1443       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1444         #warn $cust_main_invoice->destnum;
1445         my $error = $cust_main_invoice->delete;
1446         warn $error if $error;
1447       }
1448     }
1449     if ( $self->custnum ) {
1450       @cust_main_invoice =
1451         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1452     } else {
1453       @cust_main_invoice = ();
1454     }
1455     foreach my $address ( @{$arrayref} ) {
1456       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1457         my $cust_main_invoice = new FS::cust_main_invoice ( {
1458           'custnum' => $self->custnum,
1459           'dest'    => $address,
1460         } );
1461         my $error = $cust_main_invoice->insert;
1462         warn $error if $error;
1463       }
1464     }
1465   }
1466   if ( $self->custnum ) {
1467     map { $_->address }
1468       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1469   } else {
1470     ();
1471   }
1472 }
1473
1474 =item check_invoicing_list ARRAYREF
1475
1476 Checks these arguements as valid input for the invoicing_list method.  If there
1477 is an error, returns the error, otherwise returns false.
1478
1479 =cut
1480
1481 sub check_invoicing_list {
1482   my( $self, $arrayref ) = @_;
1483   foreach my $address ( @{$arrayref} ) {
1484     my $cust_main_invoice = new FS::cust_main_invoice ( {
1485       'custnum' => $self->custnum,
1486       'dest'    => $address,
1487     } );
1488     my $error = $self->custnum
1489                 ? $cust_main_invoice->check
1490                 : $cust_main_invoice->checkdest
1491     ;
1492     return $error if $error;
1493   }
1494   '';
1495 }
1496
1497 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1498
1499 Returns an array of customers referred by this customer (referral_custnum set
1500 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1501 customers referred by customers referred by this customer and so on, inclusive.
1502 The default behavior is DEPTH 1 (no recursion).
1503
1504 =cut
1505
1506 sub referral_cust_main {
1507   my $self = shift;
1508   my $depth = @_ ? shift : 1;
1509   my $exclude = @_ ? shift : {};
1510
1511   my @cust_main =
1512     map { $exclude->{$_->custnum}++; $_; }
1513       grep { ! $exclude->{ $_->custnum } }
1514         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1515
1516   if ( $depth > 1 ) {
1517     push @cust_main,
1518       map { $_->referral_cust_main($depth-1, $exclude) }
1519         @cust_main;
1520   }
1521
1522   @cust_main;
1523 }
1524
1525 =back
1526
1527 =head1 SUBROUTINES
1528
1529 =over 4
1530
1531 =item check_and_rebuild_fuzzyfiles
1532
1533 =cut
1534
1535 sub check_and_rebuild_fuzzyfiles {
1536   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1537   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1538     or &rebuild_fuzzyfiles;
1539 }
1540
1541 =item rebuild_fuzzyfiles
1542
1543 =cut
1544
1545 sub rebuild_fuzzyfiles {
1546
1547   use Fcntl qw(:flock);
1548
1549   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1550
1551   #last
1552
1553   open(LASTLOCK,">>$dir/cust_main.last")
1554     or die "can't open $dir/cust_main.last: $!";
1555   flock(LASTLOCK,LOCK_EX)
1556     or die "can't lock $dir/cust_main.last: $!";
1557
1558   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1559   push @all_last,
1560                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1561     if defined dbdef->table('cust_main')->column('ship_last');
1562
1563   open (LASTCACHE,">$dir/cust_main.last.tmp")
1564     or die "can't open $dir/cust_main.last.tmp: $!";
1565   print LASTCACHE join("\n", @all_last), "\n";
1566   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1567
1568   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1569   close LASTLOCK;
1570
1571   #company
1572
1573   open(COMPANYLOCK,">>$dir/cust_main.company")
1574     or die "can't open $dir/cust_main.company: $!";
1575   flock(COMPANYLOCK,LOCK_EX)
1576     or die "can't lock $dir/cust_main.company: $!";
1577
1578   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1579   push @all_company,
1580        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1581     if defined dbdef->table('cust_main')->column('ship_last');
1582
1583   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1584     or die "can't open $dir/cust_main.company.tmp: $!";
1585   print COMPANYCACHE join("\n", @all_company), "\n";
1586   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1587
1588   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1589   close COMPANYLOCK;
1590
1591 }
1592
1593 =item all_last
1594
1595 =cut
1596
1597 sub all_last {
1598   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1599   open(LASTCACHE,"<$dir/cust_main.last")
1600     or die "can't open $dir/cust_main.last: $!";
1601   my @array = map { chomp; $_; } <LASTCACHE>;
1602   close LASTCACHE;
1603   \@array;
1604 }
1605
1606 =item all_company
1607
1608 =cut
1609
1610 sub all_company {
1611   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1612   open(COMPANYCACHE,"<$dir/cust_main.company")
1613     or die "can't open $dir/cust_main.last: $!";
1614   my @array = map { chomp; $_; } <COMPANYCACHE>;
1615   close COMPANYCACHE;
1616   \@array;
1617 }
1618
1619 =item append_fuzzyfiles LASTNAME COMPANY
1620
1621 =cut
1622
1623 sub append_fuzzyfiles {
1624   my( $last, $company ) = @_;
1625
1626   &check_and_rebuild_fuzzyfiles;
1627
1628   use Fcntl qw(:flock);
1629
1630   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1631
1632   if ( $last ) {
1633
1634     open(LAST,">>$dir/cust_main.last")
1635       or die "can't open $dir/cust_main.last: $!";
1636     flock(LAST,LOCK_EX)
1637       or die "can't lock $dir/cust_main.last: $!";
1638
1639     print LAST "$last\n";
1640
1641     flock(LAST,LOCK_UN)
1642       or die "can't unlock $dir/cust_main.last: $!";
1643     close LAST;
1644   }
1645
1646   if ( $company ) {
1647
1648     open(COMPANY,">>$dir/cust_main.company")
1649       or die "can't open $dir/cust_main.company: $!";
1650     flock(COMPANY,LOCK_EX)
1651       or die "can't lock $dir/cust_main.company: $!";
1652
1653     print COMPANY "$company\n";
1654
1655     flock(COMPANY,LOCK_UN)
1656       or die "can't unlock $dir/cust_main.company: $!";
1657
1658     close COMPANY;
1659   }
1660
1661   1;
1662 }
1663
1664 =head1 VERSION
1665
1666 $Id: cust_main.pm,v 1.34 2001-09-20 00:13:07 ivan Exp $
1667
1668 =head1 BUGS
1669
1670 The delete method.
1671
1672 The delete method should possibly take an FS::cust_main object reference
1673 instead of a scalar customer number.
1674
1675 Bill and collect options should probably be passed as references instead of a
1676 list.
1677
1678 CyberCash v2 forces us to define some variables in package main.
1679
1680 There should probably be a configuration file with a list of allowed credit
1681 card types.
1682
1683 No multiple currency support (probably a larger project than just this module).
1684
1685 =head1 SEE ALSO
1686
1687 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1688 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1689 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1690 L<FS::UID>, schema.html from the base documentation.
1691
1692 =cut
1693
1694 1;
1695
1696