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     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 960
 961     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
 962
 963     next unless $amount > 0;
 964
 965     if ( $self->payby eq 'BILL' ) {
 966
 967       #30 days 2592000
 968       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 969       #warn "$invoice_time ", $cust_bill->_date, " $since";
 970       if ( $since >= 0 #don't print future invoices
 971            && ( $cust_bill->printed * 2592000 ) <= $since
 972       ) {
 973
 974         #my @print_text = $cust_bill->print_text; #( date )
 975         my @invoicing_list = $self->invoicing_list;
 976         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
 977           $ENV{SMTPHOSTS} = $smtpmachine;
 978           $ENV{MAILADDRESS} = $invoice_from;
 979           my $header = new Mail::Header ( [
 980             "From: $invoice_from",
 981             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
 982             "Sender: $invoice_from",
 983             "Reply-To: $invoice_from",
 984             "Date: ". time2str("%a, %d %b %Y %X %z", time),
 985             "Subject: Invoice",
 986           ] );
 987           my $message = new Mail::Internet (
 988             'Header' => $header,
 989             'Body' => [ $cust_bill->print_text ], #( date)
 990           );
 991           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
 992
 993         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
 994           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
 995           print LPR $cust_bill->print_text; #( date )
 996           close LPR
 997             or die $! ? "Error closing $lpr: $!"
 998                          : "Exit status $? from $lpr";
 999         }
1000
1001         my %hash = $cust_bill->hash;
1002         $hash{'printed'}++;
1003         my $new_cust_bill = new FS::cust_bill(\%hash);
1004         my $error = $new_cust_bill->replace($cust_bill);
1005         warn "Error updating $cust_bill->printed: $error" if $error;
1006
1007       }
1008
1009     } elsif ( $self->payby eq 'COMP' ) {
1010       my $cust_pay = new FS::cust_pay ( {
1011          'invnum' => $cust_bill->invnum,
1012          'paid' => $amount,
1013          '_date' => '',
1014          'payby' => 'COMP',
1015          'payinfo' => $self->payinfo,
1016          'paybatch' => ''
1017       } );
1018       my $error = $cust_pay->insert;
1019       if ( $error ) {
1020         $dbh->rollback if $oldAutoCommit;
1021         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1022       }
1023
1024
1025     } elsif ( $self->payby eq 'CARD' ) {
1026
1027       if ( $options{'batch_card'} ne 'yes' ) {
1028
1029         unless ( $processor ) {
1030           $dbh->rollback if $oldAutoCommit;
1031           return "Real time card processing not enabled!";
1032         }
1033
1034         my $address = $self->address1;
1035         $address .= ", ". $self->address2 if $self->address2;
1036
1037         #fix exp. date
1038         #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1039         $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1040         my $exp = "$2/$1";
1041
1042         if ( $processor =~ /^cybercash/ ) {
1043
1044           #fix exp. date for cybercash
1045           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1046           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1047           my $exp = "$2/$1";
1048
1049           my $paybatch = $cust_bill->invnum.
1050                          '-' . time2str("%y%m%d%H%M%S", time);
1051
1052           my $payname = $self->payname ||
1053                         $self->getfield('first'). ' '. $self->getfield('last');
1054
1055
1056           my $country = $self->country eq 'US' ? 'USA' : $self->country;
1057
1058           my @full_xaction = ( $xaction,
1059             'Order-ID'     => $paybatch,
1060             'Amount'       => "usd $amount",
1061             'Card-Number'  => $self->getfield('payinfo'),
1062             'Card-Name'    => $payname,
1063             'Card-Address' => $address,
1064             'Card-City'    => $self->getfield('city'),
1065             'Card-State'   => $self->getfield('state'),
1066             'Card-Zip'     => $self->getfield('zip'),
1067             'Card-Country' => $country,
1068             'Card-Exp'     => $exp,
1069           );
1070
1071           my %result;
1072           if ( $processor eq 'cybercash2' ) {
1073             $^W=0; #CCLib isn't -w safe, ugh!
1074             %result = &CCLib::sendmserver(@full_xaction);
1075             $^W=1;
1076           } elsif ( $processor eq 'cybercash3.2' ) {
1077             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1078           } else {
1079             $dbh->rollback if $oldAutoCommit;
1080             return "Unknown real-time processor $processor";
1081           }
1082
1083           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1084           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1085           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1086             my $cust_pay = new FS::cust_pay ( {
1087                'invnum'   => $cust_bill->invnum,
1088                'paid'     => $amount,
1089                '_date'     => '',
1090                'payby'    => 'CARD',
1091                'payinfo'  => $self->payinfo,
1092                'paybatch' => "$processor:$paybatch",
1093             } );
1094             my $error = $cust_pay->insert;
1095             if ( $error ) {
1096               # gah, even with transactions.
1097               $dbh->commit if $oldAutoCommit; #well.
1098               my $e = 'WARNING: Card debited but database not updated - '.
1099                       'error applying payment, invnum #' . $cust_bill->invnum.
1100                       " (CyberCash Order-ID $paybatch): $error";
1101               warn $e;
1102               return $e;
1103             }
1104           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1105                  || $options{'report_badcard'} ) {
1106              $dbh->commit if $oldAutoCommit;
1107              return 'Cybercash error, invnum #' .
1108                $cust_bill->invnum. ':'. $result{'MErrMsg'};
1109           } else {
1110             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1111             return '';
1112           }
1113
1114         } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1115
1116           my($payname, $payfirst, $paylast);
1117           if ( $self->payname ) {
1118             $payname = $self->payname;
1119             $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1120               or do {
1121                       $dbh->rollback if $oldAutoCommit;
1122                       return "Illegal payname $payname";
1123                     };
1124             ($payfirst, $paylast) = ($1, $2);
1125           } else {
1126             $payfirst = $self->getfield('first');
1127             $paylast = $self->getfield('first');
1128             $payname =  "$payfirst $paylast";
1129           }
1130
1131           my $transaction = new Business::OnlinePayment( $1, @bop_options );
1132           $transaction->content(
1133             'type'           => 'CC',
1134             'login'          => $bop_login,
1135             'password'       => $bop_password,
1136             'action'         => $bop_action,
1137             'amount'         => $amount,
1138             'invoice_number' => $cust_bill->invnum,
1139             'customer_id'    => $self->custnum,
1140             'last_name'      => $paylast,
1141             'first_name'     => $payfirst,
1142             'name'           => $payname,
1143             'address'        => $address,
1144             'city'           => $self->city,
1145             'state'          => $self->state,
1146             'zip'            => $self->zip,
1147             'country'        => $self->country,
1148             'card_number'    => $self->payinfo,
1149             'expiration'     => $exp,
1150           );
1151           $transaction->submit();
1152
1153           if ( $transaction->is_success()) {
1154             my $cust_pay = new FS::cust_pay ( {
1155                'invnum'   => $cust_bill->invnum,
1156                'paid'     => $amount,
1157                '_date'     => '',
1158                'payby'    => 'CARD',
1159                'payinfo'  => $self->payinfo,
1160                'paybatch' => "$processor:". $transaction->authorization,
1161             } );
1162             my $error = $cust_pay->insert;
1163             if ( $error ) {
1164               # gah, even with transactions.
1165               $dbh->commit if $oldAutoCommit; #well.
1166               my $e = 'WARNING: Card debited but database not updated - '.
1167                       'error applying payment, invnum #' . $cust_bill->invnum.
1168                       " ($processor): $error";
1169               warn $e;
1170               return $e;
1171             }
1172           } elsif ( $options{'report_badcard'} ) {
1173             $dbh->commit if $oldAutoCommit;
1174             return "$processor error, invnum #". $cust_bill->invnum. ': '.
1175                    $transaction->result_code. ": ". $transaction->error_message;
1176           } else {
1177             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1178             return ''
1179           }
1180
1181         } else {
1182           $dbh->rollback if $oldAutoCommit;
1183           return "Unknown real-time processor $processor\n";
1184         }
1185
1186       } else { #batch card
1187
1188        my $cust_pay_batch = new FS::cust_pay_batch ( {
1189          'invnum'   => $cust_bill->getfield('invnum'),
1190          'custnum'  => $self->getfield('custnum'),
1191          'last'     => $self->getfield('last'),
1192          'first'    => $self->getfield('first'),
1193          'address1' => $self->getfield('address1'),
1194          'address2' => $self->getfield('address2'),
1195          'city'     => $self->getfield('city'),
1196          'state'    => $self->getfield('state'),
1197          'zip'      => $self->getfield('zip'),
1198          'country'  => $self->getfield('country'),
1199          'trancode' => 77,
1200          'cardnum'  => $self->getfield('payinfo'),
1201          'exp'      => $self->getfield('paydate'),
1202          'payname'  => $self->getfield('payname'),
1203          'amount'   => $amount,
1204        } );
1205        my $error = $cust_pay_batch->insert;
1206        if ( $error ) {
1207          $dbh->rollback if $oldAutoCommit;
1208          return "Error adding to cust_pay_batch: $error";
1209        }
1210
1211       }
1212
1213     } else {
1214       $dbh->rollback if $oldAutoCommit;
1215       return "Unknown payment type ". $self->payby;
1216     }
1217
1218   }
1219   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1220   '';
1221
1222 }
1223
1224 =item total_owed
1225
1226 Returns the total owed for this customer on all invoices
1227 (see L<FS::cust_bill>).
1228
1229 =cut
1230
1231 sub total_owed {
1232   my $self = shift;
1233   my $total_bill = 0;
1234   foreach my $cust_bill ( qsearch('cust_bill', {
1235     'custnum' => $self->custnum,
1236   } ) ) {
1237     $total_bill += $cust_bill->owed;
1238   }
1239   sprintf( "%.2f", $total_bill );
1240 }
1241
1242 =item apply_credits
1243
1244 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
1245 of any remaining unapplied credits available for refund (see L<FS::cust_refund>).
1246
1247 =cut
1248
1249 sub apply_credits {
1250   my $self = shift;
1251
1252   return 0 unless $self->total_credited;
1253
1254   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1255       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1256
1257   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1258       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1259
1260   my $credit;
1261
1262   foreach my $cust_bill ( @invoices ) {
1263     my $amount;
1264
1265     if (!(defined $credit) || $credit->credited == 0) {
1266       $credit = pop @credits;
1267       last unless defined $credit;
1268     }
1269
1270     if ($cust_bill->owed >= $credit->credited) {
1271       $amount=$credit->credited;
1272     }else{
1273       $amount=$cust_bill->owed;
1274     }
1275
1276     my $cust_credit_bill = new FS::cust_credit_bill ( {
1277       'crednum' => $credit->crednum,
1278       'invnum'  => $cust_bill->invnum,
1279       'amount'  => $amount,
1280       '_date'   => time,
1281     } );
1282     my $error = $cust_credit_bill->insert;
1283     die $error if $error;
1284
1285     redo if ($cust_bill->owed > 0);
1286
1287   }
1288
1289   return $self->total_credited;
1290 }
1291
1292
1293 =item total_credited
1294
1295 Returns the total credits (see L<FS::cust_credit>) for this customer.
1296
1297 =cut
1298
1299 sub total_credited {
1300   my $self = shift;
1301   my $total_credit = 0;
1302   foreach my $cust_credit ( qsearch('cust_credit', {
1303     'custnum' => $self->custnum,
1304   } ) ) {
1305     $total_credit += $cust_credit->credited;
1306   }
1307   sprintf( "%.2f", $total_credit );
1308 }
1309
1310 =item balance
1311
1312 Returns the balance for this customer (total owed minus total credited).
1313
1314 =cut
1315
1316 sub balance {
1317   my $self = shift;
1318   sprintf( "%.2f", $self->total_owed - $self->total_credited );
1319 }
1320
1321 =item invoicing_list [ ARRAYREF ]
1322
1323 If an arguement is given, sets these email addresses as invoice recipients
1324 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1325 (except as warnings), so use check_invoicing_list first.
1326
1327 Returns a list of email addresses (with svcnum entries expanded).
1328
1329 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1330 check it without disturbing anything by passing nothing.
1331
1332 This interface may change in the future.
1333
1334 =cut
1335
1336 sub invoicing_list {
1337   my( $self, $arrayref ) = @_;
1338   if ( $arrayref ) {
1339     my @cust_main_invoice;
1340     if ( $self->custnum ) {
1341       @cust_main_invoice =
1342         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1343     } else {
1344       @cust_main_invoice = ();
1345     }
1346     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1347       #warn $cust_main_invoice->destnum;
1348       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1349         #warn $cust_main_invoice->destnum;
1350         my $error = $cust_main_invoice->delete;
1351         warn $error if $error;
1352       }
1353     }
1354     if ( $self->custnum ) {
1355       @cust_main_invoice =
1356         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1357     } else {
1358       @cust_main_invoice = ();
1359     }
1360     foreach my $address ( @{$arrayref} ) {
1361       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1362         my $cust_main_invoice = new FS::cust_main_invoice ( {
1363           'custnum' => $self->custnum,
1364           'dest'    => $address,
1365         } );
1366         my $error = $cust_main_invoice->insert;
1367         warn $error if $error;
1368       }
1369     }
1370   }
1371   if ( $self->custnum ) {
1372     map { $_->address }
1373       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1374   } else {
1375     ();
1376   }
1377 }
1378
1379 =item check_invoicing_list ARRAYREF
1380
1381 Checks these arguements as valid input for the invoicing_list method.  If there
1382 is an error, returns the error, otherwise returns false.
1383
1384 =cut
1385
1386 sub check_invoicing_list {
1387   my( $self, $arrayref ) = @_;
1388   foreach my $address ( @{$arrayref} ) {
1389     my $cust_main_invoice = new FS::cust_main_invoice ( {
1390       'custnum' => $self->custnum,
1391       'dest'    => $address,
1392     } );
1393     my $error = $self->custnum
1394                 ? $cust_main_invoice->check
1395                 : $cust_main_invoice->checkdest
1396     ;
1397     return $error if $error;
1398   }
1399   '';
1400 }
1401
1402 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1403
1404 Returns an array of customers referred by this customer (referral_custnum set
1405 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1406 customers referred by customers referred by this customer and so on, inclusive.
1407 The default behavior is DEPTH 1 (no recursion).
1408
1409 =cut
1410
1411 sub referral_cust_main {
1412   my $self = shift;
1413   my $depth = @_ ? shift : 1;
1414   my $exclude = @_ ? shift : {};
1415
1416   my @cust_main =
1417     map { $exclude->{$_->custnum}++; $_; }
1418       grep { ! $exclude->{ $_->custnum } }
1419         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1420
1421   if ( $depth > 1 ) {
1422     push @cust_main,
1423       map { $_->referral_cust_main($depth-1, $exclude) }
1424         @cust_main;
1425   }
1426
1427   @cust_main;
1428 }
1429
1430 =back
1431
1432 =head1 SUBROUTINES
1433
1434 =over 4
1435
1436 =item rebuild_fuzzyfile
1437
1438 =cut
1439
1440 sub rebuild_fuzzyfiles {
1441   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1442   push @all_last,
1443                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1444       if defined dbdef->table('cust_main')->column('ship_last');
1445 #  open(
1446
1447 }
1448
1449 =back
1450
1451 =head1 VERSION
1452
1453 $Id: cust_main.pm,v 1.25 2001-09-01 22:28:51 jeff Exp $
1454
1455 =head1 BUGS
1456
1457 The delete method.
1458
1459 The delete method should possibly take an FS::cust_main object reference
1460 instead of a scalar customer number.
1461
1462 Bill and collect options should probably be passed as references instead of a
1463 list.
1464
1465 CyberCash v2 forces us to define some variables in package main.
1466
1467 There should probably be a configuration file with a list of allowed credit
1468 card types.
1469
1470 No multiple currency support (probably a larger project than just this module).
1471
1472 =head1 SEE ALSO
1473
1474 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1475 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1476 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1477 L<FS::UID>, schema.html from the base documentation.
1478
1479 =cut
1480
1481 1;
1482
1483