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