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->getfield('custnum') } )
 860   ) {
 861
 862     next if $cust_pkg->getfield('cancel');
 863
 864     #? to avoid use of uninitialized value errors... ?
 865     $cust_pkg->setfield('bill', '')
 866       unless defined($cust_pkg->bill);
 867
 868     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 869
 870     #so we don't modify cust_pkg record unnecessarily
 871     my $cust_pkg_mod_flag = 0;
 872     my %hash = $cust_pkg->hash;
 873     my $old_cust_pkg = new FS::cust_pkg \%hash;
 874
 875     # bill setup
 876     my $setup = 0;
 877     unless ( $cust_pkg->setup ) {
 878       my $setup_prog = $part_pkg->getfield('setup');
 879       $setup_prog =~ /^(.*)$/ or do {
 880         $dbh->rollback if $oldAutoCommit;
 881         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 882                ": $setup_prog";
 883       };
 884       $setup_prog = $1;
 885
 886         #my $cpt = new Safe;
 887         ##$cpt->permit(); #what is necessary?
 888         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 889         #$setup = $cpt->reval($setup_prog);
 890       $setup = eval $setup_prog;
 891       unless ( defined($setup) ) {
 892         $dbh->rollback if $oldAutoCommit;
 893         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 894                "(expression $setup_prog): $@";
 895       }
 896       $cust_pkg->setfield('setup',$time);
 897       $cust_pkg_mod_flag=1;
 898     }
 899
 900     #bill recurring fee
 901     my $recur = 0;
 902     my $sdate;
 903     if ( $part_pkg->getfield('freq') > 0 &&
 904          ! $cust_pkg->getfield('susp') &&
 905          ( $cust_pkg->getfield('bill') || 0 ) < $time
 906     ) {
 907       my $recur_prog = $part_pkg->getfield('recur');
 908       $recur_prog =~ /^(.*)$/ or do {
 909         $dbh->rollback if $oldAutoCommit;
 910         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
 911                ": $recur_prog";
 912       };
 913       $recur_prog = $1;
 914
 915         #my $cpt = new Safe;
 916         ##$cpt->permit(); #what is necessary?
 917         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 918         #$recur = $cpt->reval($recur_prog);
 919       $recur = eval $recur_prog;
 920       unless ( defined($recur) ) {
 921         $dbh->rollback if $oldAutoCommit;
 922         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
 923                "(expression $recur_prog): $@";
 924       }
 925       #change this bit to use Date::Manip? CAREFUL with timezones (see
 926       # mailing list archive)
 927       #$sdate=$cust_pkg->bill || time;
 928       #$sdate=$cust_pkg->bill || $time;
 929       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 930       my ($sec,$min,$hour,$mday,$mon,$year) =
 931         (localtime($sdate) )[0,1,2,3,4,5];
 932       $mon += $part_pkg->getfield('freq');
 933       until ( $mon < 12 ) { $mon -= 12; $year++; }
 934       $cust_pkg->setfield('bill',
 935         timelocal($sec,$min,$hour,$mday,$mon,$year));
 936       $cust_pkg_mod_flag = 1;
 937     }
 938
 939     warn "\$setup is undefined" unless defined($setup);
 940     warn "\$recur is undefined" unless defined($recur);
 941     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 942
 943     if ( $cust_pkg_mod_flag ) {
 944       $error=$cust_pkg->replace($old_cust_pkg);
 945       if ( $error ) { #just in case
 946         $dbh->rollback if $oldAutoCommit;
 947         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
 948       }
 949       $setup = sprintf( "%.2f", $setup );
 950       $recur = sprintf( "%.2f", $recur );
 951       if ( $setup < 0 ) {
 952         $dbh->rollback if $oldAutoCommit;
 953         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 954       }
 955       if ( $recur < 0 ) {
 956         $dbh->rollback if $oldAutoCommit;
 957         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 958       }
 959       if ( $setup > 0 || $recur > 0 ) {
 960         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 961           'pkgnum' => $cust_pkg->pkgnum,
 962           'setup'  => $setup,
 963           'recur'  => $recur,
 964           'sdate'  => $sdate,
 965           'edate'  => $cust_pkg->bill,
 966         });
 967         push @cust_bill_pkg, $cust_bill_pkg;
 968         $total_setup += $setup;
 969         $total_recur += $recur;
 970         $taxable_setup += $setup
 971           unless $part_pkg->dbdef_table->column('setuptax')
 972                  || $part_pkg->setuptax =~ /^Y$/i;
 973         $taxable_recur += $recur
 974           unless $part_pkg->dbdef_table->column('recurtax')
 975                  || $part_pkg->recurtax =~ /^Y$/i;
 976       }
 977     }
 978
 979   }
 980
 981   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 982   my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
 983
 984   unless ( @cust_bill_pkg ) {
 985     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 986     return '';
 987   }
 988
 989   unless ( $self->tax =~ /Y/i
 990            || $self->payby eq 'COMP'
 991            || $taxable_charged == 0 ) {
 992     my $cust_main_county = qsearchs('cust_main_county',{
 993         'state'   => $self->state,
 994         'county'  => $self->county,
 995         'country' => $self->country,
 996     } );
 997     my $tax = sprintf( "%.2f",
 998       $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
 999     );
1000
1001     if ( $tax > 0 ) {
1002       $charged = sprintf( "%.2f", $charged+$tax );
1003
1004       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1005         'pkgnum' => 0,
1006         'setup'  => $tax,
1007         'recur'  => 0,
1008         'sdate'  => '',
1009         'edate'  => '',
1010       });
1011       push @cust_bill_pkg, $cust_bill_pkg;
1012     }
1013   }
1014
1015   my $cust_bill = new FS::cust_bill ( {
1016     'custnum' => $self->custnum,
1017     '_date'   => $time,
1018     'charged' => $charged,
1019   } );
1020   $error = $cust_bill->insert;
1021   if ( $error ) {
1022     $dbh->rollback if $oldAutoCommit;
1023     return "can't create invoice for customer #". $self->custnum. ": $error";
1024   }
1025
1026   my $invnum = $cust_bill->invnum;
1027   my $cust_bill_pkg;
1028   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1029     #warn $cust_bill_pkg->invnum($invnum);
1030     $error = $cust_bill_pkg->insert;
1031     if ( $error ) {
1032       $dbh->rollback if $oldAutoCommit;
1033       return "can't create invoice line item for customer #". $self->custnum.
1034              ": $error";
1035     }
1036   }
1037
1038   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1039   ''; #no error
1040 }
1041
1042 =item collect OPTIONS
1043
1044 (Attempt to) collect money for this customer's outstanding invoices (see
1045 L<FS::cust_bill>).  Usually used after the bill method.
1046
1047 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1048 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1049
1050 If there is an error, returns the error, otherwise returns false.
1051
1052 Options are passed as name-value pairs.
1053
1054 Currently available options are:
1055
1056 invoice_time - Use this time when deciding when to print invoices and
1057 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>
1058 for conversion functions.
1059
1060 batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>).  By
1061 default, cards are processed immediately, which will generate an error if
1062 CyberCash is not installed.
1063
1064 report_badcard - Set this true if you want bad card transactions to
1065 return an error.  By default, they don't.
1066
1067 =cut
1068
1069 sub collect {
1070   my( $self, %options ) = @_;
1071   my $invoice_time = $options{'invoice_time'} || time;
1072
1073   #put below somehow?
1074   local $SIG{HUP} = 'IGNORE';
1075   local $SIG{INT} = 'IGNORE';
1076   local $SIG{QUIT} = 'IGNORE';
1077   local $SIG{TERM} = 'IGNORE';
1078   local $SIG{TSTP} = 'IGNORE';
1079   local $SIG{PIPE} = 'IGNORE';
1080
1081   my $oldAutoCommit = $FS::UID::AutoCommit;
1082   local $FS::UID::AutoCommit = 0;
1083   my $dbh = dbh;
1084
1085   my $balance = $self->balance;
1086   warn "collect: balance $balance" if $Debug;
1087   unless ( $balance > 0 ) { #redundant?????
1088     $dbh->rollback if $oldAutoCommit; #hmm
1089     return '';
1090   }
1091
1092   foreach my $cust_bill (
1093     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1094   ) {
1095
1096     #this has to be before next's
1097     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1098                                   ? $balance
1099                                   : $cust_bill->owed
1100     );
1101     $balance = sprintf( "%.2f", $balance - $amount );
1102
1103     next unless $cust_bill->owed > 0;
1104
1105     # don't try to charge for the same invoice if it's already in a batch
1106     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1107
1108     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1109
1110     next unless $amount > 0;
1111
1112     if ( $self->payby eq 'BILL' ) {
1113
1114       #30 days 2592000
1115       my $since = $invoice_time - ( $cust_bill->_date || 0 );
1116       #warn "$invoice_time ", $cust_bill->_date, " $since";
1117       if ( $since >= 0 #don't print future invoices
1118            && ( $cust_bill->printed * 2592000 ) <= $since
1119       ) {
1120
1121         #my @print_text = $cust_bill->print_text; #( date )
1122         my @invoicing_list = $self->invoicing_list;
1123         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
1124           $ENV{SMTPHOSTS} = $smtpmachine;
1125           $ENV{MAILADDRESS} = $invoice_from;
1126           my $header = new Mail::Header ( [
1127             "From: $invoice_from",
1128             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
1129             "Sender: $invoice_from",
1130             "Reply-To: $invoice_from",
1131             "Date: ". time2str("%a, %d %b %Y %X %z", time),
1132             "Subject: Invoice",
1133           ] );
1134           my $message = new Mail::Internet (
1135             'Header' => $header,
1136             'Body' => [ $cust_bill->print_text ], #( date)
1137           );
1138           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
1139
1140         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
1141           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
1142           print LPR $cust_bill->print_text; #( date )
1143           close LPR
1144             or die $! ? "Error closing $lpr: $!"
1145                          : "Exit status $? from $lpr";
1146         }
1147
1148         my %hash = $cust_bill->hash;
1149         $hash{'printed'}++;
1150         my $new_cust_bill = new FS::cust_bill(\%hash);
1151         my $error = $new_cust_bill->replace($cust_bill);
1152         warn "Error updating $cust_bill->printed: $error" if $error;
1153
1154       }
1155
1156     } elsif ( $self->payby eq 'COMP' ) {
1157       my $cust_pay = new FS::cust_pay ( {
1158          'invnum' => $cust_bill->invnum,
1159          'paid' => $amount,
1160          '_date' => '',
1161          'payby' => 'COMP',
1162          'payinfo' => $self->payinfo,
1163          'paybatch' => ''
1164       } );
1165       my $error = $cust_pay->insert;
1166       if ( $error ) {
1167         $dbh->rollback if $oldAutoCommit;
1168         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
1169       }
1170
1171
1172     } elsif ( $self->payby eq 'CARD' ) {
1173
1174       if ( $options{'batch_card'} ne 'yes' ) {
1175
1176         unless ( $processor ) {
1177           $dbh->rollback if $oldAutoCommit;
1178           return "Real time card processing not enabled!";
1179         }
1180
1181         my $address = $self->address1;
1182         $address .= ", ". $self->address2 if $self->address2;
1183
1184         #fix exp. date
1185         #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1186         $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1187         my $exp = "$2/$1";
1188
1189         if ( $processor eq 'cybercash3.2' ) {
1190
1191           #fix exp. date for cybercash
1192           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
1193           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1194           my $exp = "$2/$1";
1195
1196           my $paybatch = $cust_bill->invnum.
1197                          '-' . time2str("%y%m%d%H%M%S", time);
1198
1199           my $payname = $self->payname ||
1200                         $self->getfield('first'). ' '. $self->getfield('last');
1201
1202
1203           my $country = $self->country eq 'US' ? 'USA' : $self->country;
1204
1205           my @full_xaction = ( $xaction,
1206             'Order-ID'     => $paybatch,
1207             'Amount'       => "usd $amount",
1208             'Card-Number'  => $self->getfield('payinfo'),
1209             'Card-Name'    => $payname,
1210             'Card-Address' => $address,
1211             'Card-City'    => $self->getfield('city'),
1212             'Card-State'   => $self->getfield('state'),
1213             'Card-Zip'     => $self->getfield('zip'),
1214             'Card-Country' => $country,
1215             'Card-Exp'     => $exp,
1216           );
1217
1218           my %result;
1219           %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
1220
1221           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
1222           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
1223           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
1224             my $cust_pay = new FS::cust_pay ( {
1225                'invnum'   => $cust_bill->invnum,
1226                'paid'     => $amount,
1227                '_date'     => '',
1228                'payby'    => 'CARD',
1229                'payinfo'  => $self->payinfo,
1230                'paybatch' => "$processor:$paybatch",
1231             } );
1232             my $error = $cust_pay->insert;
1233             if ( $error ) {
1234               # gah, even with transactions.
1235               $dbh->commit if $oldAutoCommit; #well.
1236               my $e = 'WARNING: Card debited but database not updated - '.
1237                       'error applying payment, invnum #' . $cust_bill->invnum.
1238                       " (CyberCash Order-ID $paybatch): $error";
1239               warn $e;
1240               return $e;
1241             }
1242           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1243                  || $options{'report_badcard'} ) {
1244              $dbh->commit if $oldAutoCommit;
1245              return 'Cybercash error, invnum #' .
1246                $cust_bill->invnum. ':'. $result{'MErrMsg'};
1247           } else {
1248             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1249             return '';
1250           }
1251
1252         } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
1253
1254           my $bop_processor = $1;
1255
1256           my($payname, $payfirst, $paylast);
1257           if ( $self->payname ) {
1258             $payname = $self->payname;
1259             $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
1260               or do {
1261                       $dbh->rollback if $oldAutoCommit;
1262                       return "Illegal payname $payname";
1263                     };
1264             ($payfirst, $paylast) = ($1, $2);
1265           } else {
1266             $payfirst = $self->getfield('first');
1267             $paylast = $self->getfield('first');
1268             $payname =  "$payfirst $paylast";
1269           }
1270
1271           my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1272           if ( $conf->exists('emailinvoiceauto')
1273                || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1274             push @invoicing_list, $self->default_invoicing_list;
1275           }
1276           my $email = $invoicing_list[0];
1277
1278           my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
1279
1280           my $transaction =
1281             new Business::OnlinePayment( $bop_processor, @bop_options );
1282           $transaction->content(
1283             'type'           => 'CC',
1284             'login'          => $bop_login,
1285             'password'       => $bop_password,
1286             'action'         => $action1,
1287             'description'    => 'Internet Services',
1288             'amount'         => $amount,
1289             'invoice_number' => $cust_bill->invnum,
1290             'customer_id'    => $self->custnum,
1291             'last_name'      => $paylast,
1292             'first_name'     => $payfirst,
1293             'name'           => $payname,
1294             'address'        => $address,
1295             'city'           => $self->city,
1296             'state'          => $self->state,
1297             'zip'            => $self->zip,
1298             'country'        => $self->country,
1299             'card_number'    => $self->payinfo,
1300             'expiration'     => $exp,
1301             'referer'        => 'http://cleanwhisker.420.am/',
1302             'email'          => $email,
1303           );
1304           $transaction->submit();
1305
1306           if ( $transaction->is_success() && $action2 ) {
1307             my $auth = $transaction->authorization;
1308             my $ordernum = $transaction->order_number;
1309             #warn "********* $auth ***********\n";
1310             #warn "********* $ordernum ***********\n";
1311             my $capture =
1312               new Business::OnlinePayment( $bop_processor, @bop_options );
1313
1314             $capture->content(
1315               action         => $action2,
1316               login          => $bop_login,
1317               password       => $bop_password,
1318               order_number   => $ordernum,
1319               amount         => $amount,
1320               authorization  => $auth,
1321               description    => 'Internet Services',
1322             );
1323
1324             $capture->submit();
1325
1326             unless ( $capture->is_success ) {
1327               my $e = "Authorization sucessful but capture failed, invnum #".
1328                       $cust_bill->invnum. ': '.  $capture->result_code.
1329                       ": ". $capture->error_message;
1330               warn $e;
1331               return $e;
1332             }
1333
1334           }
1335
1336           if ( $transaction->is_success() ) {
1337
1338             my $cust_pay = new FS::cust_pay ( {
1339                'invnum'   => $cust_bill->invnum,
1340                'paid'     => $amount,
1341                '_date'     => '',
1342                'payby'    => 'CARD',
1343                'payinfo'  => $self->payinfo,
1344                'paybatch' => "$processor:". $transaction->authorization,
1345             } );
1346             my $error = $cust_pay->insert;
1347             if ( $error ) {
1348               # gah, even with transactions.
1349               $dbh->commit if $oldAutoCommit; #well.
1350               my $e = 'WARNING: Card debited but database not updated - '.
1351                       'error applying payment, invnum #' . $cust_bill->invnum.
1352                       " ($processor): $error";
1353               warn $e;
1354               return $e;
1355             }
1356           } elsif ( $options{'report_badcard'} ) {
1357             $dbh->commit if $oldAutoCommit;
1358             return "$processor error, invnum #". $cust_bill->invnum. ': '.
1359                    $transaction->result_code. ": ". $transaction->error_message;
1360           } else {
1361             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1362             #return '';
1363           }
1364
1365         } else {
1366           $dbh->rollback if $oldAutoCommit;
1367           return "Unknown real-time processor $processor\n";
1368         }
1369
1370       } else { #batch card
1371
1372        my $cust_pay_batch = new FS::cust_pay_batch ( {
1373          'invnum'   => $cust_bill->getfield('invnum'),
1374          'custnum'  => $self->getfield('custnum'),
1375          'last'     => $self->getfield('last'),
1376          'first'    => $self->getfield('first'),
1377          'address1' => $self->getfield('address1'),
1378          'address2' => $self->getfield('address2'),
1379          'city'     => $self->getfield('city'),
1380          'state'    => $self->getfield('state'),
1381          'zip'      => $self->getfield('zip'),
1382          'country'  => $self->getfield('country'),
1383          'trancode' => 77,
1384          'cardnum'  => $self->getfield('payinfo'),
1385          'exp'      => $self->getfield('paydate'),
1386          'payname'  => $self->getfield('payname'),
1387          'amount'   => $amount,
1388        } );
1389        my $error = $cust_pay_batch->insert;
1390        if ( $error ) {
1391          $dbh->rollback if $oldAutoCommit;
1392          return "Error adding to cust_pay_batch: $error";
1393        }
1394
1395       }
1396
1397     } else {
1398       $dbh->rollback if $oldAutoCommit;
1399       return "Unknown payment type ". $self->payby;
1400     }
1401
1402   }
1403   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1404   '';
1405
1406 }
1407
1408 =item total_owed
1409
1410 Returns the total owed for this customer on all invoices
1411 (see L<FS::cust_bill/owed>).
1412
1413 =cut
1414
1415 sub total_owed {
1416   my $self = shift;
1417   my $total_bill = 0;
1418   foreach my $cust_bill ( qsearch('cust_bill', {
1419     'custnum' => $self->custnum,
1420   } ) ) {
1421     $total_bill += $cust_bill->owed;
1422   }
1423   sprintf( "%.2f", $total_bill );
1424 }
1425
1426 =item apply_credits
1427
1428 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1429 to outstanding invoice balances in chronological order and returns the value
1430 of any remaining unapplied credits available for refund
1431 (see L<FS::cust_refund>).
1432
1433 =cut
1434
1435 sub apply_credits {
1436   my $self = shift;
1437
1438   return 0 unless $self->total_credited;
1439
1440   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1441       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1442
1443   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1444       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1445
1446   my $credit;
1447
1448   foreach my $cust_bill ( @invoices ) {
1449     my $amount;
1450
1451     if ( !defined($credit) || $credit->credited == 0) {
1452       $credit = pop @credits or last;
1453     }
1454
1455     if ($cust_bill->owed >= $credit->credited) {
1456       $amount=$credit->credited;
1457     }else{
1458       $amount=$cust_bill->owed;
1459     }
1460
1461     my $cust_credit_bill = new FS::cust_credit_bill ( {
1462       'crednum' => $credit->crednum,
1463       'invnum'  => $cust_bill->invnum,
1464       'amount'  => $amount,
1465     } );
1466     my $error = $cust_credit_bill->insert;
1467     die $error if $error;
1468
1469     redo if ($cust_bill->owed > 0);
1470
1471   }
1472
1473   return $self->total_credited;
1474 }
1475
1476 =item apply_payments
1477
1478 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1479 to outstanding invoice balances in chronological order.
1480
1481  #and returns the value of any remaining unapplied payments.
1482
1483 =cut
1484
1485 sub apply_payments {
1486   my $self = shift;
1487
1488   #return 0 unless
1489
1490   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1491       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1492
1493   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1494       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1495
1496   my $payment;
1497
1498   foreach my $cust_bill ( @invoices ) {
1499     my $amount;
1500
1501     if ( !defined($payment) || $payment->unapplied == 0 ) {
1502       $payment = pop @payments or last;
1503     }
1504
1505     if ( $cust_bill->owed >= $payment->unapplied ) {
1506       $amount = $payment->unapplied;
1507     } else {
1508       $amount = $cust_bill->owed;
1509     }
1510
1511     my $cust_bill_pay = new FS::cust_bill_pay ( {
1512       'paynum' => $payment->paynum,
1513       'invnum' => $cust_bill->invnum,
1514       'amount' => $amount,
1515     } );
1516     my $error = $cust_bill_pay->insert;
1517     die $error if $error;
1518
1519     redo if ( $cust_bill->owed > 0);
1520
1521   }
1522
1523   return $self->total_unapplied_payments;
1524 }
1525
1526 =item total_credited
1527
1528 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1529 customer.  See L<FS::cust_credit/credited>.
1530
1531 =cut
1532
1533 sub total_credited {
1534   my $self = shift;
1535   my $total_credit = 0;
1536   foreach my $cust_credit ( qsearch('cust_credit', {
1537     'custnum' => $self->custnum,
1538   } ) ) {
1539     $total_credit += $cust_credit->credited;
1540   }
1541   sprintf( "%.2f", $total_credit );
1542 }
1543
1544 =item total_unapplied_payments
1545
1546 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1547 See L<FS::cust_pay/unapplied>.
1548
1549 =cut
1550
1551 sub total_unapplied_payments {
1552   my $self = shift;
1553   my $total_unapplied = 0;
1554   foreach my $cust_pay ( qsearch('cust_pay', {
1555     'custnum' => $self->custnum,
1556   } ) ) {
1557     $total_unapplied += $cust_pay->unapplied;
1558   }
1559   sprintf( "%.2f", $total_unapplied );
1560 }
1561
1562 =item balance
1563
1564 Returns the balance for this customer (total_owed minus total_credited
1565 minus total_unapplied_payments).
1566
1567 =cut
1568
1569 sub balance {
1570   my $self = shift;
1571   sprintf( "%.2f",
1572     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1573   );
1574 }
1575
1576 =item invoicing_list [ ARRAYREF ]
1577
1578 If an arguement is given, sets these email addresses as invoice recipients
1579 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1580 (except as warnings), so use check_invoicing_list first.
1581
1582 Returns a list of email addresses (with svcnum entries expanded).
1583
1584 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1585 check it without disturbing anything by passing nothing.
1586
1587 This interface may change in the future.
1588
1589 =cut
1590
1591 sub invoicing_list {
1592   my( $self, $arrayref ) = @_;
1593   if ( $arrayref ) {
1594     my @cust_main_invoice;
1595     if ( $self->custnum ) {
1596       @cust_main_invoice =
1597         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1598     } else {
1599       @cust_main_invoice = ();
1600     }
1601     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1602       #warn $cust_main_invoice->destnum;
1603       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1604         #warn $cust_main_invoice->destnum;
1605         my $error = $cust_main_invoice->delete;
1606         warn $error if $error;
1607       }
1608     }
1609     if ( $self->custnum ) {
1610       @cust_main_invoice =
1611         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1612     } else {
1613       @cust_main_invoice = ();
1614     }
1615     my %seen = map { $_->address => 1 } @cust_main_invoice;
1616     foreach my $address ( @{$arrayref} ) {
1617       #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1618       next if exists $seen{$address} && $seen{$address};
1619       $seen{$address} = 1;
1620       my $cust_main_invoice = new FS::cust_main_invoice ( {
1621         'custnum' => $self->custnum,
1622         'dest'    => $address,
1623       } );
1624       my $error = $cust_main_invoice->insert;
1625       warn $error if $error;
1626     }
1627   }
1628   if ( $self->custnum ) {
1629     map { $_->address }
1630       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1631   } else {
1632     ();
1633   }
1634 }
1635
1636 =item check_invoicing_list ARRAYREF
1637
1638 Checks these arguements as valid input for the invoicing_list method.  If there
1639 is an error, returns the error, otherwise returns false.
1640
1641 =cut
1642
1643 sub check_invoicing_list {
1644   my( $self, $arrayref ) = @_;
1645   foreach my $address ( @{$arrayref} ) {
1646     my $cust_main_invoice = new FS::cust_main_invoice ( {
1647       'custnum' => $self->custnum,
1648       'dest'    => $address,
1649     } );
1650     my $error = $self->custnum
1651                 ? $cust_main_invoice->check
1652                 : $cust_main_invoice->checkdest
1653     ;
1654     return $error if $error;
1655   }
1656   '';
1657 }
1658
1659 =item default_invoicing_list
1660
1661 Returns the email addresses of any
1662
1663 =cut
1664
1665 sub default_invoicing_list {
1666   my $self = shift;
1667   my @list = ();
1668   foreach my $cust_pkg ( $self->all_pkgs ) {
1669     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1670     my @svc_acct =
1671       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1672         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1673           @cust_svc;
1674     push @list, map { $_->email } @svc_acct;
1675   }
1676   $self->invoicing_list(\@list);
1677 }
1678
1679 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1680
1681 Returns an array of customers referred by this customer (referral_custnum set
1682 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1683 customers referred by customers referred by this customer and so on, inclusive.
1684 The default behavior is DEPTH 1 (no recursion).
1685
1686 =cut
1687
1688 sub referral_cust_main {
1689   my $self = shift;
1690   my $depth = @_ ? shift : 1;
1691   my $exclude = @_ ? shift : {};
1692
1693   my @cust_main =
1694     map { $exclude->{$_->custnum}++; $_; }
1695       grep { ! $exclude->{ $_->custnum } }
1696         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1697
1698   if ( $depth > 1 ) {
1699     push @cust_main,
1700       map { $_->referral_cust_main($depth-1, $exclude) }
1701         @cust_main;
1702   }
1703
1704   @cust_main;
1705 }
1706
1707 =item referral_cust_pkg [ DEPTH ]
1708
1709 Like referral_cust_main, except returns a flat list of all unsuspended packages
1710 for each customer.  The number of items in this list may be useful for
1711 comission calculations (perhaps after a grep).
1712
1713 =cut
1714
1715 sub referral_cust_pkg {
1716   my $self = shift;
1717   my $depth = @_ ? shift : 1;
1718
1719   map { $_->unsuspended_pkgs }
1720     grep { $_->unsuspended_pkgs }
1721       $self->referral_cust_main($depth);
1722 }
1723
1724 =item credit AMOUNT, REASON
1725
1726 Applies a credit to this customer.  If there is an error, returns the error,
1727 otherwise returns false.
1728
1729 =cut
1730
1731 sub credit {
1732   my( $self, $amount, $reason ) = @_;
1733   my $cust_credit = new FS::cust_credit {
1734     'custnum' => $self->custnum,
1735     'amount'  => $amount,
1736     'reason'  => $reason,
1737   };
1738   $cust_credit->insert;
1739 }
1740
1741 =back
1742
1743 =head1 SUBROUTINES
1744
1745 =over 4
1746
1747 =item check_and_rebuild_fuzzyfiles
1748
1749 =cut
1750
1751 sub check_and_rebuild_fuzzyfiles {
1752   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1753   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1754     or &rebuild_fuzzyfiles;
1755 }
1756
1757 =item rebuild_fuzzyfiles
1758
1759 =cut
1760
1761 sub rebuild_fuzzyfiles {
1762
1763   use Fcntl qw(:flock);
1764
1765   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1766
1767   #last
1768
1769   open(LASTLOCK,">>$dir/cust_main.last")
1770     or die "can't open $dir/cust_main.last: $!";
1771   flock(LASTLOCK,LOCK_EX)
1772     or die "can't lock $dir/cust_main.last: $!";
1773
1774   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1775   push @all_last,
1776                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1777     if defined dbdef->table('cust_main')->column('ship_last');
1778
1779   open (LASTCACHE,">$dir/cust_main.last.tmp")
1780     or die "can't open $dir/cust_main.last.tmp: $!";
1781   print LASTCACHE join("\n", @all_last), "\n";
1782   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1783
1784   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1785   close LASTLOCK;
1786
1787   #company
1788
1789   open(COMPANYLOCK,">>$dir/cust_main.company")
1790     or die "can't open $dir/cust_main.company: $!";
1791   flock(COMPANYLOCK,LOCK_EX)
1792     or die "can't lock $dir/cust_main.company: $!";
1793
1794   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1795   push @all_company,
1796        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1797     if defined dbdef->table('cust_main')->column('ship_last');
1798
1799   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1800     or die "can't open $dir/cust_main.company.tmp: $!";
1801   print COMPANYCACHE join("\n", @all_company), "\n";
1802   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1803
1804   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1805   close COMPANYLOCK;
1806
1807 }
1808
1809 =item all_last
1810
1811 =cut
1812
1813 sub all_last {
1814   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1815   open(LASTCACHE,"<$dir/cust_main.last")
1816     or die "can't open $dir/cust_main.last: $!";
1817   my @array = map { chomp; $_; } <LASTCACHE>;
1818   close LASTCACHE;
1819   \@array;
1820 }
1821
1822 =item all_company
1823
1824 =cut
1825
1826 sub all_company {
1827   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1828   open(COMPANYCACHE,"<$dir/cust_main.company")
1829     or die "can't open $dir/cust_main.last: $!";
1830   my @array = map { chomp; $_; } <COMPANYCACHE>;
1831   close COMPANYCACHE;
1832   \@array;
1833 }
1834
1835 =item append_fuzzyfiles LASTNAME COMPANY
1836
1837 =cut
1838
1839 sub append_fuzzyfiles {
1840   my( $last, $company ) = @_;
1841
1842   &check_and_rebuild_fuzzyfiles;
1843
1844   use Fcntl qw(:flock);
1845
1846   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1847
1848   if ( $last ) {
1849
1850     open(LAST,">>$dir/cust_main.last")
1851       or die "can't open $dir/cust_main.last: $!";
1852     flock(LAST,LOCK_EX)
1853       or die "can't lock $dir/cust_main.last: $!";
1854
1855     print LAST "$last\n";
1856
1857     flock(LAST,LOCK_UN)
1858       or die "can't unlock $dir/cust_main.last: $!";
1859     close LAST;
1860   }
1861
1862   if ( $company ) {
1863
1864     open(COMPANY,">>$dir/cust_main.company")
1865       or die "can't open $dir/cust_main.company: $!";
1866     flock(COMPANY,LOCK_EX)
1867       or die "can't lock $dir/cust_main.company: $!";
1868
1869     print COMPANY "$company\n";
1870
1871     flock(COMPANY,LOCK_UN)
1872       or die "can't unlock $dir/cust_main.company: $!";
1873
1874     close COMPANY;
1875   }
1876
1877   1;
1878 }
1879
1880 =head1 VERSION
1881
1882 $Id: cust_main.pm,v 1.47 2001-11-12 13:19:52 ivan Exp $
1883
1884 =head1 BUGS
1885
1886 The delete method.
1887
1888 The delete method should possibly take an FS::cust_main object reference
1889 instead of a scalar customer number.
1890
1891 Bill and collect options should probably be passed as references instead of a
1892 list.
1893
1894 CyberCash v2 forces us to define some variables in package main.
1895
1896 There should probably be a configuration file with a list of allowed credit
1897 card types.
1898
1899 No multiple currency support (probably a larger project than just this module).
1900
1901 =head1 SEE ALSO
1902
1903 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1904 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1905 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1906 L<FS::UID>, schema.html from the base documentation.
1907
1908 =cut
1909
1910 1;
1911
1912