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