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