FS/FS/cust_main.pm

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