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