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