FS/FS/cust_main.pm

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