FS/FS/cust_main.pm

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