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