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