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