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