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