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