FS/FS/cust_main.pm

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