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