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   $self->total_owed_date(2145859200); #12/31/2037
1420 }
1421
1422 =item total_owed_date TIME
1423
1424 Returns the total owed for this customer on all invoices with date earlier than
1425 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1426 see L<Time::Local> and L<Date::Parse> for conversion functions.
1427
1428 =cut
1429
1430 sub total_owed_date {
1431   my $self = shift;
1432   my $time = shift;
1433   my $total_bill = 0;
1434   foreach my $cust_bill (
1435     grep { $_->_date <= $time }
1436       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1437   ) {
1438     $total_bill += $cust_bill->owed;
1439   }
1440   sprintf( "%.2f", $total_bill );
1441 }
1442
1443 =item apply_credits
1444
1445 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1446 to outstanding invoice balances in chronological order and returns the value
1447 of any remaining unapplied credits available for refund
1448 (see L<FS::cust_refund>).
1449
1450 =cut
1451
1452 sub apply_credits {
1453   my $self = shift;
1454
1455   return 0 unless $self->total_credited;
1456
1457   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1458       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1459
1460   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1461       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1462
1463   my $credit;
1464
1465   foreach my $cust_bill ( @invoices ) {
1466     my $amount;
1467
1468     if ( !defined($credit) || $credit->credited == 0) {
1469       $credit = pop @credits or last;
1470     }
1471
1472     if ($cust_bill->owed >= $credit->credited) {
1473       $amount=$credit->credited;
1474     }else{
1475       $amount=$cust_bill->owed;
1476     }
1477
1478     my $cust_credit_bill = new FS::cust_credit_bill ( {
1479       'crednum' => $credit->crednum,
1480       'invnum'  => $cust_bill->invnum,
1481       'amount'  => $amount,
1482     } );
1483     my $error = $cust_credit_bill->insert;
1484     die $error if $error;
1485
1486     redo if ($cust_bill->owed > 0);
1487
1488   }
1489
1490   return $self->total_credited;
1491 }
1492
1493 =item apply_payments
1494
1495 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1496 to outstanding invoice balances in chronological order.
1497
1498  #and returns the value of any remaining unapplied payments.
1499
1500 =cut
1501
1502 sub apply_payments {
1503   my $self = shift;
1504
1505   #return 0 unless
1506
1507   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1508       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1509
1510   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1511       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1512
1513   my $payment;
1514
1515   foreach my $cust_bill ( @invoices ) {
1516     my $amount;
1517
1518     if ( !defined($payment) || $payment->unapplied == 0 ) {
1519       $payment = pop @payments or last;
1520     }
1521
1522     if ( $cust_bill->owed >= $payment->unapplied ) {
1523       $amount = $payment->unapplied;
1524     } else {
1525       $amount = $cust_bill->owed;
1526     }
1527
1528     my $cust_bill_pay = new FS::cust_bill_pay ( {
1529       'paynum' => $payment->paynum,
1530       'invnum' => $cust_bill->invnum,
1531       'amount' => $amount,
1532     } );
1533     my $error = $cust_bill_pay->insert;
1534     die $error if $error;
1535
1536     redo if ( $cust_bill->owed > 0);
1537
1538   }
1539
1540   return $self->total_unapplied_payments;
1541 }
1542
1543 =item total_credited
1544
1545 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1546 customer.  See L<FS::cust_credit/credited>.
1547
1548 =cut
1549
1550 sub total_credited {
1551   my $self = shift;
1552   my $total_credit = 0;
1553   foreach my $cust_credit ( qsearch('cust_credit', {
1554     'custnum' => $self->custnum,
1555   } ) ) {
1556     $total_credit += $cust_credit->credited;
1557   }
1558   sprintf( "%.2f", $total_credit );
1559 }
1560
1561 =item total_unapplied_payments
1562
1563 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1564 See L<FS::cust_pay/unapplied>.
1565
1566 =cut
1567
1568 sub total_unapplied_payments {
1569   my $self = shift;
1570   my $total_unapplied = 0;
1571   foreach my $cust_pay ( qsearch('cust_pay', {
1572     'custnum' => $self->custnum,
1573   } ) ) {
1574     $total_unapplied += $cust_pay->unapplied;
1575   }
1576   sprintf( "%.2f", $total_unapplied );
1577 }
1578
1579 =item balance
1580
1581 Returns the balance for this customer (total_owed minus total_credited
1582 minus total_unapplied_payments).
1583
1584 =cut
1585
1586 sub balance {
1587   my $self = shift;
1588   sprintf( "%.2f",
1589     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1590   );
1591 }
1592
1593 =item balance_date TIME
1594
1595 Returns the balance for this customer, only considering invoices with date
1596 earlier than TIME (total_owed_date minus total_credited minus
1597 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1598 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1599 functions.
1600
1601 =cut
1602
1603 sub balance_date {
1604   my $self = shift;
1605   my $time = shift;
1606   sprintf( "%.2f",
1607     $self->total_owed_date($time)
1608       - $self->total_credited
1609       - $self->total_unapplied_payments
1610   );
1611 }
1612
1613 =item invoicing_list [ ARRAYREF ]
1614
1615 If an arguement is given, sets these email addresses as invoice recipients
1616 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1617 (except as warnings), so use check_invoicing_list first.
1618
1619 Returns a list of email addresses (with svcnum entries expanded).
1620
1621 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1622 check it without disturbing anything by passing nothing.
1623
1624 This interface may change in the future.
1625
1626 =cut
1627
1628 sub invoicing_list {
1629   my( $self, $arrayref ) = @_;
1630   if ( $arrayref ) {
1631     my @cust_main_invoice;
1632     if ( $self->custnum ) {
1633       @cust_main_invoice =
1634         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1635     } else {
1636       @cust_main_invoice = ();
1637     }
1638     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1639       #warn $cust_main_invoice->destnum;
1640       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1641         #warn $cust_main_invoice->destnum;
1642         my $error = $cust_main_invoice->delete;
1643         warn $error if $error;
1644       }
1645     }
1646     if ( $self->custnum ) {
1647       @cust_main_invoice =
1648         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1649     } else {
1650       @cust_main_invoice = ();
1651     }
1652     my %seen = map { $_->address => 1 } @cust_main_invoice;
1653     foreach my $address ( @{$arrayref} ) {
1654       #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1655       next if exists $seen{$address} && $seen{$address};
1656       $seen{$address} = 1;
1657       my $cust_main_invoice = new FS::cust_main_invoice ( {
1658         'custnum' => $self->custnum,
1659         'dest'    => $address,
1660       } );
1661       my $error = $cust_main_invoice->insert;
1662       warn $error if $error;
1663     }
1664   }
1665   if ( $self->custnum ) {
1666     map { $_->address }
1667       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1668   } else {
1669     ();
1670   }
1671 }
1672
1673 =item check_invoicing_list ARRAYREF
1674
1675 Checks these arguements as valid input for the invoicing_list method.  If there
1676 is an error, returns the error, otherwise returns false.
1677
1678 =cut
1679
1680 sub check_invoicing_list {
1681   my( $self, $arrayref ) = @_;
1682   foreach my $address ( @{$arrayref} ) {
1683     my $cust_main_invoice = new FS::cust_main_invoice ( {
1684       'custnum' => $self->custnum,
1685       'dest'    => $address,
1686     } );
1687     my $error = $self->custnum
1688                 ? $cust_main_invoice->check
1689                 : $cust_main_invoice->checkdest
1690     ;
1691     return $error if $error;
1692   }
1693   '';
1694 }
1695
1696 =item default_invoicing_list
1697
1698 Returns the email addresses of any
1699
1700 =cut
1701
1702 sub default_invoicing_list {
1703   my $self = shift;
1704   my @list = ();
1705   foreach my $cust_pkg ( $self->all_pkgs ) {
1706     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1707     my @svc_acct =
1708       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1709         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1710           @cust_svc;
1711     push @list, map { $_->email } @svc_acct;
1712   }
1713   $self->invoicing_list(\@list);
1714 }
1715
1716 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1717
1718 Returns an array of customers referred by this customer (referral_custnum set
1719 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1720 customers referred by customers referred by this customer and so on, inclusive.
1721 The default behavior is DEPTH 1 (no recursion).
1722
1723 =cut
1724
1725 sub referral_cust_main {
1726   my $self = shift;
1727   my $depth = @_ ? shift : 1;
1728   my $exclude = @_ ? shift : {};
1729
1730   my @cust_main =
1731     map { $exclude->{$_->custnum}++; $_; }
1732       grep { ! $exclude->{ $_->custnum } }
1733         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1734
1735   if ( $depth > 1 ) {
1736     push @cust_main,
1737       map { $_->referral_cust_main($depth-1, $exclude) }
1738         @cust_main;
1739   }
1740
1741   @cust_main;
1742 }
1743
1744 =item referral_cust_pkg [ DEPTH ]
1745
1746 Like referral_cust_main, except returns a flat list of all unsuspended packages
1747 for each customer.  The number of items in this list may be useful for
1748 comission calculations (perhaps after a grep).
1749
1750 =cut
1751
1752 sub referral_cust_pkg {
1753   my $self = shift;
1754   my $depth = @_ ? shift : 1;
1755
1756   map { $_->unsuspended_pkgs }
1757     grep { $_->unsuspended_pkgs }
1758       $self->referral_cust_main($depth);
1759 }
1760
1761 =item credit AMOUNT, REASON
1762
1763 Applies a credit to this customer.  If there is an error, returns the error,
1764 otherwise returns false.
1765
1766 =cut
1767
1768 sub credit {
1769   my( $self, $amount, $reason ) = @_;
1770   my $cust_credit = new FS::cust_credit {
1771     'custnum' => $self->custnum,
1772     'amount'  => $amount,
1773     'reason'  => $reason,
1774   };
1775   $cust_credit->insert;
1776 }
1777
1778 =back
1779
1780 =head1 SUBROUTINES
1781
1782 =over 4
1783
1784 =item check_and_rebuild_fuzzyfiles
1785
1786 =cut
1787
1788 sub check_and_rebuild_fuzzyfiles {
1789   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1790   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1791     or &rebuild_fuzzyfiles;
1792 }
1793
1794 =item rebuild_fuzzyfiles
1795
1796 =cut
1797
1798 sub rebuild_fuzzyfiles {
1799
1800   use Fcntl qw(:flock);
1801
1802   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1803
1804   #last
1805
1806   open(LASTLOCK,">>$dir/cust_main.last")
1807     or die "can't open $dir/cust_main.last: $!";
1808   flock(LASTLOCK,LOCK_EX)
1809     or die "can't lock $dir/cust_main.last: $!";
1810
1811   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1812   push @all_last,
1813                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1814     if defined dbdef->table('cust_main')->column('ship_last');
1815
1816   open (LASTCACHE,">$dir/cust_main.last.tmp")
1817     or die "can't open $dir/cust_main.last.tmp: $!";
1818   print LASTCACHE join("\n", @all_last), "\n";
1819   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1820
1821   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1822   close LASTLOCK;
1823
1824   #company
1825
1826   open(COMPANYLOCK,">>$dir/cust_main.company")
1827     or die "can't open $dir/cust_main.company: $!";
1828   flock(COMPANYLOCK,LOCK_EX)
1829     or die "can't lock $dir/cust_main.company: $!";
1830
1831   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1832   push @all_company,
1833        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1834     if defined dbdef->table('cust_main')->column('ship_last');
1835
1836   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1837     or die "can't open $dir/cust_main.company.tmp: $!";
1838   print COMPANYCACHE join("\n", @all_company), "\n";
1839   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1840
1841   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1842   close COMPANYLOCK;
1843
1844 }
1845
1846 =item all_last
1847
1848 =cut
1849
1850 sub all_last {
1851   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1852   open(LASTCACHE,"<$dir/cust_main.last")
1853     or die "can't open $dir/cust_main.last: $!";
1854   my @array = map { chomp; $_; } <LASTCACHE>;
1855   close LASTCACHE;
1856   \@array;
1857 }
1858
1859 =item all_company
1860
1861 =cut
1862
1863 sub all_company {
1864   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1865   open(COMPANYCACHE,"<$dir/cust_main.company")
1866     or die "can't open $dir/cust_main.last: $!";
1867   my @array = map { chomp; $_; } <COMPANYCACHE>;
1868   close COMPANYCACHE;
1869   \@array;
1870 }
1871
1872 =item append_fuzzyfiles LASTNAME COMPANY
1873
1874 =cut
1875
1876 sub append_fuzzyfiles {
1877   my( $last, $company ) = @_;
1878
1879   &check_and_rebuild_fuzzyfiles;
1880
1881   use Fcntl qw(:flock);
1882
1883   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1884
1885   if ( $last ) {
1886
1887     open(LAST,">>$dir/cust_main.last")
1888       or die "can't open $dir/cust_main.last: $!";
1889     flock(LAST,LOCK_EX)
1890       or die "can't lock $dir/cust_main.last: $!";
1891
1892     print LAST "$last\n";
1893
1894     flock(LAST,LOCK_UN)
1895       or die "can't unlock $dir/cust_main.last: $!";
1896     close LAST;
1897   }
1898
1899   if ( $company ) {
1900
1901     open(COMPANY,">>$dir/cust_main.company")
1902       or die "can't open $dir/cust_main.company: $!";
1903     flock(COMPANY,LOCK_EX)
1904       or die "can't lock $dir/cust_main.company: $!";
1905
1906     print COMPANY "$company\n";
1907
1908     flock(COMPANY,LOCK_UN)
1909       or die "can't unlock $dir/cust_main.company: $!";
1910
1911     close COMPANY;
1912   }
1913
1914   1;
1915 }
1916
1917 =head1 VERSION
1918
1919 $Id: cust_main.pm,v 1.51 2001-12-26 11:17:49 ivan Exp $
1920
1921 =head1 BUGS
1922
1923 The delete method.
1924
1925 The delete method should possibly take an FS::cust_main object reference
1926 instead of a scalar customer number.
1927
1928 Bill and collect options should probably be passed as references instead of a
1929 list.
1930
1931 CyberCash v2 forces us to define some variables in package main.
1932
1933 There should probably be a configuration file with a list of allowed credit
1934 card types.
1935
1936 No multiple currency support (probably a larger project than just this module).
1937
1938 =head1 SEE ALSO
1939
1940 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1941 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1942 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1943 L<FS::UID>, schema.html from the base documentation.
1944
1945 =cut
1946
1947 1;
1948
1949