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 @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1155           if ( $conf->exists('emailinvoiceonly') ) {
1156             @invoicing_list = $self->default_invoicing_list
1157               unless @invoicing_list;
1158           }
1159           my $email = $invoicing_list[0];
1160
1161           my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1162
1163           my $transaction =
1164             new Business::OnlinePayment( $bop_processor, @bop_options );
1165           $transaction->content(
1166             'type'           => 'CC',
1167             'login'          => $bop_login,
1168             'password'       => $bop_password,
1169             'action'         => $action1,
1170             'description'    => 'Internet Services',
1171             'amount'         => $amount,
1172             'invoice_number' => $cust_bill->invnum,
1173             'customer_id'    => $self->custnum,
1174             'last_name'      => $paylast,
1175             'first_name'     => $payfirst,
1176             'name'           => $payname,
1177             'address'        => $address,
1178             'city'           => $self->city,
1179             'state'          => $self->state,
1180             'zip'            => $self->zip,
1181             'country'        => $self->country,
1182             'card_number'    => $self->payinfo,
1183             'expiration'     => $exp,
1184             'referer'        => 'http://cleanwhisker.420.am/',
1185             'email'          => $email,
1186           );
1187           $transaction->submit();
1188
1189           if ( $transaction->is_success() && $action2 ) {
1190             my $auth = $transaction->authorization;
1191             my $ordernum = $transaction->order_number;
1192             #warn "********* $auth ***********\n";
1193             #warn "********* $ordernum ***********\n";
1194             my $capture =
1195               new Business::OnlinePayment( $bop_processor, @bop_options );
1196
1197             $capture->content(
1198               action         => $action2,
1199               login          => $bop_login,
1200               password       => $bop_password,
1201               order_number   => $ordernum,
1202               amount         => $amount,
1203               authorization  => $auth,
1204               description    => 'Internet Services',
1205             );
1206
1207             $capture->submit();
1208
1209             unless ( $capture->is_success ) {
1210               my $e = "Authorization sucessful but capture failed, invnum #".
1211                       $cust_bill->invnum. ': '.  $capture->result_code.
1212                       ": ". $capture->error_message;
1213               warn $e;
1214               return $e;
1215             }
1216
1217           }
1218
1219           if ( $transaction->is_success() ) {
1220
1221             my $cust_pay = new FS::cust_pay ( {
1222                'invnum'   => $cust_bill->invnum,
1223                'paid'     => $amount,
1224                '_date'     => '',
1225                'payby'    => 'CARD',
1226                'payinfo'  => $self->payinfo,
1227                'paybatch' => "$processor:". $transaction->authorization,
1228             } );
1229             my $error = $cust_pay->insert;
1230             if ( $error ) {
1231               # gah, even with transactions.
1232               $dbh->commit if $oldAutoCommit; #well.
1233               my $e = 'WARNING: Card debited but database not updated - '.
1234                       'error applying payment, invnum #' . $cust_bill->invnum.
1235                       " ($processor): $error";
1236               warn $e;
1237               return $e;
1238             }
1239           } elsif ( $options{'report_badcard'} ) {
1240             $dbh->commit if $oldAutoCommit;
1241             return "$processor error, invnum #". $cust_bill->invnum. ': '.
1242                    $transaction->result_code. ": ". $transaction->error_message;
1243           } else {
1244             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1245             #return '';
1246           }
1247
1248         } else {
1249           $dbh->rollback if $oldAutoCommit;
1250           return "Unknown real-time processor $processor\n";
1251         }
1252
1253       } else { #batch card
1254
1255        my $cust_pay_batch = new FS::cust_pay_batch ( {
1256          'invnum'   => $cust_bill->getfield('invnum'),
1257          'custnum'  => $self->getfield('custnum'),
1258          'last'     => $self->getfield('last'),
1259          'first'    => $self->getfield('first'),
1260          'address1' => $self->getfield('address1'),
1261          'address2' => $self->getfield('address2'),
1262          'city'     => $self->getfield('city'),
1263          'state'    => $self->getfield('state'),
1264          'zip'      => $self->getfield('zip'),
1265          'country'  => $self->getfield('country'),
1266          'trancode' => 77,
1267          'cardnum'  => $self->getfield('payinfo'),
1268          'exp'      => $self->getfield('paydate'),
1269          'payname'  => $self->getfield('payname'),
1270          'amount'   => $amount,
1271        } );
1272        my $error = $cust_pay_batch->insert;
1273        if ( $error ) {
1274          $dbh->rollback if $oldAutoCommit;
1275          return "Error adding to cust_pay_batch: $error";
1276        }
1277
1278       }
1279
1280     } else {
1281       $dbh->rollback if $oldAutoCommit;
1282       return "Unknown payment type ". $self->payby;
1283     }
1284
1285   }
1286   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1287   '';
1288
1289 }
1290
1291 =item total_owed
1292
1293 Returns the total owed for this customer on all invoices
1294 (see L<FS::cust_bill/owed>).
1295
1296 =cut
1297
1298 sub total_owed {
1299   my $self = shift;
1300   my $total_bill = 0;
1301   foreach my $cust_bill ( qsearch('cust_bill', {
1302     'custnum' => $self->custnum,
1303   } ) ) {
1304     $total_bill += $cust_bill->owed;
1305   }
1306   sprintf( "%.2f", $total_bill );
1307 }
1308
1309 =item apply_credits
1310
1311 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1312 to outstanding invoice balances in chronological order and returns the value
1313 of any remaining unapplied credits available for refund
1314 (see L<FS::cust_refund>).
1315
1316 =cut
1317
1318 sub apply_credits {
1319   my $self = shift;
1320
1321   return 0 unless $self->total_credited;
1322
1323   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1324       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1325
1326   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1327       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1328
1329   my $credit;
1330
1331   foreach my $cust_bill ( @invoices ) {
1332     my $amount;
1333
1334     if ( !defined($credit) || $credit->credited == 0) {
1335       $credit = pop @credits or last;
1336     }
1337
1338     if ($cust_bill->owed >= $credit->credited) {
1339       $amount=$credit->credited;
1340     }else{
1341       $amount=$cust_bill->owed;
1342     }
1343
1344     my $cust_credit_bill = new FS::cust_credit_bill ( {
1345       'crednum' => $credit->crednum,
1346       'invnum'  => $cust_bill->invnum,
1347       'amount'  => $amount,
1348     } );
1349     my $error = $cust_credit_bill->insert;
1350     die $error if $error;
1351
1352     redo if ($cust_bill->owed > 0);
1353
1354   }
1355
1356   return $self->total_credited;
1357 }
1358
1359 =item apply_payments
1360
1361 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1362 to outstanding invoice balances in chronological order.
1363
1364  #and returns the value of any remaining unapplied payments.
1365
1366 =cut
1367
1368 sub apply_payments {
1369   my $self = shift;
1370
1371   #return 0 unless
1372
1373   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1374       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1375
1376   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1377       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1378
1379   my $payment;
1380
1381   foreach my $cust_bill ( @invoices ) {
1382     my $amount;
1383
1384     if ( !defined($payment) || $payment->unapplied == 0 ) {
1385       $payment = pop @payments or last;
1386     }
1387
1388     if ( $cust_bill->owed >= $payment->unapplied ) {
1389       $amount = $payment->unapplied;
1390     } else {
1391       $amount = $cust_bill->owed;
1392     }
1393
1394     my $cust_bill_pay = new FS::cust_bill_pay ( {
1395       'paynum' => $payment->paynum,
1396       'invnum' => $cust_bill->invnum,
1397       'amount' => $amount,
1398     } );
1399     my $error = $cust_bill_pay->insert;
1400     die $error if $error;
1401
1402     redo if ( $cust_bill->owed > 0);
1403
1404   }
1405
1406   # return 0;
1407 }
1408
1409 =item total_credited
1410
1411 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1412 customer.  See L<FS::cust_credit/credited>.
1413
1414 =cut
1415
1416 sub total_credited {
1417   my $self = shift;
1418   my $total_credit = 0;
1419   foreach my $cust_credit ( qsearch('cust_credit', {
1420     'custnum' => $self->custnum,
1421   } ) ) {
1422     $total_credit += $cust_credit->credited;
1423   }
1424   sprintf( "%.2f", $total_credit );
1425 }
1426
1427 =item total_unapplied_payments
1428
1429 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1430 See L<FS::cust_pay/unapplied>.
1431
1432 =cut
1433
1434 sub total_unapplied_payments {
1435   my $self = shift;
1436   my $total_unapplied = 0;
1437   foreach my $cust_pay ( qsearch('cust_pay', {
1438     'custnum' => $self->custnum,
1439   } ) ) {
1440     $total_unapplied += $cust_pay->unapplied;
1441   }
1442   sprintf( "%.2f", $total_unapplied );
1443 }
1444
1445 =item balance
1446
1447 Returns the balance for this customer (total_owed minus total_credited
1448 minus total_unapplied_payments).
1449
1450 =cut
1451
1452 sub balance {
1453   my $self = shift;
1454   sprintf( "%.2f",
1455     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1456   );
1457 }
1458
1459 =item invoicing_list [ ARRAYREF ]
1460
1461 If an arguement is given, sets these email addresses as invoice recipients
1462 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1463 (except as warnings), so use check_invoicing_list first.
1464
1465 Returns a list of email addresses (with svcnum entries expanded).
1466
1467 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1468 check it without disturbing anything by passing nothing.
1469
1470 This interface may change in the future.
1471
1472 =cut
1473
1474 sub invoicing_list {
1475   my( $self, $arrayref ) = @_;
1476   if ( $arrayref ) {
1477     my @cust_main_invoice;
1478     if ( $self->custnum ) {
1479       @cust_main_invoice =
1480         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1481     } else {
1482       @cust_main_invoice = ();
1483     }
1484     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1485       #warn $cust_main_invoice->destnum;
1486       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1487         #warn $cust_main_invoice->destnum;
1488         my $error = $cust_main_invoice->delete;
1489         warn $error if $error;
1490       }
1491     }
1492     if ( $self->custnum ) {
1493       @cust_main_invoice =
1494         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1495     } else {
1496       @cust_main_invoice = ();
1497     }
1498     foreach my $address ( @{$arrayref} ) {
1499       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1500         my $cust_main_invoice = new FS::cust_main_invoice ( {
1501           'custnum' => $self->custnum,
1502           'dest'    => $address,
1503         } );
1504         my $error = $cust_main_invoice->insert;
1505         warn $error if $error;
1506       }
1507     }
1508   }
1509   if ( $self->custnum ) {
1510     map { $_->address }
1511       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1512   } else {
1513     ();
1514   }
1515 }
1516
1517 =item check_invoicing_list ARRAYREF
1518
1519 Checks these arguements as valid input for the invoicing_list method.  If there
1520 is an error, returns the error, otherwise returns false.
1521
1522 =cut
1523
1524 sub check_invoicing_list {
1525   my( $self, $arrayref ) = @_;
1526   foreach my $address ( @{$arrayref} ) {
1527     my $cust_main_invoice = new FS::cust_main_invoice ( {
1528       'custnum' => $self->custnum,
1529       'dest'    => $address,
1530     } );
1531     my $error = $self->custnum
1532                 ? $cust_main_invoice->check
1533                 : $cust_main_invoice->checkdest
1534     ;
1535     return $error if $error;
1536   }
1537   '';
1538 }
1539
1540 =item default_invoicing_list
1541
1542 =cut
1543
1544 sub default_invoicing_list {
1545   my $self = shift;
1546   my @list = ();
1547   foreach my $cust_pkg ( $self->all_pkgs ) {
1548     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1549     my @svc_acct =
1550       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1551         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1552           @cust_svc;
1553     push @list, map { $_->email } @svc_acct;
1554   }
1555   $self->invoicing_list(\@list);
1556 }
1557
1558 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1559
1560 Returns an array of customers referred by this customer (referral_custnum set
1561 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1562 customers referred by customers referred by this customer and so on, inclusive.
1563 The default behavior is DEPTH 1 (no recursion).
1564
1565 =cut
1566
1567 sub referral_cust_main {
1568   my $self = shift;
1569   my $depth = @_ ? shift : 1;
1570   my $exclude = @_ ? shift : {};
1571
1572   my @cust_main =
1573     map { $exclude->{$_->custnum}++; $_; }
1574       grep { ! $exclude->{ $_->custnum } }
1575         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1576
1577   if ( $depth > 1 ) {
1578     push @cust_main,
1579       map { $_->referral_cust_main($depth-1, $exclude) }
1580         @cust_main;
1581   }
1582
1583   @cust_main;
1584 }
1585
1586 =back
1587
1588 =head1 SUBROUTINES
1589
1590 =over 4
1591
1592 =item check_and_rebuild_fuzzyfiles
1593
1594 =cut
1595
1596 sub check_and_rebuild_fuzzyfiles {
1597   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1598   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1599     or &rebuild_fuzzyfiles;
1600 }
1601
1602 =item rebuild_fuzzyfiles
1603
1604 =cut
1605
1606 sub rebuild_fuzzyfiles {
1607
1608   use Fcntl qw(:flock);
1609
1610   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1611
1612   #last
1613
1614   open(LASTLOCK,">>$dir/cust_main.last")
1615     or die "can't open $dir/cust_main.last: $!";
1616   flock(LASTLOCK,LOCK_EX)
1617     or die "can't lock $dir/cust_main.last: $!";
1618
1619   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1620   push @all_last,
1621                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1622     if defined dbdef->table('cust_main')->column('ship_last');
1623
1624   open (LASTCACHE,">$dir/cust_main.last.tmp")
1625     or die "can't open $dir/cust_main.last.tmp: $!";
1626   print LASTCACHE join("\n", @all_last), "\n";
1627   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1628
1629   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1630   close LASTLOCK;
1631
1632   #company
1633
1634   open(COMPANYLOCK,">>$dir/cust_main.company")
1635     or die "can't open $dir/cust_main.company: $!";
1636   flock(COMPANYLOCK,LOCK_EX)
1637     or die "can't lock $dir/cust_main.company: $!";
1638
1639   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1640   push @all_company,
1641        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1642     if defined dbdef->table('cust_main')->column('ship_last');
1643
1644   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1645     or die "can't open $dir/cust_main.company.tmp: $!";
1646   print COMPANYCACHE join("\n", @all_company), "\n";
1647   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1648
1649   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1650   close COMPANYLOCK;
1651
1652 }
1653
1654 =item all_last
1655
1656 =cut
1657
1658 sub all_last {
1659   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1660   open(LASTCACHE,"<$dir/cust_main.last")
1661     or die "can't open $dir/cust_main.last: $!";
1662   my @array = map { chomp; $_; } <LASTCACHE>;
1663   close LASTCACHE;
1664   \@array;
1665 }
1666
1667 =item all_company
1668
1669 =cut
1670
1671 sub all_company {
1672   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1673   open(COMPANYCACHE,"<$dir/cust_main.company")
1674     or die "can't open $dir/cust_main.last: $!";
1675   my @array = map { chomp; $_; } <COMPANYCACHE>;
1676   close COMPANYCACHE;
1677   \@array;
1678 }
1679
1680 =item append_fuzzyfiles LASTNAME COMPANY
1681
1682 =cut
1683
1684 sub append_fuzzyfiles {
1685   my( $last, $company ) = @_;
1686
1687   &check_and_rebuild_fuzzyfiles;
1688
1689   use Fcntl qw(:flock);
1690
1691   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1692
1693   if ( $last ) {
1694
1695     open(LAST,">>$dir/cust_main.last")
1696       or die "can't open $dir/cust_main.last: $!";
1697     flock(LAST,LOCK_EX)
1698       or die "can't lock $dir/cust_main.last: $!";
1699
1700     print LAST "$last\n";
1701
1702     flock(LAST,LOCK_UN)
1703       or die "can't unlock $dir/cust_main.last: $!";
1704     close LAST;
1705   }
1706
1707   if ( $company ) {
1708
1709     open(COMPANY,">>$dir/cust_main.company")
1710       or die "can't open $dir/cust_main.company: $!";
1711     flock(COMPANY,LOCK_EX)
1712       or die "can't lock $dir/cust_main.company: $!";
1713
1714     print COMPANY "$company\n";
1715
1716     flock(COMPANY,LOCK_UN)
1717       or die "can't unlock $dir/cust_main.company: $!";
1718
1719     close COMPANY;
1720   }
1721
1722   1;
1723 }
1724
1725 =head1 VERSION
1726
1727 $Id: cust_main.pm,v 1.37 2001-09-25 18:03:04 ivan Exp $
1728
1729 =head1 BUGS
1730
1731 The delete method.
1732
1733 The delete method should possibly take an FS::cust_main object reference
1734 instead of a scalar customer number.
1735
1736 Bill and collect options should probably be passed as references instead of a
1737 list.
1738
1739 CyberCash v2 forces us to define some variables in package main.
1740
1741 There should probably be a configuration file with a list of allowed credit
1742 card types.
1743
1744 No multiple currency support (probably a larger project than just this module).
1745
1746 =head1 SEE ALSO
1747
1748 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1749 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1750 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1751 L<FS::UID>, schema.html from the base documentation.
1752
1753 =cut
1754
1755 1;
1756
1757