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 - Advertising source (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 advertising source."
 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 refnum"
 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 ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 590                        @addfields )
 591          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 592        )
 593     {
 594       my $error =
 595         $self->ut_name('ship_last')
 596         || $self->ut_name('ship_first')
 597         || $self->ut_textn('ship_company')
 598         || $self->ut_text('ship_address1')
 599         || $self->ut_textn('ship_address2')
 600         || $self->ut_text('ship_city')
 601         || $self->ut_textn('ship_county')
 602         || $self->ut_textn('ship_state')
 603         || $self->ut_country('ship_country')
 604       ;
 605       return $error if $error;
 606
 607       #false laziness with above
 608       unless ( qsearchs('cust_main_county', {
 609         'country' => $self->ship_country,
 610         'state'   => '',
 611        } ) ) {
 612         return "Unknown ship_state/ship_county/ship_country: ".
 613           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 614           unless qsearchs('cust_main_county',{
 615             'state'   => $self->ship_state,
 616             'county'  => $self->ship_county,
 617             'country' => $self->ship_country,
 618           } );
 619       }
 620       #eofalse
 621
 622       $error =
 623         $self->ut_phonen('ship_daytime', $self->ship_country)
 624         || $self->ut_phonen('ship_night', $self->ship_country)
 625         || $self->ut_phonen('ship_fax', $self->ship_country)
 626         || $self->ut_zip('ship_zip', $self->ship_country)
 627       ;
 628       return $error if $error;
 629
 630     } else { # ship_ info eq billing info, so don't store dup info in database
 631       $self->setfield("ship_$_", '')
 632         foreach qw( last first company address1 address2 city county state zip
 633                     country daytime night fax );
 634     }
 635   }
 636
 637   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
 638     or return "Illegal payby: ". $self->payby;
 639   $self->payby($1);
 640
 641   if ( $self->payby eq 'CARD' ) {
 642
 643     my $payinfo = $self->payinfo;
 644     $payinfo =~ s/\D//g;
 645     $payinfo =~ /^(\d{13,16})$/
 646       or return "Illegal credit card number: ". $self->payinfo;
 647     $payinfo = $1;
 648     $self->payinfo($payinfo);
 649     validate($payinfo)
 650       or return "Illegal credit card number: ". $self->payinfo;
 651     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 652
 653   } elsif ( $self->payby eq 'BILL' ) {
 654
 655     $error = $self->ut_textn('payinfo');
 656     return "Illegal P.O. number: ". $self->payinfo if $error;
 657
 658   } elsif ( $self->payby eq 'COMP' ) {
 659
 660     $error = $self->ut_textn('payinfo');
 661     return "Illegal comp account issuer: ". $self->payinfo if $error;
 662
 663   } elsif ( $self->payby eq 'PREPAY' ) {
 664
 665     my $payinfo = $self->payinfo;
 666     $payinfo =~ s/\W//g; #anything else would just confuse things
 667     $self->payinfo($payinfo);
 668     $error = $self->ut_alpha('payinfo');
 669     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 670     return "Unknown prepayment identifier"
 671       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 672
 673   }
 674
 675   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 676     return "Expriation date required"
 677       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
 678     $self->paydate('');
 679   } else {
 680     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 681       or return "Illegal expiration date: ". $self->paydate;
 682     if ( length($2) == 4 ) {
 683       $self->paydate("$2-$1-01");
 684     } else {
 685       $self->paydate("20$2-$1-01");
 686     }
 687   }
 688
 689   if ( $self->payname eq '' ) {
 690     $self->payname( $self->first. " ". $self->getfield('last') );
 691   } else {
 692     $self->payname =~ /^([\w \,\.\-\']+)$/
 693       or return "Illegal billing name: ". $self->payname;
 694     $self->payname($1);
 695   }
 696
 697   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 698   $self->tax($1);
 699
 700   $self->otaker(getotaker);
 701
 702   #warn "AFTER: \n". $self->_dump;
 703
 704   ''; #no error
 705 }
 706
 707 =item all_pkgs
 708
 709 Returns all packages (see L<FS::cust_pkg>) for this customer.
 710
 711 =cut
 712
 713 sub all_pkgs {
 714   my $self = shift;
 715   if ( $self->{'_pkgnum'} ) {
 716     values %{ $self->{'_pkgnum'}->cache };
 717   } else {
 718     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 719   }
 720 }
 721
 722 =item ncancelled_pkgs
 723
 724 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 725
 726 =cut
 727
 728 sub ncancelled_pkgs {
 729   my $self = shift;
 730   if ( $self->{'_pkgnum'} ) {
 731     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 732   } else {
 733     @{ [ # force list context
 734       qsearch( 'cust_pkg', {
 735         'custnum' => $self->custnum,
 736         'cancel'  => '',
 737       }),
 738       qsearch( 'cust_pkg', {
 739         'custnum' => $self->custnum,
 740         'cancel'  => 0,
 741       }),
 742     ] };
 743   }
 744 }
 745
 746 =item suspended_pkgs
 747
 748 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 749
 750 =cut
 751
 752 sub suspended_pkgs {
 753   my $self = shift;
 754   grep { $_->susp } $self->ncancelled_pkgs;
 755 }
 756
 757 =item unflagged_suspended_pkgs
 758
 759 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 760 customer (thouse packages without the `manual_flag' set).
 761
 762 =cut
 763
 764 sub unflagged_suspended_pkgs {
 765   my $self = shift;
 766   return $self->suspended_pkgs
 767     unless dbdef->table('cust_pkg')->column('manual_flag');
 768   grep { ! $_->manual_flag } $self->suspended_pkgs;
 769 }
 770
 771 =item unsuspended_pkgs
 772
 773 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 774 this customer.
 775
 776 =cut
 777
 778 sub unsuspended_pkgs {
 779   my $self = shift;
 780   grep { ! $_->susp } $self->ncancelled_pkgs;
 781 }
 782
 783 =item unsuspend
 784
 785 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 786 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 787 on success or a list of errors.
 788
 789 =cut
 790
 791 sub unsuspend {
 792   my $self = shift;
 793   grep { $_->unsuspend } $self->suspended_pkgs;
 794 }
 795
 796 =item suspend
 797
 798 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 799 Always returns a list: an empty list on success or a list of errors.
 800
 801 =cut
 802
 803 sub suspend {
 804   my $self = shift;
 805   grep { $_->suspend } $self->unsuspended_pkgs;
 806 }
 807
 808 =item cancel
 809
 810 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 811 Always returns a list: an empty list on success or a list of errors.
 812
 813 =cut
 814
 815 sub cancel {
 816   my $self = shift;
 817   grep { $_->cancel } $self->ncancelled_pkgs;
 818 }
 819
 820 =item agent
 821
 822 Returns the agent (see L<FS::agent>) for this customer.
 823
 824 =cut
 825
 826 sub agent {
 827   my $self = shift;
 828   qsearchs( 'agent', { 'agent' => $self->agentnum } );
 829 }
 830
 831 =item bill OPTIONS
 832
 833 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 834 conjunction with the collect method.
 835
 836 Options are passed as name-value pairs.
 837
 838 The only currently available option is `time', which bills the customer as if
 839 it were that time.  It is specified as a UNIX timestamp; see
 840 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 841 functions.  For example:
 842
 843  use Date::Parse;
 844  ...
 845  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 846
 847 If there is an error, returns the error, otherwise returns false.
 848
 849 =cut
 850
 851 sub bill {
 852   my( $self, %options ) = @_;
 853   my $time = $options{'time'} || time;
 854
 855   my $error;
 856
 857   #put below somehow?
 858   local $SIG{HUP} = 'IGNORE';
 859   local $SIG{INT} = 'IGNORE';
 860   local $SIG{QUIT} = 'IGNORE';
 861   local $SIG{TERM} = 'IGNORE';
 862   local $SIG{TSTP} = 'IGNORE';
 863   local $SIG{PIPE} = 'IGNORE';
 864
 865   my $oldAutoCommit = $FS::UID::AutoCommit;
 866   local $FS::UID::AutoCommit = 0;
 867   my $dbh = dbh;
 868
 869   # find the packages which are due for billing, find out how much they are
 870   # & generate invoice database.
 871
 872   my( $total_setup, $total_recur ) = ( 0, 0 );
 873   my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 874   my @cust_bill_pkg = ();
 875
 876   foreach my $cust_pkg (
 877     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
 878   ) {
 879
 880     #NO!! next if $cust_pkg->cancel;
 881     next if $cust_pkg->getfield('cancel');
 882
 883     #? to avoid use of uninitialized value errors... ?
 884     $cust_pkg->setfield('bill', '')
 885       unless defined($cust_pkg->bill);
 886
 887     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 888
 889     #so we don't modify cust_pkg record unnecessarily
 890     my $cust_pkg_mod_flag = 0;
 891     my %hash = $cust_pkg->hash;
 892     my $old_cust_pkg = new FS::cust_pkg \%hash;
 893
 894     # bill setup
 895     my $setup = 0;
 896     unless ( $cust_pkg->setup ) {
 897       my $setup_prog = $part_pkg->getfield('setup');
 898       $setup_prog =~ /^(.*)$/ or do {
 899         $dbh->rollback if $oldAutoCommit;
 900         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
 901                ": $setup_prog";
 902       };
 903       $setup_prog = $1;
 904
 905         #my $cpt = new Safe;
 906         ##$cpt->permit(); #what is necessary?
 907         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 908         #$setup = $cpt->reval($setup_prog);
 909       $setup = eval $setup_prog;
 910       unless ( defined($setup) ) {
 911         $dbh->rollback if $oldAutoCommit;
 912         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
 913                "(expression $setup_prog): $@";
 914       }
 915       $cust_pkg->setfield('setup',$time);
 916       $cust_pkg_mod_flag=1;
 917     }
 918
 919     #bill recurring fee
 920     my $recur = 0;
 921     my $sdate;
 922     if ( $part_pkg->getfield('freq') > 0 &&
 923          ! $cust_pkg->getfield('susp') &&
 924          ( $cust_pkg->getfield('bill') || 0 ) < $time
 925     ) {
 926       my $recur_prog = $part_pkg->getfield('recur');
 927       $recur_prog =~ /^(.*)$/ or do {
 928         $dbh->rollback if $oldAutoCommit;
 929         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
 930                ": $recur_prog";
 931       };
 932       $recur_prog = $1;
 933
 934       # shared with $recur_prog
 935       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 936
 937         #my $cpt = new Safe;
 938         ##$cpt->permit(); #what is necessary?
 939         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 940         #$recur = $cpt->reval($recur_prog);
 941       $recur = eval $recur_prog;
 942       unless ( defined($recur) ) {
 943         $dbh->rollback if $oldAutoCommit;
 944         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
 945                "(expression $recur_prog): $@";
 946       }
 947       #change this bit to use Date::Manip? CAREFUL with timezones (see
 948       # mailing list archive)
 949       my ($sec,$min,$hour,$mday,$mon,$year) =
 950         (localtime($sdate) )[0,1,2,3,4,5];
 951
 952       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
 953       # only for figuring next bill date, nothing else, so, reset $sdate again
 954       # here
 955       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 956
 957       $mon += $part_pkg->getfield('freq');
 958       until ( $mon < 12 ) { $mon -= 12; $year++; }
 959       $cust_pkg->setfield('bill',
 960         timelocal($sec,$min,$hour,$mday,$mon,$year));
 961       $cust_pkg_mod_flag = 1;
 962     }
 963
 964     warn "\$setup is undefined" unless defined($setup);
 965     warn "\$recur is undefined" unless defined($recur);
 966     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 967
 968     if ( $cust_pkg_mod_flag ) {
 969       $error=$cust_pkg->replace($old_cust_pkg);
 970       if ( $error ) { #just in case
 971         $dbh->rollback if $oldAutoCommit;
 972         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
 973       }
 974       $setup = sprintf( "%.2f", $setup );
 975       $recur = sprintf( "%.2f", $recur );
 976       if ( $setup < 0 ) {
 977         $dbh->rollback if $oldAutoCommit;
 978         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 979       }
 980       if ( $recur < 0 ) {
 981         $dbh->rollback if $oldAutoCommit;
 982         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 983       }
 984       if ( $setup > 0 || $recur > 0 ) {
 985         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 986           'pkgnum' => $cust_pkg->pkgnum,
 987           'setup'  => $setup,
 988           'recur'  => $recur,
 989           'sdate'  => $sdate,
 990           'edate'  => $cust_pkg->bill,
 991         });
 992         push @cust_bill_pkg, $cust_bill_pkg;
 993         $total_setup += $setup;
 994         $total_recur += $recur;
 995         $taxable_setup += $setup
 996           unless $part_pkg->dbdef_table->column('setuptax')
 997                  && $part_pkg->setuptax =~ /^Y$/i;
 998         $taxable_recur += $recur
 999           unless $part_pkg->dbdef_table->column('recurtax')
1000                  && $part_pkg->recurtax =~ /^Y$/i;
1001       }
1002     }
1003
1004   }
1005
1006   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1007   my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1008
1009   unless ( @cust_bill_pkg ) {
1010     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1011     return '';
1012   }
1013
1014   unless ( $self->tax =~ /Y/i
1015            || $self->payby eq 'COMP'
1016            || $taxable_charged == 0 ) {
1017     my $cust_main_county = qsearchs('cust_main_county',{
1018         'state'   => $self->state,
1019         'county'  => $self->county,
1020         'country' => $self->country,
1021     } ) or die "fatal: can't find tax rate for state/county/country ".
1022                $self->state. "/". $self->county. "/". $self->country. "\n";
1023     my $tax = sprintf( "%.2f",
1024       $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1025     );
1026
1027     if ( $tax > 0 ) {
1028       $charged = sprintf( "%.2f", $charged+$tax );
1029
1030       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1031         'pkgnum' => 0,
1032         'setup'  => $tax,
1033         'recur'  => 0,
1034         'sdate'  => '',
1035         'edate'  => '',
1036       });
1037       push @cust_bill_pkg, $cust_bill_pkg;
1038     }
1039   }
1040
1041   my $cust_bill = new FS::cust_bill ( {
1042     'custnum' => $self->custnum,
1043     '_date'   => $time,
1044     'charged' => $charged,
1045   } );
1046   $error = $cust_bill->insert;
1047   if ( $error ) {
1048     $dbh->rollback if $oldAutoCommit;
1049     return "can't create invoice for customer #". $self->custnum. ": $error";
1050   }
1051
1052   my $invnum = $cust_bill->invnum;
1053   my $cust_bill_pkg;
1054   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1055     #warn $invnum;
1056     $cust_bill_pkg->invnum($invnum);
1057     $error = $cust_bill_pkg->insert;
1058     if ( $error ) {
1059       $dbh->rollback if $oldAutoCommit;
1060       return "can't create invoice line item for customer #". $self->custnum.
1061              ": $error";
1062     }
1063   }
1064
1065   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1066   ''; #no error
1067 }
1068
1069 =item collect OPTIONS
1070
1071 (Attempt to) collect money for this customer's outstanding invoices (see
1072 L<FS::cust_bill>).  Usually used after the bill method.
1073
1074 Depending on the value of `payby', this may print an invoice (`BILL'), charge
1075 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
1076
1077 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1078 and the invoice events web interface.
1079
1080 If there is an error, returns the error, otherwise returns false.
1081
1082 Options are passed as name-value pairs.
1083
1084 Currently available options are:
1085
1086 invoice_time - Use this time when deciding when to print invoices and
1087 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>
1088 for conversion functions.
1089
1090 batch_card - This option is deprecated.  See the invoice events web interface
1091 to control whether cards are batched or run against a realtime gateway.
1092
1093 report_badcard - This option is deprecated.
1094
1095 force_print - This option is deprecated; see the invoice events web interface.
1096
1097 =cut
1098
1099 sub collect {
1100   my( $self, %options ) = @_;
1101   my $invoice_time = $options{'invoice_time'} || time;
1102
1103   #put below somehow?
1104   local $SIG{HUP} = 'IGNORE';
1105   local $SIG{INT} = 'IGNORE';
1106   local $SIG{QUIT} = 'IGNORE';
1107   local $SIG{TERM} = 'IGNORE';
1108   local $SIG{TSTP} = 'IGNORE';
1109   local $SIG{PIPE} = 'IGNORE';
1110
1111   my $oldAutoCommit = $FS::UID::AutoCommit;
1112   local $FS::UID::AutoCommit = 0;
1113   my $dbh = dbh;
1114
1115   my $balance = $self->balance;
1116   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1117   unless ( $balance > 0 ) { #redundant?????
1118     $dbh->rollback if $oldAutoCommit; #hmm
1119     return '';
1120   }
1121
1122   foreach my $cust_bill (
1123     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1124   ) {
1125
1126     #this has to be before next's
1127     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1128                                   ? $balance
1129                                   : $cust_bill->owed
1130     );
1131     $balance = sprintf( "%.2f", $balance - $amount );
1132
1133     next unless $cust_bill->owed > 0;
1134
1135     # don't try to charge for the same invoice if it's already in a batch
1136     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1137
1138     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1139
1140     next unless $amount > 0;
1141
1142     foreach my $part_bill_event (
1143       sort {    $a->seconds   <=> $b->seconds
1144              || $a->weight    <=> $b->weight
1145              || $a->eventpart <=> $b->eventpart }
1146         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1147                && ! qsearchs( 'cust_bill_event', {
1148                                 'invnum'    => $cust_bill->invnum,
1149                                 'eventpart' => $_->eventpart,
1150                                 'status'    => 'done',
1151                                                                    } )
1152              }
1153           qsearch('part_bill_event', { 'payby'    => $self->payby,
1154                                        'disabled' => '',           } )
1155     ) {
1156       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1157         if $Debug;
1158       my $cust_main = $self; #for callback
1159       my $error = eval $part_bill_event->eventcode;
1160
1161       my $status = '';
1162       my $statustext = '';
1163       if ( $@ ) {
1164         $status = 'failed';
1165         $statustext = $@;
1166       } elsif ( $error ) {
1167         $status = 'done';
1168         $statustext = $error;
1169       } else {
1170         $status = 'done'
1171       }
1172
1173       #add cust_bill_event
1174       my $cust_bill_event = new FS::cust_bill_event {
1175         'invnum'     => $cust_bill->invnum,
1176         'eventpart'  => $part_bill_event->eventpart,
1177         '_date'      => $invoice_time,
1178         'status'     => $status,
1179         'statustext' => $statustext,
1180       };
1181       $error = $cust_bill_event->insert;
1182       if ( $error ) {
1183         #$dbh->rollback if $oldAutoCommit;
1184         #return "error: $error";
1185
1186         # gah, even with transactions.
1187         $dbh->commit if $oldAutoCommit; #well.
1188         my $e = 'WARNING: Event run but database not updated - '.
1189                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1190                 ', eventpart '. $part_bill_event->eventpart.
1191                 ": $error";
1192         warn $e;
1193         return $e;
1194       }
1195
1196
1197     }
1198
1199   }
1200
1201   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1202   '';
1203
1204 }
1205
1206 =item total_owed
1207
1208 Returns the total owed for this customer on all invoices
1209 (see L<FS::cust_bill/owed>).
1210
1211 =cut
1212
1213 sub total_owed {
1214   my $self = shift;
1215   $self->total_owed_date(2145859200); #12/31/2037
1216 }
1217
1218 =item total_owed_date TIME
1219
1220 Returns the total owed for this customer on all invoices with date earlier than
1221 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1222 see L<Time::Local> and L<Date::Parse> for conversion functions.
1223
1224 =cut
1225
1226 sub total_owed_date {
1227   my $self = shift;
1228   my $time = shift;
1229   my $total_bill = 0;
1230   foreach my $cust_bill (
1231     grep { $_->_date <= $time }
1232       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1233   ) {
1234     $total_bill += $cust_bill->owed;
1235   }
1236   sprintf( "%.2f", $total_bill );
1237 }
1238
1239 =item apply_credits
1240
1241 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1242 to outstanding invoice balances in chronological order and returns the value
1243 of any remaining unapplied credits available for refund
1244 (see L<FS::cust_refund>).
1245
1246 =cut
1247
1248 sub apply_credits {
1249   my $self = shift;
1250
1251   return 0 unless $self->total_credited;
1252
1253   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1254       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1255
1256   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1257       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1258
1259   my $credit;
1260
1261   foreach my $cust_bill ( @invoices ) {
1262     my $amount;
1263
1264     if ( !defined($credit) || $credit->credited == 0) {
1265       $credit = pop @credits or last;
1266     }
1267
1268     if ($cust_bill->owed >= $credit->credited) {
1269       $amount=$credit->credited;
1270     }else{
1271       $amount=$cust_bill->owed;
1272     }
1273
1274     my $cust_credit_bill = new FS::cust_credit_bill ( {
1275       'crednum' => $credit->crednum,
1276       'invnum'  => $cust_bill->invnum,
1277       'amount'  => $amount,
1278     } );
1279     my $error = $cust_credit_bill->insert;
1280     die $error if $error;
1281
1282     redo if ($cust_bill->owed > 0);
1283
1284   }
1285
1286   return $self->total_credited;
1287 }
1288
1289 =item apply_payments
1290
1291 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1292 to outstanding invoice balances in chronological order.
1293
1294  #and returns the value of any remaining unapplied payments.
1295
1296 =cut
1297
1298 sub apply_payments {
1299   my $self = shift;
1300
1301   #return 0 unless
1302
1303   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1304       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1305
1306   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1307       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1308
1309   my $payment;
1310
1311   foreach my $cust_bill ( @invoices ) {
1312     my $amount;
1313
1314     if ( !defined($payment) || $payment->unapplied == 0 ) {
1315       $payment = pop @payments or last;
1316     }
1317
1318     if ( $cust_bill->owed >= $payment->unapplied ) {
1319       $amount = $payment->unapplied;
1320     } else {
1321       $amount = $cust_bill->owed;
1322     }
1323
1324     my $cust_bill_pay = new FS::cust_bill_pay ( {
1325       'paynum' => $payment->paynum,
1326       'invnum' => $cust_bill->invnum,
1327       'amount' => $amount,
1328     } );
1329     my $error = $cust_bill_pay->insert;
1330     die $error if $error;
1331
1332     redo if ( $cust_bill->owed > 0);
1333
1334   }
1335
1336   return $self->total_unapplied_payments;
1337 }
1338
1339 =item total_credited
1340
1341 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1342 customer.  See L<FS::cust_credit/credited>.
1343
1344 =cut
1345
1346 sub total_credited {
1347   my $self = shift;
1348   my $total_credit = 0;
1349   foreach my $cust_credit ( qsearch('cust_credit', {
1350     'custnum' => $self->custnum,
1351   } ) ) {
1352     $total_credit += $cust_credit->credited;
1353   }
1354   sprintf( "%.2f", $total_credit );
1355 }
1356
1357 =item total_unapplied_payments
1358
1359 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1360 See L<FS::cust_pay/unapplied>.
1361
1362 =cut
1363
1364 sub total_unapplied_payments {
1365   my $self = shift;
1366   my $total_unapplied = 0;
1367   foreach my $cust_pay ( qsearch('cust_pay', {
1368     'custnum' => $self->custnum,
1369   } ) ) {
1370     $total_unapplied += $cust_pay->unapplied;
1371   }
1372   sprintf( "%.2f", $total_unapplied );
1373 }
1374
1375 =item balance
1376
1377 Returns the balance for this customer (total_owed minus total_credited
1378 minus total_unapplied_payments).
1379
1380 =cut
1381
1382 sub balance {
1383   my $self = shift;
1384   sprintf( "%.2f",
1385     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1386   );
1387 }
1388
1389 =item balance_date TIME
1390
1391 Returns the balance for this customer, only considering invoices with date
1392 earlier than TIME (total_owed_date minus total_credited minus
1393 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1394 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1395 functions.
1396
1397 =cut
1398
1399 sub balance_date {
1400   my $self = shift;
1401   my $time = shift;
1402   sprintf( "%.2f",
1403     $self->total_owed_date($time)
1404       - $self->total_credited
1405       - $self->total_unapplied_payments
1406   );
1407 }
1408
1409 =item invoicing_list [ ARRAYREF ]
1410
1411 If an arguement is given, sets these email addresses as invoice recipients
1412 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1413 (except as warnings), so use check_invoicing_list first.
1414
1415 Returns a list of email addresses (with svcnum entries expanded).
1416
1417 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1418 check it without disturbing anything by passing nothing.
1419
1420 This interface may change in the future.
1421
1422 =cut
1423
1424 sub invoicing_list {
1425   my( $self, $arrayref ) = @_;
1426   if ( $arrayref ) {
1427     my @cust_main_invoice;
1428     if ( $self->custnum ) {
1429       @cust_main_invoice =
1430         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1431     } else {
1432       @cust_main_invoice = ();
1433     }
1434     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1435       #warn $cust_main_invoice->destnum;
1436       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1437         #warn $cust_main_invoice->destnum;
1438         my $error = $cust_main_invoice->delete;
1439         warn $error if $error;
1440       }
1441     }
1442     if ( $self->custnum ) {
1443       @cust_main_invoice =
1444         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1445     } else {
1446       @cust_main_invoice = ();
1447     }
1448     my %seen = map { $_->address => 1 } @cust_main_invoice;
1449     foreach my $address ( @{$arrayref} ) {
1450       #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1451       next if exists $seen{$address} && $seen{$address};
1452       $seen{$address} = 1;
1453       my $cust_main_invoice = new FS::cust_main_invoice ( {
1454         'custnum' => $self->custnum,
1455         'dest'    => $address,
1456       } );
1457       my $error = $cust_main_invoice->insert;
1458       warn $error if $error;
1459     }
1460   }
1461   if ( $self->custnum ) {
1462     map { $_->address }
1463       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1464   } else {
1465     ();
1466   }
1467 }
1468
1469 =item check_invoicing_list ARRAYREF
1470
1471 Checks these arguements as valid input for the invoicing_list method.  If there
1472 is an error, returns the error, otherwise returns false.
1473
1474 =cut
1475
1476 sub check_invoicing_list {
1477   my( $self, $arrayref ) = @_;
1478   foreach my $address ( @{$arrayref} ) {
1479     my $cust_main_invoice = new FS::cust_main_invoice ( {
1480       'custnum' => $self->custnum,
1481       'dest'    => $address,
1482     } );
1483     my $error = $self->custnum
1484                 ? $cust_main_invoice->check
1485                 : $cust_main_invoice->checkdest
1486     ;
1487     return $error if $error;
1488   }
1489   '';
1490 }
1491
1492 =item default_invoicing_list
1493
1494 Sets the invoicing list to all accounts associated with this customer.
1495
1496 =cut
1497
1498 sub default_invoicing_list {
1499   my $self = shift;
1500   my @list = ();
1501   foreach my $cust_pkg ( $self->all_pkgs ) {
1502     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1503     my @svc_acct =
1504       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1505         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1506           @cust_svc;
1507     push @list, map { $_->email } @svc_acct;
1508   }
1509   $self->invoicing_list(\@list);
1510 }
1511
1512 =item invoicing_list_addpost
1513
1514 Adds postal invoicing to this customer.  If this customer is already configured
1515 to receive postal invoices, does nothing.
1516
1517 =cut
1518
1519 sub invoicing_list_addpost {
1520   my $self = shift;
1521   return if grep { $_ eq 'POST' } $self->invoicing_list;
1522   my @invoicing_list = $self->invoicing_list;
1523   push @invoicing_list, 'POST';
1524   $self->invoicing_list(\@invoicing_list);
1525 }
1526
1527 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1528
1529 Returns an array of customers referred by this customer (referral_custnum set
1530 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1531 customers referred by customers referred by this customer and so on, inclusive.
1532 The default behavior is DEPTH 1 (no recursion).
1533
1534 =cut
1535
1536 sub referral_cust_main {
1537   my $self = shift;
1538   my $depth = @_ ? shift : 1;
1539   my $exclude = @_ ? shift : {};
1540
1541   my @cust_main =
1542     map { $exclude->{$_->custnum}++; $_; }
1543       grep { ! $exclude->{ $_->custnum } }
1544         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1545
1546   if ( $depth > 1 ) {
1547     push @cust_main,
1548       map { $_->referral_cust_main($depth-1, $exclude) }
1549         @cust_main;
1550   }
1551
1552   @cust_main;
1553 }
1554
1555 =item referral_cust_main_ncancelled
1556
1557 Same as referral_cust_main, except only returns customers with uncancelled
1558 packages.
1559
1560 =cut
1561
1562 sub referral_cust_main_ncancelled {
1563   my $self = shift;
1564   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
1565 }
1566
1567 =item referral_cust_pkg [ DEPTH ]
1568
1569 Like referral_cust_main, except returns a flat list of all unsuspended (and
1570 uncancelled) packages for each customer.  The number of items in this list may
1571 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
1572
1573 =cut
1574
1575 sub referral_cust_pkg {
1576   my $self = shift;
1577   my $depth = @_ ? shift : 1;
1578
1579   map { $_->unsuspended_pkgs }
1580     grep { $_->unsuspended_pkgs }
1581       $self->referral_cust_main($depth);
1582 }
1583
1584 =item credit AMOUNT, REASON
1585
1586 Applies a credit to this customer.  If there is an error, returns the error,
1587 otherwise returns false.
1588
1589 =cut
1590
1591 sub credit {
1592   my( $self, $amount, $reason ) = @_;
1593   my $cust_credit = new FS::cust_credit {
1594     'custnum' => $self->custnum,
1595     'amount'  => $amount,
1596     'reason'  => $reason,
1597   };
1598   $cust_credit->insert;
1599 }
1600
1601 =item charge AMOUNT PKG COMMENT
1602
1603 Creates a one-time charge for this customer.  If there is an error, returns
1604 the error, otherwise returns false.
1605
1606 =cut
1607
1608 sub charge {
1609   my ( $self, $amount, $pkg, $comment ) = @_;
1610
1611   my $part_pkg = new FS::part_pkg ( {
1612     'pkg'      => $pkg || 'One-time charge',
1613     'comment'  => $comment || '$'. sprintf("%.2f".$amount),
1614     'setup'    => $amount,
1615     'freq'     => 0,
1616     'recur'    => '0',
1617     'disabled' => 'Y',
1618   } );
1619
1620   $part_pkg->insert;
1621
1622 }
1623
1624 =back
1625
1626 =head1 SUBROUTINES
1627
1628 =over 4
1629
1630 =item check_and_rebuild_fuzzyfiles
1631
1632 =cut
1633
1634 sub check_and_rebuild_fuzzyfiles {
1635   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1636   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
1637     or &rebuild_fuzzyfiles;
1638 }
1639
1640 =item rebuild_fuzzyfiles
1641
1642 =cut
1643
1644 sub rebuild_fuzzyfiles {
1645
1646   use Fcntl qw(:flock);
1647
1648   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1649
1650   #last
1651
1652   open(LASTLOCK,">>$dir/cust_main.last")
1653     or die "can't open $dir/cust_main.last: $!";
1654   flock(LASTLOCK,LOCK_EX)
1655     or die "can't lock $dir/cust_main.last: $!";
1656
1657   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
1658   push @all_last,
1659                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
1660     if defined dbdef->table('cust_main')->column('ship_last');
1661
1662   open (LASTCACHE,">$dir/cust_main.last.tmp")
1663     or die "can't open $dir/cust_main.last.tmp: $!";
1664   print LASTCACHE join("\n", @all_last), "\n";
1665   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
1666
1667   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
1668   close LASTLOCK;
1669
1670   #company
1671
1672   open(COMPANYLOCK,">>$dir/cust_main.company")
1673     or die "can't open $dir/cust_main.company: $!";
1674   flock(COMPANYLOCK,LOCK_EX)
1675     or die "can't lock $dir/cust_main.company: $!";
1676
1677   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
1678   push @all_company,
1679        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
1680     if defined dbdef->table('cust_main')->column('ship_last');
1681
1682   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
1683     or die "can't open $dir/cust_main.company.tmp: $!";
1684   print COMPANYCACHE join("\n", @all_company), "\n";
1685   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
1686
1687   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
1688   close COMPANYLOCK;
1689
1690 }
1691
1692 =item all_last
1693
1694 =cut
1695
1696 sub all_last {
1697   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1698   open(LASTCACHE,"<$dir/cust_main.last")
1699     or die "can't open $dir/cust_main.last: $!";
1700   my @array = map { chomp; $_; } <LASTCACHE>;
1701   close LASTCACHE;
1702   \@array;
1703 }
1704
1705 =item all_company
1706
1707 =cut
1708
1709 sub all_company {
1710   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1711   open(COMPANYCACHE,"<$dir/cust_main.company")
1712     or die "can't open $dir/cust_main.last: $!";
1713   my @array = map { chomp; $_; } <COMPANYCACHE>;
1714   close COMPANYCACHE;
1715   \@array;
1716 }
1717
1718 =item append_fuzzyfiles LASTNAME COMPANY
1719
1720 =cut
1721
1722 sub append_fuzzyfiles {
1723   my( $last, $company ) = @_;
1724
1725   &check_and_rebuild_fuzzyfiles;
1726
1727   use Fcntl qw(:flock);
1728
1729   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1730
1731   if ( $last ) {
1732
1733     open(LAST,">>$dir/cust_main.last")
1734       or die "can't open $dir/cust_main.last: $!";
1735     flock(LAST,LOCK_EX)
1736       or die "can't lock $dir/cust_main.last: $!";
1737
1738     print LAST "$last\n";
1739
1740     flock(LAST,LOCK_UN)
1741       or die "can't unlock $dir/cust_main.last: $!";
1742     close LAST;
1743   }
1744
1745   if ( $company ) {
1746
1747     open(COMPANY,">>$dir/cust_main.company")
1748       or die "can't open $dir/cust_main.company: $!";
1749     flock(COMPANY,LOCK_EX)
1750       or die "can't lock $dir/cust_main.company: $!";
1751
1752     print COMPANY "$company\n";
1753
1754     flock(COMPANY,LOCK_UN)
1755       or die "can't unlock $dir/cust_main.company: $!";
1756
1757     close COMPANY;
1758   }
1759
1760   1;
1761 }
1762
1763 =back
1764
1765 =head1 BUGS
1766
1767 The delete method.
1768
1769 The delete method should possibly take an FS::cust_main object reference
1770 instead of a scalar customer number.
1771
1772 Bill and collect options should probably be passed as references instead of a
1773 list.
1774
1775 There should probably be a configuration file with a list of allowed credit
1776 card types.
1777
1778 No multiple currency support (probably a larger project than just this module).
1779
1780 =head1 SEE ALSO
1781
1782 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1783 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
1784 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
1785
1786 =cut
1787
1788 1;
1789
1790