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 BEGIN {
   8   eval "use Time::Local;";
   9   die "Time::Local version 1.05 required with Perl versions before 5.6"
  10     if $] < 5.006 && !defined($Time::Local::VERSION);
  11   eval "use Time::Local qw(timelocal_nocheck);";
  12 }
  13 use Date::Format;
  14 #use Date::Manip;
  15 use Business::CreditCard;
  16 use FS::UID qw( getotaker dbh );
  17 use FS::Record qw( qsearchs qsearch dbdef );
  18 use FS::Misc qw( send_email );
  19 use FS::cust_pkg;
  20 use FS::cust_bill;
  21 use FS::cust_bill_pkg;
  22 use FS::cust_pay;
  23 use FS::cust_credit;
  24 use FS::part_referral;
  25 use FS::cust_main_county;
  26 use FS::agent;
  27 use FS::cust_main_invoice;
  28 use FS::cust_credit_bill;
  29 use FS::cust_bill_pay;
  30 use FS::prepay_credit;
  31 use FS::queue;
  32 use FS::part_pkg;
  33 use FS::part_bill_event;
  34 use FS::cust_bill_event;
  35 use FS::cust_tax_exempt;
  36 use FS::type_pkgs;
  37 use FS::Msgcat qw(gettext);
  38
  39 @ISA = qw( FS::Record );
  40
  41 $Debug = 1;
  42 #$Debug = 1;
  43
  44 $import = 0;
  45
  46 #ask FS::UID to run this stuff for us later
  47 #$FS::UID::callback{'FS::cust_main'} = sub {
  48 install_callback FS::UID sub {
  49   $conf = new FS::Conf;
  50   #yes, need it for stuff below (prolly should be cached)
  51 };
  52
  53 sub _cache {
  54   my $self = shift;
  55   my ( $hashref, $cache ) = @_;
  56   if ( exists $hashref->{'pkgnum'} ) {
  57 #    #@{ $self->{'_pkgnum'} } = ();
  58     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  59     $self->{'_pkgnum'} = $subcache;
  60     #push @{ $self->{'_pkgnum'} },
  61     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  62   }
  63 }
  64
  65 =head1 NAME
  66
  67 FS::cust_main - Object methods for cust_main records
  68
  69 =head1 SYNOPSIS
  70
  71   use FS::cust_main;
  72
  73   $record = new FS::cust_main \%hash;
  74   $record = new FS::cust_main { 'column' => 'value' };
  75
  76   $error = $record->insert;
  77
  78   $error = $new_record->replace($old_record);
  79
  80   $error = $record->delete;
  81
  82   $error = $record->check;
  83
  84   @cust_pkg = $record->all_pkgs;
  85
  86   @cust_pkg = $record->ncancelled_pkgs;
  87
  88   @cust_pkg = $record->suspended_pkgs;
  89
  90   $error = $record->bill;
  91   $error = $record->bill %options;
  92   $error = $record->bill 'time' => $time;
  93
  94   $error = $record->collect;
  95   $error = $record->collect %options;
  96   $error = $record->collect 'invoice_time'   => $time,
  97                             'batch_card'     => 'yes',
  98                             'report_badcard' => 'yes',
  99                           ;
 100
 101 =head1 DESCRIPTION
 102
 103 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 104 FS::Record.  The following fields are currently supported:
 105
 106 =over 4
 107
 108 =item custnum - primary key (assigned automatically for new customers)
 109
 110 =item agentnum - agent (see L<FS::agent>)
 111
 112 =item refnum - Advertising source (see L<FS::part_referral>)
 113
 114 =item first - name
 115
 116 =item last - name
 117
 118 =item ss - social security number (optional)
 119
 120 =item company - (optional)
 121
 122 =item address1
 123
 124 =item address2 - (optional)
 125
 126 =item city
 127
 128 =item county - (optional, see L<FS::cust_main_county>)
 129
 130 =item state - (see L<FS::cust_main_county>)
 131
 132 =item zip
 133
 134 =item country - (see L<FS::cust_main_county>)
 135
 136 =item daytime - phone (optional)
 137
 138 =item night - phone (optional)
 139
 140 =item fax - phone (optional)
 141
 142 =item ship_first - name
 143
 144 =item ship_last - name
 145
 146 =item ship_company - (optional)
 147
 148 =item ship_address1
 149
 150 =item ship_address2 - (optional)
 151
 152 =item ship_city
 153
 154 =item ship_county - (optional, see L<FS::cust_main_county>)
 155
 156 =item ship_state - (see L<FS::cust_main_county>)
 157
 158 =item ship_zip
 159
 160 =item ship_country - (see L<FS::cust_main_county>)
 161
 162 =item ship_daytime - phone (optional)
 163
 164 =item ship_night - phone (optional)
 165
 166 =item ship_fax - phone (optional)
 167
 168 =item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
 169
 170 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 171
 172 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 173
 174 =item payname - name on card or billing name
 175
 176 =item tax - tax exempt, empty or `Y'
 177
 178 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 179
 180 =item comments - comments (optional)
 181
 182 =item referral_custnum - referring customer number
 183
 184 =back
 185
 186 =head1 METHODS
 187
 188 =over 4
 189
 190 =item new HASHREF
 191
 192 Creates a new customer.  To add the customer to the database, see L<"insert">.
 193
 194 Note that this stores the hash reference, not a distinct copy of the hash it
 195 points to.  You can ask the object for a copy with the I<hash> method.
 196
 197 =cut
 198
 199 sub table { 'cust_main'; }
 200
 201 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
 202
 203 Adds this customer to the database.  If there is an error, returns the error,
 204 otherwise returns false.
 205
 206 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 207 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 208 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 209 hash reference is equivalent to not supplying this parameter.  There should be
 210 a better explanation of this, but until then, here's an example:
 211
 212   use Tie::RefHash;
 213   tie %hash, 'Tie::RefHash'; #this part is important
 214   %hash = (
 215     $cust_pkg => [ $svc_acct ],
 216     ...
 217   );
 218   $cust_main->insert( \%hash );
 219
 220 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 221 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 222 expected and rollback the entire transaction; it is not necessary to call
 223 check_invoicing_list first.  The invoicing_list is set after the records in the
 224 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 225 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 226
 227   $cust_main->insert( {}, [ $email, 'POST' ] );
 228
 229 =cut
 230
 231 sub insert {
 232   my $self = shift;
 233   my $cust_pkgs = @_ ? shift : {};
 234   my $invoicing_list = @_ ? shift : '';
 235
 236   local $SIG{HUP} = 'IGNORE';
 237   local $SIG{INT} = 'IGNORE';
 238   local $SIG{QUIT} = 'IGNORE';
 239   local $SIG{TERM} = 'IGNORE';
 240   local $SIG{TSTP} = 'IGNORE';
 241   local $SIG{PIPE} = 'IGNORE';
 242
 243   my $oldAutoCommit = $FS::UID::AutoCommit;
 244   local $FS::UID::AutoCommit = 0;
 245   my $dbh = dbh;
 246
 247   my $amount = 0;
 248   my $seconds = 0;
 249   if ( $self->payby eq 'PREPAY' ) {
 250     $self->payby('BILL');
 251     my $prepay_credit = qsearchs(
 252       'prepay_credit',
 253       { 'identifier' => $self->payinfo },
 254       '',
 255       'FOR UPDATE'
 256     );
 257     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 258       unless $prepay_credit;
 259     $amount = $prepay_credit->amount;
 260     $seconds = $prepay_credit->seconds;
 261     my $error = $prepay_credit->delete;
 262     if ( $error ) {
 263       $dbh->rollback if $oldAutoCommit;
 264       return "removing prepay_credit (transaction rolled back): $error";
 265     }
 266   }
 267
 268   my $error = $self->SUPER::insert;
 269   if ( $error ) {
 270     $dbh->rollback if $oldAutoCommit;
 271     #return "inserting cust_main record (transaction rolled back): $error";
 272     return $error;
 273   }
 274
 275   # invoicing list
 276   if ( $invoicing_list ) {
 277     $error = $self->check_invoicing_list( $invoicing_list );
 278     if ( $error ) {
 279       $dbh->rollback if $oldAutoCommit;
 280       return "checking invoicing_list (transaction rolled back): $error";
 281     }
 282     $self->invoicing_list( $invoicing_list );
 283   }
 284
 285   # packages
 286   $error = $self->order_pkgs($cust_pkgs, \$seconds);
 287   if ( $error ) {
 288     $dbh->rollback if $oldAutoCommit;
 289     return $error;
 290   }
 291
 292   if ( $seconds ) {
 293     $dbh->rollback if $oldAutoCommit;
 294     return "No svc_acct record to apply pre-paid time";
 295   }
 296
 297   if ( $amount ) {
 298     my $cust_credit = new FS::cust_credit {
 299       'custnum' => $self->custnum,
 300       'amount'  => $amount,
 301     };
 302     $error = $cust_credit->insert;
 303     if ( $error ) {
 304       $dbh->rollback if $oldAutoCommit;
 305       return "inserting credit (transaction rolled back): $error";
 306     }
 307   }
 308
 309   #false laziness with sub replace
 310   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 311   $error = $queue->insert($self->getfield('last'), $self->company);
 312   if ( $error ) {
 313     $dbh->rollback if $oldAutoCommit;
 314     return "queueing job (transaction rolled back): $error";
 315   }
 316
 317   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 318     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 319     $error = $queue->insert($self->getfield('last'), $self->company);
 320     if ( $error ) {
 321       $dbh->rollback if $oldAutoCommit;
 322       return "queueing job (transaction rolled back): $error";
 323     }
 324   }
 325   #eslaf
 326
 327   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 328   '';
 329
 330 }
 331
 332 =item order_pkgs
 333
 334 document me.  like ->insert(%cust_pkg) on an existing record
 335
 336 =cut
 337
 338 sub order_pkgs {
 339   my $self = shift;
 340   my $cust_pkgs = shift;
 341   my $seconds = shift;
 342
 343   local $SIG{HUP} = 'IGNORE';
 344   local $SIG{INT} = 'IGNORE';
 345   local $SIG{QUIT} = 'IGNORE';
 346   local $SIG{TERM} = 'IGNORE';
 347   local $SIG{TSTP} = 'IGNORE';
 348   local $SIG{PIPE} = 'IGNORE';
 349
 350   my $oldAutoCommit = $FS::UID::AutoCommit;
 351   local $FS::UID::AutoCommit = 0;
 352   my $dbh = dbh;
 353
 354   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 355     $cust_pkg->custnum( $self->custnum );
 356     my $error = $cust_pkg->insert;
 357     if ( $error ) {
 358       $dbh->rollback if $oldAutoCommit;
 359       return "inserting cust_pkg (transaction rolled back): $error";
 360     }
 361     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 362       $svc_something->pkgnum( $cust_pkg->pkgnum );
 363       if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 364         $svc_something->seconds( $svc_something->seconds + $$seconds );
 365         $$seconds = 0;
 366       }
 367       $error = $svc_something->insert;
 368       if ( $error ) {
 369         $dbh->rollback if $oldAutoCommit;
 370         #return "inserting svc_ (transaction rolled back): $error";
 371         return $error;
 372       }
 373     }
 374   }
 375
 376   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 377   ''; #no error
 378 }
 379
 380 =item delete NEW_CUSTNUM
 381
 382 This deletes the customer.  If there is an error, returns the error, otherwise
 383 returns false.
 384
 385 This will completely remove all traces of the customer record.  This is not
 386 what you want when a customer cancels service; for that, cancel all of the
 387 customer's packages (see L<FS::cust_pkg/cancel>).
 388
 389 If the customer has any uncancelled packages, you need to pass a new (valid)
 390 customer number for those packages to be transferred to.  Cancelled packages
 391 will be deleted.  Did I mention that this is NOT what you want when a customer
 392 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 393
 394 You can't delete a customer with invoices (see L<FS::cust_bill>),
 395 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 396 refunds (see L<FS::cust_refund>).
 397
 398 =cut
 399
 400 sub delete {
 401   my $self = shift;
 402
 403   local $SIG{HUP} = 'IGNORE';
 404   local $SIG{INT} = 'IGNORE';
 405   local $SIG{QUIT} = 'IGNORE';
 406   local $SIG{TERM} = 'IGNORE';
 407   local $SIG{TSTP} = 'IGNORE';
 408   local $SIG{PIPE} = 'IGNORE';
 409
 410   my $oldAutoCommit = $FS::UID::AutoCommit;
 411   local $FS::UID::AutoCommit = 0;
 412   my $dbh = dbh;
 413
 414   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 415     $dbh->rollback if $oldAutoCommit;
 416     return "Can't delete a customer with invoices";
 417   }
 418   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 419     $dbh->rollback if $oldAutoCommit;
 420     return "Can't delete a customer with credits";
 421   }
 422   if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
 423     $dbh->rollback if $oldAutoCommit;
 424     return "Can't delete a customer with payments";
 425   }
 426   if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
 427     $dbh->rollback if $oldAutoCommit;
 428     return "Can't delete a customer with refunds";
 429   }
 430
 431   my @cust_pkg = $self->ncancelled_pkgs;
 432   if ( @cust_pkg ) {
 433     my $new_custnum = shift;
 434     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 435       $dbh->rollback if $oldAutoCommit;
 436       return "Invalid new customer number: $new_custnum";
 437     }
 438     foreach my $cust_pkg ( @cust_pkg ) {
 439       my %hash = $cust_pkg->hash;
 440       $hash{'custnum'} = $new_custnum;
 441       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 442       my $error = $new_cust_pkg->replace($cust_pkg);
 443       if ( $error ) {
 444         $dbh->rollback if $oldAutoCommit;
 445         return $error;
 446       }
 447     }
 448   }
 449   my @cancelled_cust_pkg = $self->all_pkgs;
 450   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 451     my $error = $cust_pkg->delete;
 452     if ( $error ) {
 453       $dbh->rollback if $oldAutoCommit;
 454       return $error;
 455     }
 456   }
 457
 458   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 459     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 460   ) {
 461     my $error = $cust_main_invoice->delete;
 462     if ( $error ) {
 463       $dbh->rollback if $oldAutoCommit;
 464       return $error;
 465     }
 466   }
 467
 468   my $error = $self->SUPER::delete;
 469   if ( $error ) {
 470     $dbh->rollback if $oldAutoCommit;
 471     return $error;
 472   }
 473
 474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 475   '';
 476
 477 }
 478
 479 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 480
 481 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 482 returns the error, otherwise returns false.
 483
 484 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 485 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 486 expected and rollback the entire transaction; it is not necessary to call
 487 check_invoicing_list first.  Here's an example:
 488
 489   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 490
 491 =cut
 492
 493 sub replace {
 494   my $self = shift;
 495   my $old = shift;
 496   my @param = @_;
 497
 498   local $SIG{HUP} = 'IGNORE';
 499   local $SIG{INT} = 'IGNORE';
 500   local $SIG{QUIT} = 'IGNORE';
 501   local $SIG{TERM} = 'IGNORE';
 502   local $SIG{TSTP} = 'IGNORE';
 503   local $SIG{PIPE} = 'IGNORE';
 504
 505   my $oldAutoCommit = $FS::UID::AutoCommit;
 506   local $FS::UID::AutoCommit = 0;
 507   my $dbh = dbh;
 508
 509   my $error = $self->SUPER::replace($old);
 510
 511   if ( $error ) {
 512     $dbh->rollback if $oldAutoCommit;
 513     return $error;
 514   }
 515
 516   if ( @param ) { # INVOICING_LIST_ARYREF
 517     my $invoicing_list = shift @param;
 518     $error = $self->check_invoicing_list( $invoicing_list );
 519     if ( $error ) {
 520       $dbh->rollback if $oldAutoCommit;
 521       return $error;
 522     }
 523     $self->invoicing_list( $invoicing_list );
 524   }
 525
 526   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 527        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 528     # card/check info has changed, want to retry realtime_card invoice events
 529     #false laziness w/collect
 530     foreach my $cust_bill_event (
 531       grep {
 532              #$_->part_bill_event->plan eq 'realtime-card'
 533              $_->part_bill_event->eventcode =~
 534                  /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/
 535                && $_->status eq 'done'
 536                && $_->statustext
 537            }
 538         map { $_->cust_bill_event }
 539           grep { $_->cust_bill_event }
 540             $self->open_cust_bill
 541
 542     ) {
 543       my $error = $cust_bill_event->retry;
 544       if ( $error ) {
 545         $dbh->rollback if $oldAutoCommit;
 546         return "error scheduling invoice events for retry: $error";
 547       }
 548     }
 549     #eslaf
 550
 551   }
 552
 553   #false laziness with sub insert
 554   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 555   $error = $queue->insert($self->getfield('last'), $self->company);
 556   if ( $error ) {
 557     $dbh->rollback if $oldAutoCommit;
 558     return "queueing job (transaction rolled back): $error";
 559   }
 560
 561   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 562     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 563     $error = $queue->insert($self->getfield('last'), $self->company);
 564     if ( $error ) {
 565       $dbh->rollback if $oldAutoCommit;
 566       return "queueing job (transaction rolled back): $error";
 567     }
 568   }
 569   #eslaf
 570
 571   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 572   '';
 573
 574 }
 575
 576 =item check
 577
 578 Checks all fields to make sure this is a valid customer record.  If there is
 579 an error, returns the error, otherwise returns false.  Called by the insert
 580 and repalce methods.
 581
 582 =cut
 583
 584 sub check {
 585   my $self = shift;
 586
 587   #warn "BEFORE: \n". $self->_dump;
 588
 589   my $error =
 590     $self->ut_numbern('custnum')
 591     || $self->ut_number('agentnum')
 592     || $self->ut_number('refnum')
 593     || $self->ut_name('last')
 594     || $self->ut_name('first')
 595     || $self->ut_textn('company')
 596     || $self->ut_text('address1')
 597     || $self->ut_textn('address2')
 598     || $self->ut_text('city')
 599     || $self->ut_textn('county')
 600     || $self->ut_textn('state')
 601     || $self->ut_country('country')
 602     || $self->ut_anything('comments')
 603     || $self->ut_numbern('referral_custnum')
 604   ;
 605   #barf.  need message catalogs.  i18n.  etc.
 606   $error .= "Please select a advertising source."
 607     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 608   return $error if $error;
 609
 610   return "Unknown agent"
 611     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 612
 613   return "Unknown refnum"
 614     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 615
 616   return "Unknown referring custnum ". $self->referral_custnum
 617     unless ! $self->referral_custnum
 618            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 619
 620   if ( $self->ss eq '' ) {
 621     $self->ss('');
 622   } else {
 623     my $ss = $self->ss;
 624     $ss =~ s/\D//g;
 625     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 626       or return "Illegal social security number: ". $self->ss;
 627     $self->ss("$1-$2-$3");
 628   }
 629
 630
 631 # bad idea to disable, causes billing to fail because of no tax rates later
 632 #  unless ( $import ) {
 633     unless ( qsearch('cust_main_county', {
 634       'country' => $self->country,
 635       'state'   => '',
 636      } ) ) {
 637       return "Unknown state/county/country: ".
 638         $self->state. "/". $self->county. "/". $self->country
 639         unless qsearch('cust_main_county',{
 640           'state'   => $self->state,
 641           'county'  => $self->county,
 642           'country' => $self->country,
 643         } );
 644     }
 645 #  }
 646
 647   $error =
 648     $self->ut_phonen('daytime', $self->country)
 649     || $self->ut_phonen('night', $self->country)
 650     || $self->ut_phonen('fax', $self->country)
 651     || $self->ut_zip('zip', $self->country)
 652   ;
 653   return $error if $error;
 654
 655   my @addfields = qw(
 656     last first company address1 address2 city county state zip
 657     country daytime night fax
 658   );
 659
 660   if ( defined $self->dbdef_table->column('ship_last') ) {
 661     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 662                        @addfields )
 663          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 664        )
 665     {
 666       my $error =
 667         $self->ut_name('ship_last')
 668         || $self->ut_name('ship_first')
 669         || $self->ut_textn('ship_company')
 670         || $self->ut_text('ship_address1')
 671         || $self->ut_textn('ship_address2')
 672         || $self->ut_text('ship_city')
 673         || $self->ut_textn('ship_county')
 674         || $self->ut_textn('ship_state')
 675         || $self->ut_country('ship_country')
 676       ;
 677       return $error if $error;
 678
 679       #false laziness with above
 680       unless ( qsearchs('cust_main_county', {
 681         'country' => $self->ship_country,
 682         'state'   => '',
 683        } ) ) {
 684         return "Unknown ship_state/ship_county/ship_country: ".
 685           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 686           unless qsearchs('cust_main_county',{
 687             'state'   => $self->ship_state,
 688             'county'  => $self->ship_county,
 689             'country' => $self->ship_country,
 690           } );
 691       }
 692       #eofalse
 693
 694       $error =
 695         $self->ut_phonen('ship_daytime', $self->ship_country)
 696         || $self->ut_phonen('ship_night', $self->ship_country)
 697         || $self->ut_phonen('ship_fax', $self->ship_country)
 698         || $self->ut_zip('ship_zip', $self->ship_country)
 699       ;
 700       return $error if $error;
 701
 702     } else { # ship_ info eq billing info, so don't store dup info in database
 703       $self->setfield("ship_$_", '')
 704         foreach qw( last first company address1 address2 city county state zip
 705                     country daytime night fax );
 706     }
 707   }
 708
 709   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
 710     or return "Illegal payby: ". $self->payby;
 711   $self->payby($1);
 712
 713   if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
 714
 715     my $payinfo = $self->payinfo;
 716     $payinfo =~ s/\D//g;
 717     $payinfo =~ /^(\d{13,16})$/
 718       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 719     $payinfo = $1;
 720     $self->payinfo($payinfo);
 721     validate($payinfo)
 722       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 723     return gettext('unknown_card_type')
 724       if cardtype($self->payinfo) eq "Unknown";
 725
 726   } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
 727
 728     my $payinfo = $self->payinfo;
 729     $payinfo =~ s/[^\d\@]//g;
 730     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 731     $payinfo = "$1\@$2";
 732     $self->payinfo($payinfo);
 733
 734   } elsif ( $self->payby eq 'LECB' ) {
 735
 736     my $payinfo = $self->payinfo;
 737     $payinfo =~ s/\D//g;
 738     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 739     $payinfo = $1;
 740     $self->payinfo($payinfo);
 741
 742   } elsif ( $self->payby eq 'BILL' ) {
 743
 744     $error = $self->ut_textn('payinfo');
 745     return "Illegal P.O. number: ". $self->payinfo if $error;
 746
 747   } elsif ( $self->payby eq 'COMP' ) {
 748
 749     $error = $self->ut_textn('payinfo');
 750     return "Illegal comp account issuer: ". $self->payinfo if $error;
 751
 752   } elsif ( $self->payby eq 'PREPAY' ) {
 753
 754     my $payinfo = $self->payinfo;
 755     $payinfo =~ s/\W//g; #anything else would just confuse things
 756     $self->payinfo($payinfo);
 757     $error = $self->ut_alpha('payinfo');
 758     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 759     return "Unknown prepayment identifier"
 760       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 761
 762   }
 763
 764   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 765     return "Expriation date required"
 766       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 767     $self->paydate('');
 768   } else {
 769     my( $m, $y );
 770     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 771       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 772     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
 773       ( $m, $y ) = ( $3, "20$2" );
 774     } else {
 775       return "Illegal expiration date: ". $self->paydate;
 776     }
 777     $self->paydate("$y-$m-01");
 778     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 779     return gettext('expired_card')
 780       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 781   }
 782
 783   if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
 784        ( ! $conf->exists('require_cardname')
 785          || $self->payby !~ /^(CARD|DCRD)$/  )
 786   ) {
 787     $self->payname( $self->first. " ". $self->getfield('last') );
 788   } else {
 789     $self->payname =~ /^([\w \,\.\-\']+)$/
 790       or return gettext('illegal_name'). " payname: ". $self->payname;
 791     $self->payname($1);
 792   }
 793
 794   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 795   $self->tax($1);
 796
 797   $self->otaker(getotaker);
 798
 799   #warn "AFTER: \n". $self->_dump;
 800
 801   ''; #no error
 802 }
 803
 804 =item all_pkgs
 805
 806 Returns all packages (see L<FS::cust_pkg>) for this customer.
 807
 808 =cut
 809
 810 sub all_pkgs {
 811   my $self = shift;
 812   if ( $self->{'_pkgnum'} ) {
 813     values %{ $self->{'_pkgnum'}->cache };
 814   } else {
 815     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 816   }
 817 }
 818
 819 =item ncancelled_pkgs
 820
 821 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 822
 823 =cut
 824
 825 sub ncancelled_pkgs {
 826   my $self = shift;
 827   if ( $self->{'_pkgnum'} ) {
 828     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 829   } else {
 830     @{ [ # force list context
 831       qsearch( 'cust_pkg', {
 832         'custnum' => $self->custnum,
 833         'cancel'  => '',
 834       }),
 835       qsearch( 'cust_pkg', {
 836         'custnum' => $self->custnum,
 837         'cancel'  => 0,
 838       }),
 839     ] };
 840   }
 841 }
 842
 843 =item suspended_pkgs
 844
 845 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 846
 847 =cut
 848
 849 sub suspended_pkgs {
 850   my $self = shift;
 851   grep { $_->susp } $self->ncancelled_pkgs;
 852 }
 853
 854 =item unflagged_suspended_pkgs
 855
 856 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 857 customer (thouse packages without the `manual_flag' set).
 858
 859 =cut
 860
 861 sub unflagged_suspended_pkgs {
 862   my $self = shift;
 863   return $self->suspended_pkgs
 864     unless dbdef->table('cust_pkg')->column('manual_flag');
 865   grep { ! $_->manual_flag } $self->suspended_pkgs;
 866 }
 867
 868 =item unsuspended_pkgs
 869
 870 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
 871 this customer.
 872
 873 =cut
 874
 875 sub unsuspended_pkgs {
 876   my $self = shift;
 877   grep { ! $_->susp } $self->ncancelled_pkgs;
 878 }
 879
 880 =item unsuspend
 881
 882 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
 883 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
 884 on success or a list of errors.
 885
 886 =cut
 887
 888 sub unsuspend {
 889   my $self = shift;
 890   grep { $_->unsuspend } $self->suspended_pkgs;
 891 }
 892
 893 =item suspend
 894
 895 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
 896 Always returns a list: an empty list on success or a list of errors.
 897
 898 =cut
 899
 900 sub suspend {
 901   my $self = shift;
 902   grep { $_->suspend } $self->unsuspended_pkgs;
 903 }
 904
 905 =item cancel
 906
 907 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
 908 Always returns a list: an empty list on success or a list of errors.
 909
 910 =cut
 911
 912 sub cancel {
 913   my $self = shift;
 914   grep { $_->cancel } $self->ncancelled_pkgs;
 915 }
 916
 917 =item agent
 918
 919 Returns the agent (see L<FS::agent>) for this customer.
 920
 921 =cut
 922
 923 sub agent {
 924   my $self = shift;
 925   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 926 }
 927
 928 =item bill OPTIONS
 929
 930 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 931 conjunction with the collect method.
 932
 933 Options are passed as name-value pairs.
 934
 935 The only currently available option is `time', which bills the customer as if
 936 it were that time.  It is specified as a UNIX timestamp; see
 937 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 938 functions.  For example:
 939
 940  use Date::Parse;
 941  ...
 942  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 943
 944 If there is an error, returns the error, otherwise returns false.
 945
 946 =cut
 947
 948 sub bill {
 949   my( $self, %options ) = @_;
 950   my $time = $options{'time'} || time;
 951
 952   my $error;
 953
 954   #put below somehow?
 955   local $SIG{HUP} = 'IGNORE';
 956   local $SIG{INT} = 'IGNORE';
 957   local $SIG{QUIT} = 'IGNORE';
 958   local $SIG{TERM} = 'IGNORE';
 959   local $SIG{TSTP} = 'IGNORE';
 960   local $SIG{PIPE} = 'IGNORE';
 961
 962   my $oldAutoCommit = $FS::UID::AutoCommit;
 963   local $FS::UID::AutoCommit = 0;
 964   my $dbh = dbh;
 965
 966   # find the packages which are due for billing, find out how much they are
 967   # & generate invoice database.
 968
 969   my( $total_setup, $total_recur ) = ( 0, 0 );
 970   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
 971   my @cust_bill_pkg = ();
 972   #my $tax = 0;##
 973   #my $taxable_charged = 0;##
 974   #my $charged = 0;##
 975
 976   my %tax;
 977
 978   foreach my $cust_pkg (
 979     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
 980   ) {
 981
 982     #NO!! next if $cust_pkg->cancel;
 983     next if $cust_pkg->getfield('cancel');
 984
 985     #? to avoid use of uninitialized value errors... ?
 986     $cust_pkg->setfield('bill', '')
 987       unless defined($cust_pkg->bill);
 988
 989     my $part_pkg = $cust_pkg->part_pkg;
 990
 991     #so we don't modify cust_pkg record unnecessarily
 992     my $cust_pkg_mod_flag = 0;
 993     my %hash = $cust_pkg->hash;
 994     my $old_cust_pkg = new FS::cust_pkg \%hash;
 995
 996     my @details = ();
 997
 998     # bill setup
 999     my $setup = 0;
1000     unless ( $cust_pkg->setup ) {
1001       my $setup_prog = $part_pkg->getfield('setup');
1002       $setup_prog =~ /^(.*)$/ or do {
1003         $dbh->rollback if $oldAutoCommit;
1004         return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
1005                ": $setup_prog";
1006       };
1007       $setup_prog = $1;
1008       $setup_prog = '0' if $setup_prog =~ /^\s*$/;
1009
1010         #my $cpt = new Safe;
1011         ##$cpt->permit(); #what is necessary?
1012         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1013         #$setup = $cpt->reval($setup_prog);
1014       $setup = eval $setup_prog;
1015       unless ( defined($setup) ) {
1016         $dbh->rollback if $oldAutoCommit;
1017         return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
1018                "(expression $setup_prog): $@";
1019       }
1020       $cust_pkg->setfield('setup',$time);
1021       $cust_pkg_mod_flag=1;
1022     }
1023
1024     #bill recurring fee
1025     my $recur = 0;
1026     my $sdate;
1027     if ( $part_pkg->getfield('freq') > 0 &&
1028          ! $cust_pkg->getfield('susp') &&
1029          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1030     ) {
1031       my $recur_prog = $part_pkg->getfield('recur');
1032       $recur_prog =~ /^(.*)$/ or do {
1033         $dbh->rollback if $oldAutoCommit;
1034         return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
1035                ": $recur_prog";
1036       };
1037       $recur_prog = $1;
1038       $recur_prog = '0' if $recur_prog =~ /^\s*$/;
1039
1040       # shared with $recur_prog
1041       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1042
1043         #my $cpt = new Safe;
1044         ##$cpt->permit(); #what is necessary?
1045         #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
1046         #$recur = $cpt->reval($recur_prog);
1047       $recur = eval $recur_prog;
1048       unless ( defined($recur) ) {
1049         $dbh->rollback if $oldAutoCommit;
1050         return "Error eval-ing part_pkg->recur pkgpart ".  $part_pkg->pkgpart.
1051                "(expression $recur_prog): $@";
1052       }
1053       #change this bit to use Date::Manip? CAREFUL with timezones (see
1054       # mailing list archive)
1055       my ($sec,$min,$hour,$mday,$mon,$year) =
1056         (localtime($sdate) )[0,1,2,3,4,5];
1057
1058       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1059       # only for figuring next bill date, nothing else, so, reset $sdate again
1060       # here
1061       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1062       $cust_pkg->last_bill($sdate)
1063         if $cust_pkg->dbdef_table->column('last_bill');
1064
1065       $mon += $part_pkg->freq;
1066       until ( $mon < 12 ) { $mon -= 12; $year++; }
1067       $cust_pkg->setfield('bill',
1068         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1069       $cust_pkg_mod_flag = 1;
1070     }
1071
1072     warn "\$setup is undefined" unless defined($setup);
1073     warn "\$recur is undefined" unless defined($recur);
1074     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1075
1076     my $taxable_charged = 0;
1077     if ( $cust_pkg_mod_flag ) {
1078       $error=$cust_pkg->replace($old_cust_pkg);
1079       if ( $error ) { #just in case
1080         $dbh->rollback if $oldAutoCommit;
1081         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1082       }
1083       $setup = sprintf( "%.2f", $setup );
1084       $recur = sprintf( "%.2f", $recur );
1085       if ( $setup < 0 ) {
1086         $dbh->rollback if $oldAutoCommit;
1087         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1088       }
1089       if ( $recur < 0 ) {
1090         $dbh->rollback if $oldAutoCommit;
1091         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1092       }
1093       if ( $setup > 0 || $recur > 0 ) {
1094         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1095           'pkgnum'  => $cust_pkg->pkgnum,
1096           'setup'   => $setup,
1097           'recur'   => $recur,
1098           'sdate'   => $sdate,
1099           'edate'   => $cust_pkg->bill,
1100           'details' => \@details,
1101         });
1102         push @cust_bill_pkg, $cust_bill_pkg;
1103         $total_setup += $setup;
1104         $total_recur += $recur;
1105         $taxable_charged += $setup
1106           unless $part_pkg->setuptax =~ /^Y$/i;
1107         $taxable_charged += $recur
1108           unless $part_pkg->recurtax =~ /^Y$/i;
1109
1110         unless ( $self->tax =~ /Y/i
1111                  || $self->payby eq 'COMP'
1112                  || $taxable_charged == 0 ) {
1113
1114           my $cust_main_county = qsearchs('cust_main_county',{
1115               'state'    => $self->state,
1116               'county'   => $self->county,
1117               'country'  => $self->country,
1118               'taxclass' => $part_pkg->taxclass,
1119           } );
1120           $cust_main_county ||= qsearchs('cust_main_county',{
1121               'state'    => $self->state,
1122               'county'   => $self->county,
1123               'country'  => $self->country,
1124               'taxclass' => '',
1125           } );
1126           unless ( $cust_main_county ) {
1127             $dbh->rollback if $oldAutoCommit;
1128             return
1129               "fatal: can't find tax rate for state/county/country/taxclass ".
1130               join('/', ( map $self->$_(), qw(state county country) ),
1131                         $part_pkg->taxclass ).  "\n";
1132           }
1133
1134           if ( $cust_main_county->exempt_amount ) {
1135             my ($mon,$year) = (localtime($sdate) )[4,5];
1136             $mon++;
1137             my $freq = $part_pkg->freq || 1;
1138             my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1139             foreach my $which_month ( 1 .. $freq ) {
1140               my %hash = (
1141                 'custnum' => $self->custnum,
1142                 'taxnum'  => $cust_main_county->taxnum,
1143                 'year'    => 1900+$year,
1144                 'month'   => $mon++,
1145               );
1146               #until ( $mon < 12 ) { $mon -= 12; $year++; }
1147               until ( $mon < 13 ) { $mon -= 12; $year++; }
1148               my $cust_tax_exempt =
1149                 qsearchs('cust_tax_exempt', \%hash)
1150                 || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1151               my $remaining_exemption = sprintf("%.2f",
1152                 $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
1153               if ( $remaining_exemption > 0 ) {
1154                 my $addl = $remaining_exemption > $taxable_per_month
1155                   ? $taxable_per_month
1156                   : $remaining_exemption;
1157                 $taxable_charged -= $addl;
1158                 my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1159                   $cust_tax_exempt->hash,
1160                   'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1161                 } );
1162                 $error = $new_cust_tax_exempt->exemptnum
1163                   ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1164                   : $new_cust_tax_exempt->insert;
1165                 if ( $error ) {
1166                   $dbh->rollback if $oldAutoCommit;
1167                   return "fatal: can't update cust_tax_exempt: $error";
1168                 }
1169
1170               } # if $remaining_exemption > 0
1171
1172             } #foreach $which_month
1173
1174           } #if $cust_main_county->exempt_amount
1175
1176           $taxable_charged = sprintf( "%.2f", $taxable_charged);
1177
1178           #$tax += $taxable_charged * $cust_main_county->tax / 100
1179           $tax{ $cust_main_county->taxname || 'Tax' } +=
1180             $taxable_charged * $cust_main_county->tax / 100
1181
1182         } #unless $self->tax =~ /Y/i
1183           #       || $self->payby eq 'COMP'
1184           #       || $taxable_charged == 0
1185
1186       } #if $setup > 0 || $recur > 0
1187
1188     } #if $cust_pkg_mod_flag
1189
1190   } #foreach my $cust_pkg
1191
1192   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1193 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1194
1195   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1196     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1197     return '';
1198   }
1199
1200 #  unless ( $self->tax =~ /Y/i
1201 #           || $self->payby eq 'COMP'
1202 #           || $taxable_charged == 0 ) {
1203 #    my $cust_main_county = qsearchs('cust_main_county',{
1204 #        'state'   => $self->state,
1205 #        'county'  => $self->county,
1206 #        'country' => $self->country,
1207 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1208 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1209 #    my $tax = sprintf( "%.2f",
1210 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1211 #    );
1212
1213   foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1214     my $tax = sprintf("%.2f", $tax{$taxname} );
1215     $charged = sprintf( "%.2f", $charged+$tax );
1216
1217     my $cust_bill_pkg = new FS::cust_bill_pkg ({
1218       'pkgnum'   => 0,
1219       'setup'    => $tax,
1220       'recur'    => 0,
1221       'sdate'    => '',
1222       'edate'    => '',
1223       'itemdesc' => $taxname,
1224     });
1225     push @cust_bill_pkg, $cust_bill_pkg;
1226   }
1227 #  }
1228
1229   my $cust_bill = new FS::cust_bill ( {
1230     'custnum' => $self->custnum,
1231     '_date'   => $time,
1232     'charged' => $charged,
1233   } );
1234   $error = $cust_bill->insert;
1235   if ( $error ) {
1236     $dbh->rollback if $oldAutoCommit;
1237     return "can't create invoice for customer #". $self->custnum. ": $error";
1238   }
1239
1240   my $invnum = $cust_bill->invnum;
1241   my $cust_bill_pkg;
1242   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1243     #warn $invnum;
1244     $cust_bill_pkg->invnum($invnum);
1245     $error = $cust_bill_pkg->insert;
1246     if ( $error ) {
1247       $dbh->rollback if $oldAutoCommit;
1248       return "can't create invoice line item for customer #". $self->custnum.
1249              ": $error";
1250     }
1251   }
1252
1253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1254   ''; #no error
1255 }
1256
1257 =item collect OPTIONS
1258
1259 (Attempt to) collect money for this customer's outstanding invoices (see
1260 L<FS::cust_bill>).  Usually used after the bill method.
1261
1262 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1263 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1264 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1265
1266 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1267 and the invoice events web interface.
1268
1269 If there is an error, returns the error, otherwise returns false.
1270
1271 Options are passed as name-value pairs.
1272
1273 Currently available options are:
1274
1275 invoice_time - Use this time when deciding when to print invoices and
1276 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>
1277 for conversion functions.
1278
1279 retry_card - Retry cards even when not scheduled by invoice events.
1280
1281 batch_card - This option is deprecated.  See the invoice events web interface
1282 to control whether cards are batched or run against a realtime gateway.
1283
1284 report_badcard - This option is deprecated.
1285
1286 force_print - This option is deprecated; see the invoice events web interface.
1287
1288 =cut
1289
1290 sub collect {
1291   my( $self, %options ) = @_;
1292   my $invoice_time = $options{'invoice_time'} || time;
1293
1294   #put below somehow?
1295   local $SIG{HUP} = 'IGNORE';
1296   local $SIG{INT} = 'IGNORE';
1297   local $SIG{QUIT} = 'IGNORE';
1298   local $SIG{TERM} = 'IGNORE';
1299   local $SIG{TSTP} = 'IGNORE';
1300   local $SIG{PIPE} = 'IGNORE';
1301
1302   my $oldAutoCommit = $FS::UID::AutoCommit;
1303   local $FS::UID::AutoCommit = 0;
1304   my $dbh = dbh;
1305
1306   my $balance = $self->balance;
1307   warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
1308   unless ( $balance > 0 ) { #redundant?????
1309     $dbh->rollback if $oldAutoCommit; #hmm
1310     return '';
1311   }
1312
1313   if ( exists($options{'retry_card'}) && $options{'retry_card'} ) {
1314     #false laziness w/replace
1315     foreach my $cust_bill_event (
1316       grep {
1317              #$_->part_bill_event->plan eq 'realtime-card'
1318              $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();'
1319                && $_->status eq 'done'
1320                && $_->statustext
1321            }
1322         map { $_->cust_bill_event }
1323           grep { $_->cust_bill_event }
1324             $self->open_cust_bill
1325     ) {
1326       my $error = $cust_bill_event->retry;
1327       if ( $error ) {
1328         $dbh->rollback if $oldAutoCommit;
1329         return "error scheduling invoice events for retry: $error";
1330       }
1331     }
1332     #eslaf
1333   }
1334
1335   foreach my $cust_bill ( $self->cust_bill ) {
1336
1337     #this has to be before next's
1338     my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
1339                                   ? $balance
1340                                   : $cust_bill->owed
1341     );
1342     $balance = sprintf( "%.2f", $balance - $amount );
1343
1344     next unless $cust_bill->owed > 0;
1345
1346     # don't try to charge for the same invoice if it's already in a batch
1347     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1348
1349     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
1350
1351     next unless $amount > 0;
1352
1353
1354     foreach my $part_bill_event (
1355       sort {    $a->seconds   <=> $b->seconds
1356              || $a->weight    <=> $b->weight
1357              || $a->eventpart <=> $b->eventpart }
1358         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1359                && ! qsearchs( 'cust_bill_event', {
1360                                 'invnum'    => $cust_bill->invnum,
1361                                 'eventpart' => $_->eventpart,
1362                                 'status'    => 'done',
1363                                                                    } )
1364              }
1365           qsearch('part_bill_event', { 'payby'    => $self->payby,
1366                                        'disabled' => '',           } )
1367     ) {
1368
1369       last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
1370
1371       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1372         if $Debug;
1373       my $cust_main = $self; #for callback
1374       my $error = eval $part_bill_event->eventcode;
1375
1376       my $status = '';
1377       my $statustext = '';
1378       if ( $@ ) {
1379         $status = 'failed';
1380         $statustext = $@;
1381       } elsif ( $error ) {
1382         $status = 'done';
1383         $statustext = $error;
1384       } else {
1385         $status = 'done'
1386       }
1387
1388       #add cust_bill_event
1389       my $cust_bill_event = new FS::cust_bill_event {
1390         'invnum'     => $cust_bill->invnum,
1391         'eventpart'  => $part_bill_event->eventpart,
1392         #'_date'      => $invoice_time,
1393         '_date'      => time,
1394         'status'     => $status,
1395         'statustext' => $statustext,
1396       };
1397       $error = $cust_bill_event->insert;
1398       if ( $error ) {
1399         #$dbh->rollback if $oldAutoCommit;
1400         #return "error: $error";
1401
1402         # gah, even with transactions.
1403         $dbh->commit if $oldAutoCommit; #well.
1404         my $e = 'WARNING: Event run but database not updated - '.
1405                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1406                 ', eventpart '. $part_bill_event->eventpart.
1407                 ": $error";
1408         warn $e;
1409         return $e;
1410       }
1411
1412
1413     }
1414
1415   }
1416
1417   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1418   '';
1419
1420 }
1421
1422 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1423
1424 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1425 via a Business::OnlinePayment realtime gateway.  See
1426 L<http://420.am/business-onlinepayment> for supported gateways.
1427
1428 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1429
1430 Available options are: I<description>, I<invnum>, I<quiet>
1431
1432 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1433 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1434 if set, will override the value from the customer record.
1435
1436 I<description> is a free-text field passed to the gateway.  It defaults to
1437 "Internet services".
1438
1439 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1440 specified invoice.  If you don't specify an I<invnum> you might want to
1441 call the B<apply_payments> method.
1442
1443 I<quiet> can be set true to surpress email decline notices.
1444
1445 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1446
1447 =cut
1448
1449 sub realtime_bop {
1450   my( $self, $method, $amount, %options ) = @_;
1451   if ( $Debug ) {
1452     warn "$self $method $amount\n";
1453     warn "  $_ => $options{$_}\n" foreach keys %options;
1454   }
1455
1456   $options{'description'} ||= 'Internet services';
1457
1458   #pre-requisites
1459   die "Real-time processing not enabled\n"
1460     unless $conf->exists('business-onlinepayment');
1461   eval "use Business::OnlinePayment";
1462   die $@ if $@;
1463
1464   #overrides
1465   $self->set( $_ => $options{$_} )
1466     foreach grep { exists($options{$_}) }
1467             qw( payname address1 address2 city state zip payinfo paydate );
1468
1469   #load up config
1470   my $bop_config = 'business-onlinepayment';
1471   $bop_config .= '-ach'
1472     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1473   my ( $processor, $login, $password, $action, @bop_options ) =
1474     $conf->config($bop_config);
1475   $action ||= 'normal authorization';
1476   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1477
1478   #massage data
1479
1480   my $address = $self->address1;
1481   $address .= ", ". $self->address2 if $self->address2;
1482
1483   my($payname, $payfirst, $paylast);
1484   if ( $self->payname && $method ne 'ECHECK' ) {
1485     $payname = $self->payname;
1486     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1487       or return "Illegal payname $payname";
1488     ($payfirst, $paylast) = ($1, $2);
1489   } else {
1490     $payfirst = $self->getfield('first');
1491     $paylast = $self->getfield('last');
1492     $payname =  "$payfirst $paylast";
1493   }
1494
1495   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1496   if ( $conf->exists('emailinvoiceauto')
1497        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1498     push @invoicing_list, $self->all_emails;
1499   }
1500   my $email = $invoicing_list[0];
1501
1502   my %content;
1503   if ( $method eq 'CC' ) {
1504     $content{card_number} = $self->payinfo;
1505     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1506     $content{expiration} = "$2/$1";
1507   } elsif ( $method eq 'ECHECK' ) {
1508     my($account_number,$routing_code) = $self->payinfo;
1509     ( $content{account_number}, $content{routing_code} ) =
1510       split('@', $self->payinfo);
1511     $content{bank_name} = $self->payname;
1512   } elsif ( $method eq 'LEC' ) {
1513     $content{phone} = $self->payinfo;
1514   }
1515
1516   #transaction(s)
1517
1518   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1519
1520   my $transaction =
1521     new Business::OnlinePayment( $processor, @bop_options );
1522   $transaction->content(
1523     'type'           => $method,
1524     'login'          => $login,
1525     'password'       => $password,
1526     'action'         => $action1,
1527     'description'    => $options{'description'},
1528     'amount'         => $amount,
1529     'invoice_number' => $options{'invnum'},
1530     'customer_id'    => $self->custnum,
1531     'last_name'      => $paylast,
1532     'first_name'     => $payfirst,
1533     'name'           => $payname,
1534     'address'        => $address,
1535     'city'           => $self->city,
1536     'state'          => $self->state,
1537     'zip'            => $self->zip,
1538     'country'        => $self->country,
1539     'referer'        => 'http://cleanwhisker.420.am/',
1540     'email'          => $email,
1541     'phone'          => $self->daytime || $self->night,
1542     %content, #after
1543   );
1544   $transaction->submit();
1545
1546   if ( $transaction->is_success() && $action2 ) {
1547     my $auth = $transaction->authorization;
1548     my $ordernum = $transaction->can('order_number')
1549                    ? $transaction->order_number
1550                    : '';
1551
1552     my $capture =
1553       new Business::OnlinePayment( $processor, @bop_options );
1554
1555     my %capture = (
1556       %content,
1557       type           => $method,
1558       action         => $action2,
1559       login          => $login,
1560       password       => $password,
1561       order_number   => $ordernum,
1562       amount         => $amount,
1563       authorization  => $auth,
1564       description    => $options{'description'},
1565     );
1566
1567     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1568                            transaction_sequence_num local_transaction_date
1569                            local_transaction_time AVS_result_code          )) {
1570       $capture{$field} = $transaction->$field() if $transaction->can($field);
1571     }
1572
1573     $capture->content( %capture );
1574
1575     $capture->submit();
1576
1577     unless ( $capture->is_success ) {
1578       my $e = "Authorization sucessful but capture failed, custnum #".
1579               $self->custnum. ': '.  $capture->result_code.
1580               ": ". $capture->error_message;
1581       warn $e;
1582       return $e;
1583     }
1584
1585   }
1586
1587   #result handling
1588   if ( $transaction->is_success() ) {
1589
1590     my %method2payby = (
1591       'CC'     => 'CARD',
1592       'ECHECK' => 'CHEK',
1593       'LEC'    => 'LECB',
1594     );
1595
1596     my $cust_pay = new FS::cust_pay ( {
1597        'custnum'  => $self->custnum,
1598        'invnum'   => $options{'invnum'},
1599        'paid'     => $amount,
1600        '_date'     => '',
1601        'payby'    => $method2payby{$method},
1602        'payinfo'  => $self->payinfo,
1603        'paybatch' => "$processor:". $transaction->authorization,
1604     } );
1605     my $error = $cust_pay->insert;
1606     if ( $error ) {
1607       # gah, even with transactions.
1608       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1609               'error applying payment, invnum #' . $self->invnum.
1610               " ($processor): $error";
1611       warn $e;
1612       return $e;
1613     } else {
1614       return '';
1615     }
1616
1617   } else {
1618
1619     my $perror = "$processor error: ". $transaction->error_message;
1620
1621     if ( !$options{'quiet'} && $conf->exists('emaildecline')
1622          && grep { $_ ne 'POST' } $self->invoicing_list
1623     ) {
1624       my @templ = $conf->config('declinetemplate');
1625       my $template = new Text::Template (
1626         TYPE   => 'ARRAY',
1627         SOURCE => [ map "$_\n", @templ ],
1628       ) or return "($perror) can't create template: $Text::Template::ERROR";
1629       $template->compile()
1630         or return "($perror) can't compile template: $Text::Template::ERROR";
1631
1632       my $templ_hash = { error => $transaction->error_message };
1633
1634       my $error = send_email(
1635         'from'    => $conf->config('invoice_from'),
1636         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1637         'subject' => 'Your payment could not be processed',
1638         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1639       );
1640
1641       $perror .= " (also received error sending decline notification: $error)"
1642         if $error;
1643
1644     }
1645
1646     return $perror;
1647   }
1648
1649 }
1650
1651 =item total_owed
1652
1653 Returns the total owed for this customer on all invoices
1654 (see L<FS::cust_bill/owed>).
1655
1656 =cut
1657
1658 sub total_owed {
1659   my $self = shift;
1660   $self->total_owed_date(2145859200); #12/31/2037
1661 }
1662
1663 =item total_owed_date TIME
1664
1665 Returns the total owed for this customer on all invoices with date earlier than
1666 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1667 see L<Time::Local> and L<Date::Parse> for conversion functions.
1668
1669 =cut
1670
1671 sub total_owed_date {
1672   my $self = shift;
1673   my $time = shift;
1674   my $total_bill = 0;
1675   foreach my $cust_bill (
1676     grep { $_->_date <= $time }
1677       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1678   ) {
1679     $total_bill += $cust_bill->owed;
1680   }
1681   sprintf( "%.2f", $total_bill );
1682 }
1683
1684 =item apply_credits
1685
1686 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1687 to outstanding invoice balances in chronological order and returns the value
1688 of any remaining unapplied credits available for refund
1689 (see L<FS::cust_refund>).
1690
1691 =cut
1692
1693 sub apply_credits {
1694   my $self = shift;
1695
1696   return 0 unless $self->total_credited;
1697
1698   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1699       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1700
1701   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1702       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1703
1704   my $credit;
1705
1706   foreach my $cust_bill ( @invoices ) {
1707     my $amount;
1708
1709     if ( !defined($credit) || $credit->credited == 0) {
1710       $credit = pop @credits or last;
1711     }
1712
1713     if ($cust_bill->owed >= $credit->credited) {
1714       $amount=$credit->credited;
1715     }else{
1716       $amount=$cust_bill->owed;
1717     }
1718
1719     my $cust_credit_bill = new FS::cust_credit_bill ( {
1720       'crednum' => $credit->crednum,
1721       'invnum'  => $cust_bill->invnum,
1722       'amount'  => $amount,
1723     } );
1724     my $error = $cust_credit_bill->insert;
1725     die $error if $error;
1726
1727     redo if ($cust_bill->owed > 0);
1728
1729   }
1730
1731   return $self->total_credited;
1732 }
1733
1734 =item apply_payments
1735
1736 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1737 to outstanding invoice balances in chronological order.
1738
1739  #and returns the value of any remaining unapplied payments.
1740
1741 =cut
1742
1743 sub apply_payments {
1744   my $self = shift;
1745
1746   #return 0 unless
1747
1748   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1749       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1750
1751   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1752       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1753
1754   my $payment;
1755
1756   foreach my $cust_bill ( @invoices ) {
1757     my $amount;
1758
1759     if ( !defined($payment) || $payment->unapplied == 0 ) {
1760       $payment = pop @payments or last;
1761     }
1762
1763     if ( $cust_bill->owed >= $payment->unapplied ) {
1764       $amount = $payment->unapplied;
1765     } else {
1766       $amount = $cust_bill->owed;
1767     }
1768
1769     my $cust_bill_pay = new FS::cust_bill_pay ( {
1770       'paynum' => $payment->paynum,
1771       'invnum' => $cust_bill->invnum,
1772       'amount' => $amount,
1773     } );
1774     my $error = $cust_bill_pay->insert;
1775     die $error if $error;
1776
1777     redo if ( $cust_bill->owed > 0);
1778
1779   }
1780
1781   return $self->total_unapplied_payments;
1782 }
1783
1784 =item total_credited
1785
1786 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1787 customer.  See L<FS::cust_credit/credited>.
1788
1789 =cut
1790
1791 sub total_credited {
1792   my $self = shift;
1793   my $total_credit = 0;
1794   foreach my $cust_credit ( qsearch('cust_credit', {
1795     'custnum' => $self->custnum,
1796   } ) ) {
1797     $total_credit += $cust_credit->credited;
1798   }
1799   sprintf( "%.2f", $total_credit );
1800 }
1801
1802 =item total_unapplied_payments
1803
1804 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1805 See L<FS::cust_pay/unapplied>.
1806
1807 =cut
1808
1809 sub total_unapplied_payments {
1810   my $self = shift;
1811   my $total_unapplied = 0;
1812   foreach my $cust_pay ( qsearch('cust_pay', {
1813     'custnum' => $self->custnum,
1814   } ) ) {
1815     $total_unapplied += $cust_pay->unapplied;
1816   }
1817   sprintf( "%.2f", $total_unapplied );
1818 }
1819
1820 =item balance
1821
1822 Returns the balance for this customer (total_owed minus total_credited
1823 minus total_unapplied_payments).
1824
1825 =cut
1826
1827 sub balance {
1828   my $self = shift;
1829   sprintf( "%.2f",
1830     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1831   );
1832 }
1833
1834 =item balance_date TIME
1835
1836 Returns the balance for this customer, only considering invoices with date
1837 earlier than TIME (total_owed_date minus total_credited minus
1838 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1839 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1840 functions.
1841
1842 =cut
1843
1844 sub balance_date {
1845   my $self = shift;
1846   my $time = shift;
1847   sprintf( "%.2f",
1848     $self->total_owed_date($time)
1849       - $self->total_credited
1850       - $self->total_unapplied_payments
1851   );
1852 }
1853
1854 =item invoicing_list [ ARRAYREF ]
1855
1856 If an arguement is given, sets these email addresses as invoice recipients
1857 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1858 (except as warnings), so use check_invoicing_list first.
1859
1860 Returns a list of email addresses (with svcnum entries expanded).
1861
1862 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1863 check it without disturbing anything by passing nothing.
1864
1865 This interface may change in the future.
1866
1867 =cut
1868
1869 sub invoicing_list {
1870   my( $self, $arrayref ) = @_;
1871   if ( $arrayref ) {
1872     my @cust_main_invoice;
1873     if ( $self->custnum ) {
1874       @cust_main_invoice =
1875         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1876     } else {
1877       @cust_main_invoice = ();
1878     }
1879     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1880       #warn $cust_main_invoice->destnum;
1881       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1882         #warn $cust_main_invoice->destnum;
1883         my $error = $cust_main_invoice->delete;
1884         warn $error if $error;
1885       }
1886     }
1887     if ( $self->custnum ) {
1888       @cust_main_invoice =
1889         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1890     } else {
1891       @cust_main_invoice = ();
1892     }
1893     my %seen = map { $_->address => 1 } @cust_main_invoice;
1894     foreach my $address ( @{$arrayref} ) {
1895       next if exists $seen{$address} && $seen{$address};
1896       $seen{$address} = 1;
1897       my $cust_main_invoice = new FS::cust_main_invoice ( {
1898         'custnum' => $self->custnum,
1899         'dest'    => $address,
1900       } );
1901       my $error = $cust_main_invoice->insert;
1902       warn $error if $error;
1903     }
1904   }
1905   if ( $self->custnum ) {
1906     map { $_->address }
1907       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1908   } else {
1909     ();
1910   }
1911 }
1912
1913 =item check_invoicing_list ARRAYREF
1914
1915 Checks these arguements as valid input for the invoicing_list method.  If there
1916 is an error, returns the error, otherwise returns false.
1917
1918 =cut
1919
1920 sub check_invoicing_list {
1921   my( $self, $arrayref ) = @_;
1922   foreach my $address ( @{$arrayref} ) {
1923     my $cust_main_invoice = new FS::cust_main_invoice ( {
1924       'custnum' => $self->custnum,
1925       'dest'    => $address,
1926     } );
1927     my $error = $self->custnum
1928                 ? $cust_main_invoice->check
1929                 : $cust_main_invoice->checkdest
1930     ;
1931     return $error if $error;
1932   }
1933   '';
1934 }
1935
1936 =item set_default_invoicing_list
1937
1938 Sets the invoicing list to all accounts associated with this customer,
1939 overwriting any previous invoicing list.
1940
1941 =cut
1942
1943 sub set_default_invoicing_list {
1944   my $self = shift;
1945   $self->invoicing_list($self->all_emails);
1946 }
1947
1948 =item all_emails
1949
1950 Returns the email addresses of all accounts provisioned for this customer.
1951
1952 =cut
1953
1954 sub all_emails {
1955   my $self = shift;
1956   my %list;
1957   foreach my $cust_pkg ( $self->all_pkgs ) {
1958     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1959     my @svc_acct =
1960       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1961         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1962           @cust_svc;
1963     $list{$_}=1 foreach map { $_->email } @svc_acct;
1964   }
1965   keys %list;
1966 }
1967
1968 =item invoicing_list_addpost
1969
1970 Adds postal invoicing to this customer.  If this customer is already configured
1971 to receive postal invoices, does nothing.
1972
1973 =cut
1974
1975 sub invoicing_list_addpost {
1976   my $self = shift;
1977   return if grep { $_ eq 'POST' } $self->invoicing_list;
1978   my @invoicing_list = $self->invoicing_list;
1979   push @invoicing_list, 'POST';
1980   $self->invoicing_list(\@invoicing_list);
1981 }
1982
1983 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1984
1985 Returns an array of customers referred by this customer (referral_custnum set
1986 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1987 customers referred by customers referred by this customer and so on, inclusive.
1988 The default behavior is DEPTH 1 (no recursion).
1989
1990 =cut
1991
1992 sub referral_cust_main {
1993   my $self = shift;
1994   my $depth = @_ ? shift : 1;
1995   my $exclude = @_ ? shift : {};
1996
1997   my @cust_main =
1998     map { $exclude->{$_->custnum}++; $_; }
1999       grep { ! $exclude->{ $_->custnum } }
2000         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2001
2002   if ( $depth > 1 ) {
2003     push @cust_main,
2004       map { $_->referral_cust_main($depth-1, $exclude) }
2005         @cust_main;
2006   }
2007
2008   @cust_main;
2009 }
2010
2011 =item referral_cust_main_ncancelled
2012
2013 Same as referral_cust_main, except only returns customers with uncancelled
2014 packages.
2015
2016 =cut
2017
2018 sub referral_cust_main_ncancelled {
2019   my $self = shift;
2020   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2021 }
2022
2023 =item referral_cust_pkg [ DEPTH ]
2024
2025 Like referral_cust_main, except returns a flat list of all unsuspended (and
2026 uncancelled) packages for each customer.  The number of items in this list may
2027 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2028
2029 =cut
2030
2031 sub referral_cust_pkg {
2032   my $self = shift;
2033   my $depth = @_ ? shift : 1;
2034
2035   map { $_->unsuspended_pkgs }
2036     grep { $_->unsuspended_pkgs }
2037       $self->referral_cust_main($depth);
2038 }
2039
2040 =item credit AMOUNT, REASON
2041
2042 Applies a credit to this customer.  If there is an error, returns the error,
2043 otherwise returns false.
2044
2045 =cut
2046
2047 sub credit {
2048   my( $self, $amount, $reason ) = @_;
2049   my $cust_credit = new FS::cust_credit {
2050     'custnum' => $self->custnum,
2051     'amount'  => $amount,
2052     'reason'  => $reason,
2053   };
2054   $cust_credit->insert;
2055 }
2056
2057 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2058
2059 Creates a one-time charge for this customer.  If there is an error, returns
2060 the error, otherwise returns false.
2061
2062 =cut
2063
2064 sub charge {
2065   my ( $self, $amount ) = ( shift, shift );
2066   my $pkg      = @_ ? shift : 'One-time charge';
2067   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2068   my $taxclass = @_ ? shift : '';
2069
2070   local $SIG{HUP} = 'IGNORE';
2071   local $SIG{INT} = 'IGNORE';
2072   local $SIG{QUIT} = 'IGNORE';
2073   local $SIG{TERM} = 'IGNORE';
2074   local $SIG{TSTP} = 'IGNORE';
2075   local $SIG{PIPE} = 'IGNORE';
2076
2077   my $oldAutoCommit = $FS::UID::AutoCommit;
2078   local $FS::UID::AutoCommit = 0;
2079   my $dbh = dbh;
2080
2081   my $part_pkg = new FS::part_pkg ( {
2082     'pkg'      => $pkg,
2083     'comment'  => $comment,
2084     'setup'    => $amount,
2085     'freq'     => 0,
2086     'recur'    => '0',
2087     'disabled' => 'Y',
2088     'taxclass' => $taxclass,
2089   } );
2090
2091   my $error = $part_pkg->insert;
2092   if ( $error ) {
2093     $dbh->rollback if $oldAutoCommit;
2094     return $error;
2095   }
2096
2097   my $pkgpart = $part_pkg->pkgpart;
2098   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2099   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2100     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2101     $error = $type_pkgs->insert;
2102     if ( $error ) {
2103       $dbh->rollback if $oldAutoCommit;
2104       return $error;
2105     }
2106   }
2107
2108   my $cust_pkg = new FS::cust_pkg ( {
2109     'custnum' => $self->custnum,
2110     'pkgpart' => $pkgpart,
2111   } );
2112
2113   $error = $cust_pkg->insert;
2114   if ( $error ) {
2115     $dbh->rollback if $oldAutoCommit;
2116     return $error;
2117   }
2118
2119   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2120   '';
2121
2122 }
2123
2124 =item cust_bill
2125
2126 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2127
2128 =cut
2129
2130 sub cust_bill {
2131   my $self = shift;
2132   sort { $a->_date <=> $b->_date }
2133     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2134 }
2135
2136 =item open_cust_bill
2137
2138 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2139 customer.
2140
2141 =cut
2142
2143 sub open_cust_bill {
2144   my $self = shift;
2145   grep { $_->owed > 0 } $self->cust_bill;
2146 }
2147
2148 =back
2149
2150 =head1 SUBROUTINES
2151
2152 =over 4
2153
2154 =item check_and_rebuild_fuzzyfiles
2155
2156 =cut
2157
2158 sub check_and_rebuild_fuzzyfiles {
2159   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2160   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2161     or &rebuild_fuzzyfiles;
2162 }
2163
2164 =item rebuild_fuzzyfiles
2165
2166 =cut
2167
2168 sub rebuild_fuzzyfiles {
2169
2170   use Fcntl qw(:flock);
2171
2172   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2173
2174   #last
2175
2176   open(LASTLOCK,">>$dir/cust_main.last")
2177     or die "can't open $dir/cust_main.last: $!";
2178   flock(LASTLOCK,LOCK_EX)
2179     or die "can't lock $dir/cust_main.last: $!";
2180
2181   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2182   push @all_last,
2183                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2184     if defined dbdef->table('cust_main')->column('ship_last');
2185
2186   open (LASTCACHE,">$dir/cust_main.last.tmp")
2187     or die "can't open $dir/cust_main.last.tmp: $!";
2188   print LASTCACHE join("\n", @all_last), "\n";
2189   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2190
2191   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2192   close LASTLOCK;
2193
2194   #company
2195
2196   open(COMPANYLOCK,">>$dir/cust_main.company")
2197     or die "can't open $dir/cust_main.company: $!";
2198   flock(COMPANYLOCK,LOCK_EX)
2199     or die "can't lock $dir/cust_main.company: $!";
2200
2201   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2202   push @all_company,
2203        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2204     if defined dbdef->table('cust_main')->column('ship_last');
2205
2206   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2207     or die "can't open $dir/cust_main.company.tmp: $!";
2208   print COMPANYCACHE join("\n", @all_company), "\n";
2209   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2210
2211   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2212   close COMPANYLOCK;
2213
2214 }
2215
2216 =item all_last
2217
2218 =cut
2219
2220 sub all_last {
2221   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2222   open(LASTCACHE,"<$dir/cust_main.last")
2223     or die "can't open $dir/cust_main.last: $!";
2224   my @array = map { chomp; $_; } <LASTCACHE>;
2225   close LASTCACHE;
2226   \@array;
2227 }
2228
2229 =item all_company
2230
2231 =cut
2232
2233 sub all_company {
2234   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2235   open(COMPANYCACHE,"<$dir/cust_main.company")
2236     or die "can't open $dir/cust_main.last: $!";
2237   my @array = map { chomp; $_; } <COMPANYCACHE>;
2238   close COMPANYCACHE;
2239   \@array;
2240 }
2241
2242 =item append_fuzzyfiles LASTNAME COMPANY
2243
2244 =cut
2245
2246 sub append_fuzzyfiles {
2247   my( $last, $company ) = @_;
2248
2249   &check_and_rebuild_fuzzyfiles;
2250
2251   use Fcntl qw(:flock);
2252
2253   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2254
2255   if ( $last ) {
2256
2257     open(LAST,">>$dir/cust_main.last")
2258       or die "can't open $dir/cust_main.last: $!";
2259     flock(LAST,LOCK_EX)
2260       or die "can't lock $dir/cust_main.last: $!";
2261
2262     print LAST "$last\n";
2263
2264     flock(LAST,LOCK_UN)
2265       or die "can't unlock $dir/cust_main.last: $!";
2266     close LAST;
2267   }
2268
2269   if ( $company ) {
2270
2271     open(COMPANY,">>$dir/cust_main.company")
2272       or die "can't open $dir/cust_main.company: $!";
2273     flock(COMPANY,LOCK_EX)
2274       or die "can't lock $dir/cust_main.company: $!";
2275
2276     print COMPANY "$company\n";
2277
2278     flock(COMPANY,LOCK_UN)
2279       or die "can't unlock $dir/cust_main.company: $!";
2280
2281     close COMPANY;
2282   }
2283
2284   1;
2285 }
2286
2287 =item batch_import
2288
2289 =cut
2290
2291 sub batch_import {
2292   my $param = shift;
2293   #warn join('-',keys %$param);
2294   my $fh = $param->{filehandle};
2295   my $agentnum = $param->{agentnum};
2296   my $refnum = $param->{refnum};
2297   my $pkgpart = $param->{pkgpart};
2298   my @fields = @{$param->{fields}};
2299
2300   eval "use Date::Parse;";
2301   die $@ if $@;
2302   eval "use Text::CSV_XS;";
2303   die $@ if $@;
2304
2305   my $csv = new Text::CSV_XS;
2306   #warn $csv;
2307   #warn $fh;
2308
2309   my $imported = 0;
2310   #my $columns;
2311
2312   local $SIG{HUP} = 'IGNORE';
2313   local $SIG{INT} = 'IGNORE';
2314   local $SIG{QUIT} = 'IGNORE';
2315   local $SIG{TERM} = 'IGNORE';
2316   local $SIG{TSTP} = 'IGNORE';
2317   local $SIG{PIPE} = 'IGNORE';
2318
2319   my $oldAutoCommit = $FS::UID::AutoCommit;
2320   local $FS::UID::AutoCommit = 0;
2321   my $dbh = dbh;
2322
2323   #while ( $columns = $csv->getline($fh) ) {
2324   my $line;
2325   while ( defined($line=<$fh>) ) {
2326
2327     $csv->parse($line) or do {
2328       $dbh->rollback if $oldAutoCommit;
2329       return "can't parse: ". $csv->error_input();
2330     };
2331
2332     my @columns = $csv->fields();
2333     #warn join('-',@columns);
2334
2335     my %cust_main = (
2336       agentnum => $agentnum,
2337       refnum   => $refnum,
2338       country  => 'US', #default
2339       payby    => 'BILL', #default
2340       paydate  => '12/2037', #default
2341     );
2342     my $billtime = time;
2343     my %cust_pkg = ( pkgpart => $pkgpart );
2344     foreach my $field ( @fields ) {
2345       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2346         #$cust_pkg{$1} = str2time( shift @$columns );
2347         if ( $1 eq 'setup' ) {
2348           $billtime = str2time(shift @columns);
2349         } else {
2350           $cust_pkg{$1} = str2time( shift @columns );
2351         }
2352       } else {
2353         #$cust_main{$field} = shift @$columns;
2354         $cust_main{$field} = shift @columns;
2355       }
2356     }
2357
2358     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2359     my $cust_main = new FS::cust_main ( \%cust_main );
2360     use Tie::RefHash;
2361     tie my %hash, 'Tie::RefHash'; #this part is important
2362     $hash{$cust_pkg} = [] if $pkgpart;
2363     my $error = $cust_main->insert( \%hash );
2364
2365     if ( $error ) {
2366       $dbh->rollback if $oldAutoCommit;
2367       return "can't insert customer for $line: $error";
2368     }
2369
2370     #false laziness w/bill.cgi
2371     $error = $cust_main->bill( 'time' => $billtime );
2372     if ( $error ) {
2373       $dbh->rollback if $oldAutoCommit;
2374       return "can't bill customer for $line: $error";
2375     }
2376
2377     $cust_main->apply_payments;
2378     $cust_main->apply_credits;
2379
2380     $error = $cust_main->collect();
2381     if ( $error ) {
2382       $dbh->rollback if $oldAutoCommit;
2383       return "can't collect customer for $line: $error";
2384     }
2385
2386     $imported++;
2387   }
2388
2389   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2390
2391   return "Empty file!" unless $imported;
2392
2393   ''; #no error
2394
2395 }
2396
2397 =item batch_charge
2398
2399 =cut
2400
2401 sub batch_charge {
2402   my $param = shift;
2403   #warn join('-',keys %$param);
2404   my $fh = $param->{filehandle};
2405   my @fields = @{$param->{fields}};
2406
2407   eval "use Date::Parse;";
2408   die $@ if $@;
2409   eval "use Text::CSV_XS;";
2410   die $@ if $@;
2411
2412   my $csv = new Text::CSV_XS;
2413   #warn $csv;
2414   #warn $fh;
2415
2416   my $imported = 0;
2417   #my $columns;
2418
2419   local $SIG{HUP} = 'IGNORE';
2420   local $SIG{INT} = 'IGNORE';
2421   local $SIG{QUIT} = 'IGNORE';
2422   local $SIG{TERM} = 'IGNORE';
2423   local $SIG{TSTP} = 'IGNORE';
2424   local $SIG{PIPE} = 'IGNORE';
2425
2426   my $oldAutoCommit = $FS::UID::AutoCommit;
2427   local $FS::UID::AutoCommit = 0;
2428   my $dbh = dbh;
2429
2430   #while ( $columns = $csv->getline($fh) ) {
2431   my $line;
2432   while ( defined($line=<$fh>) ) {
2433
2434     $csv->parse($line) or do {
2435       $dbh->rollback if $oldAutoCommit;
2436       return "can't parse: ". $csv->error_input();
2437     };
2438
2439     my @columns = $csv->fields();
2440     #warn join('-',@columns);
2441
2442     my %row = ();
2443     foreach my $field ( @fields ) {
2444       $row{$field} = shift @columns;
2445     }
2446
2447     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2448     unless ( $cust_main ) {
2449       $dbh->rollback if $oldAutoCommit;
2450       return "unknown custnum $row{'custnum'}";
2451     }
2452
2453     if ( $row{'amount'} > 0 ) {
2454       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2455       if ( $error ) {
2456         $dbh->rollback if $oldAutoCommit;
2457         return $error;
2458       }
2459       $imported++;
2460     } elsif ( $row{'amount'} < 0 ) {
2461       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2462                                       $row{'pkg'}                         );
2463       if ( $error ) {
2464         $dbh->rollback if $oldAutoCommit;
2465         return $error;
2466       }
2467       $imported++;
2468     } else {
2469       #hmm?
2470     }
2471
2472   }
2473
2474   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2475
2476   return "Empty file!" unless $imported;
2477
2478   ''; #no error
2479
2480 }
2481
2482 =back
2483
2484 =head1 BUGS
2485
2486 The delete method.
2487
2488 The delete method should possibly take an FS::cust_main object reference
2489 instead of a scalar customer number.
2490
2491 Bill and collect options should probably be passed as references instead of a
2492 list.
2493
2494 There should probably be a configuration file with a list of allowed credit
2495 card types.
2496
2497 No multiple currency support (probably a larger project than just this module).
2498
2499 =head1 SEE ALSO
2500
2501 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2502 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2503 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2504
2505 =cut
2506
2507 1;
2508
2509