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