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