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