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