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