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