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