FS/FS/cust_main.pm

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