FS/FS/cust_main.pm

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