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 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1415 via a Business::OnlinePayment realtime gateway.  See
1416 L<http://420.am/business-onlinepayment> for supported gateways.
1417
1418 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1419
1420 Available options are: I<description>, I<invnum>, I<quiet>
1421
1422 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1423 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1424 if set, will override the value from the customer record.
1425
1426 I<description> is a free-text field passed to the gateway.  It defaults to
1427 "Internet services".
1428
1429 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1430 specified invoice.  If you don't specify an I<invnum> you might want to
1431 call the B<apply_payments> method.
1432
1433 I<quiet> can be set true to surpress email decline notices.
1434
1435 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1436
1437 =cut
1438
1439 sub realtime_bop {
1440   my( $self, $method, $amount, %options ) = @_;
1441   $options{'description'} ||= 'Internet services';
1442
1443   #pre-requisites
1444   die "Real-time processing not enabled\n"
1445     unless $conf->exists('business-onlinepayment');
1446   eval "use Business::OnlinePayment";
1447   die $@ if $@;
1448
1449   #overrides
1450   $self->set( $_ => $options{$_} )
1451     foreach grep { exists($options{$_}) }
1452             qw( payname address1 address2 city state zip payinfo paydate );
1453
1454   #load up config
1455   my $bop_config = 'business-onlinepayment';
1456   $bop_config .= '-ach'
1457     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1458   my ( $processor, $login, $password, $action, @bop_options ) =
1459     $conf->config($bop_config);
1460   $action ||= 'normal authorization';
1461   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1462
1463   #massage data
1464
1465   my $address = $self->address1;
1466   $address .= ", ". $self->address2 if $self->address2;
1467
1468   my($payname, $payfirst, $paylast);
1469   if ( $self->payname && $method ne 'ECHECK' ) {
1470     $payname = $self->payname;
1471     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1472       or return "Illegal payname $payname";
1473     ($payfirst, $paylast) = ($1, $2);
1474   } else {
1475     $payfirst = $self->getfield('first');
1476     $paylast = $self->getfield('last');
1477     $payname =  "$payfirst $paylast";
1478   }
1479
1480   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1481   if ( $conf->exists('emailinvoiceauto')
1482        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1483     push @invoicing_list, $self->all_emails;
1484   }
1485   my $email = $invoicing_list[0];
1486
1487   my %content;
1488   if ( $method eq 'CC' ) {
1489     $content{card_number} = $self->payinfo;
1490     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1491     $content{expiration} = "$2/$1";
1492   } elsif ( $method eq 'ECHECK' ) {
1493     my($account_number,$routing_code) = $self->payinfo;
1494     ( $content{account_number}, $content{routing_code} ) =
1495       split('@', $self->payinfo);
1496     $content{bank_name} = $self->payname;
1497   } elsif ( $method eq 'LEC' ) {
1498     $content{phone} = $self->payinfo;
1499   }
1500
1501   #transaction(s)
1502
1503   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1504
1505   my $transaction =
1506     new Business::OnlinePayment( $processor, @bop_options );
1507   $transaction->content(
1508     'type'           => $method,
1509     'login'          => $login,
1510     'password'       => $password,
1511     'action'         => $action1,
1512     'description'    => $options{'description'},
1513     'amount'         => $amount,
1514     'invoice_number' => $options{'invnum'},
1515     'customer_id'    => $self->custnum,
1516     'last_name'      => $paylast,
1517     'first_name'     => $payfirst,
1518     'name'           => $payname,
1519     'address'        => $address,
1520     'city'           => $self->city,
1521     'state'          => $self->state,
1522     'zip'            => $self->zip,
1523     'country'        => $self->country,
1524     'referer'        => 'http://cleanwhisker.420.am/',
1525     'email'          => $email,
1526     'phone'          => $self->daytime || $self->night,
1527     %content, #after
1528   );
1529   $transaction->submit();
1530
1531   if ( $transaction->is_success() && $action2 ) {
1532     my $auth = $transaction->authorization;
1533     my $ordernum = $transaction->can('order_number')
1534                    ? $transaction->order_number
1535                    : '';
1536
1537     my $capture =
1538       new Business::OnlinePayment( $processor, @bop_options );
1539
1540     my %capture = (
1541       %content,
1542       type           => $method,
1543       action         => $action2,
1544       login          => $login,
1545       password       => $password,
1546       order_number   => $ordernum,
1547       amount         => $amount,
1548       authorization  => $auth,
1549       description    => $options{'description'},
1550     );
1551
1552     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1553                            transaction_sequence_num local_transaction_date
1554                            local_transaction_time AVS_result_code          )) {
1555       $capture{$field} = $transaction->$field() if $transaction->can($field);
1556     }
1557
1558     $capture->content( %capture );
1559
1560     $capture->submit();
1561
1562     unless ( $capture->is_success ) {
1563       my $e = "Authorization sucessful but capture failed, custnum #".
1564               $self->custnum. ': '.  $capture->result_code.
1565               ": ". $capture->error_message;
1566       warn $e;
1567       return $e;
1568     }
1569
1570   }
1571
1572   #result handling
1573   if ( $transaction->is_success() ) {
1574
1575     my %method2payby = (
1576       'CC'     => 'CARD',
1577       'ECHECK' => 'CHEK',
1578       'LEC'    => 'LECB',
1579     );
1580
1581     my $cust_pay = new FS::cust_pay ( {
1582        'custnum'  => $self->custnum,
1583        'invnum'   => $options{'invnum'},
1584        'paid'     => $amount,
1585        '_date'     => '',
1586        'payby'    => $method2payby{$method},
1587        'payinfo'  => $self->payinfo,
1588        'paybatch' => "$processor:". $transaction->authorization,
1589     } );
1590     my $error = $cust_pay->insert;
1591     if ( $error ) {
1592       # gah, even with transactions.
1593       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1594               'error applying payment, invnum #' . $self->invnum.
1595               " ($processor): $error";
1596       warn $e;
1597       return $e;
1598     } else {
1599       return '';
1600     }
1601
1602   } else {
1603
1604     my $perror = "$processor error: ". $transaction->error_message;
1605
1606     if ( !$options{'quiet'} && $conf->exists('emaildecline')
1607          && grep { $_ ne 'POST' } $self->invoicing_list
1608     ) {
1609       my @templ = $conf->config('declinetemplate');
1610       my $template = new Text::Template (
1611         TYPE   => 'ARRAY',
1612         SOURCE => [ map "$_\n", @templ ],
1613       ) or return "($perror) can't create template: $Text::Template::ERROR";
1614       $template->compile()
1615         or return "($perror) can't compile template: $Text::Template::ERROR";
1616
1617       my $templ_hash = { error => $transaction->error_message };
1618
1619       my $error = send_email(
1620         'from'    => $conf->config('invoice_from'),
1621         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1622         'subject' => 'Your payment could not be processed',
1623         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1624       );
1625
1626       $perror .= " (also received error sending decline notification: $error)"
1627         if $error;
1628
1629     }
1630
1631     return $perror;
1632   }
1633
1634 }
1635
1636 =item total_owed
1637
1638 Returns the total owed for this customer on all invoices
1639 (see L<FS::cust_bill/owed>).
1640
1641 =cut
1642
1643 sub total_owed {
1644   my $self = shift;
1645   $self->total_owed_date(2145859200); #12/31/2037
1646 }
1647
1648 =item total_owed_date TIME
1649
1650 Returns the total owed for this customer on all invoices with date earlier than
1651 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1652 see L<Time::Local> and L<Date::Parse> for conversion functions.
1653
1654 =cut
1655
1656 sub total_owed_date {
1657   my $self = shift;
1658   my $time = shift;
1659   my $total_bill = 0;
1660   foreach my $cust_bill (
1661     grep { $_->_date <= $time }
1662       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1663   ) {
1664     $total_bill += $cust_bill->owed;
1665   }
1666   sprintf( "%.2f", $total_bill );
1667 }
1668
1669 =item apply_credits
1670
1671 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1672 to outstanding invoice balances in chronological order and returns the value
1673 of any remaining unapplied credits available for refund
1674 (see L<FS::cust_refund>).
1675
1676 =cut
1677
1678 sub apply_credits {
1679   my $self = shift;
1680
1681   return 0 unless $self->total_credited;
1682
1683   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1684       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1685
1686   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1687       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1688
1689   my $credit;
1690
1691   foreach my $cust_bill ( @invoices ) {
1692     my $amount;
1693
1694     if ( !defined($credit) || $credit->credited == 0) {
1695       $credit = pop @credits or last;
1696     }
1697
1698     if ($cust_bill->owed >= $credit->credited) {
1699       $amount=$credit->credited;
1700     }else{
1701       $amount=$cust_bill->owed;
1702     }
1703
1704     my $cust_credit_bill = new FS::cust_credit_bill ( {
1705       'crednum' => $credit->crednum,
1706       'invnum'  => $cust_bill->invnum,
1707       'amount'  => $amount,
1708     } );
1709     my $error = $cust_credit_bill->insert;
1710     die $error if $error;
1711
1712     redo if ($cust_bill->owed > 0);
1713
1714   }
1715
1716   return $self->total_credited;
1717 }
1718
1719 =item apply_payments
1720
1721 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1722 to outstanding invoice balances in chronological order.
1723
1724  #and returns the value of any remaining unapplied payments.
1725
1726 =cut
1727
1728 sub apply_payments {
1729   my $self = shift;
1730
1731   #return 0 unless
1732
1733   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1734       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1735
1736   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1737       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1738
1739   my $payment;
1740
1741   foreach my $cust_bill ( @invoices ) {
1742     my $amount;
1743
1744     if ( !defined($payment) || $payment->unapplied == 0 ) {
1745       $payment = pop @payments or last;
1746     }
1747
1748     if ( $cust_bill->owed >= $payment->unapplied ) {
1749       $amount = $payment->unapplied;
1750     } else {
1751       $amount = $cust_bill->owed;
1752     }
1753
1754     my $cust_bill_pay = new FS::cust_bill_pay ( {
1755       'paynum' => $payment->paynum,
1756       'invnum' => $cust_bill->invnum,
1757       'amount' => $amount,
1758     } );
1759     my $error = $cust_bill_pay->insert;
1760     die $error if $error;
1761
1762     redo if ( $cust_bill->owed > 0);
1763
1764   }
1765
1766   return $self->total_unapplied_payments;
1767 }
1768
1769 =item total_credited
1770
1771 Returns the total outstanding credit (see L<FS::cust_credit>) for this
1772 customer.  See L<FS::cust_credit/credited>.
1773
1774 =cut
1775
1776 sub total_credited {
1777   my $self = shift;
1778   my $total_credit = 0;
1779   foreach my $cust_credit ( qsearch('cust_credit', {
1780     'custnum' => $self->custnum,
1781   } ) ) {
1782     $total_credit += $cust_credit->credited;
1783   }
1784   sprintf( "%.2f", $total_credit );
1785 }
1786
1787 =item total_unapplied_payments
1788
1789 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
1790 See L<FS::cust_pay/unapplied>.
1791
1792 =cut
1793
1794 sub total_unapplied_payments {
1795   my $self = shift;
1796   my $total_unapplied = 0;
1797   foreach my $cust_pay ( qsearch('cust_pay', {
1798     'custnum' => $self->custnum,
1799   } ) ) {
1800     $total_unapplied += $cust_pay->unapplied;
1801   }
1802   sprintf( "%.2f", $total_unapplied );
1803 }
1804
1805 =item balance
1806
1807 Returns the balance for this customer (total_owed minus total_credited
1808 minus total_unapplied_payments).
1809
1810 =cut
1811
1812 sub balance {
1813   my $self = shift;
1814   sprintf( "%.2f",
1815     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
1816   );
1817 }
1818
1819 =item balance_date TIME
1820
1821 Returns the balance for this customer, only considering invoices with date
1822 earlier than TIME (total_owed_date minus total_credited minus
1823 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
1824 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
1825 functions.
1826
1827 =cut
1828
1829 sub balance_date {
1830   my $self = shift;
1831   my $time = shift;
1832   sprintf( "%.2f",
1833     $self->total_owed_date($time)
1834       - $self->total_credited
1835       - $self->total_unapplied_payments
1836   );
1837 }
1838
1839 =item invoicing_list [ ARRAYREF ]
1840
1841 If an arguement is given, sets these email addresses as invoice recipients
1842 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1843 (except as warnings), so use check_invoicing_list first.
1844
1845 Returns a list of email addresses (with svcnum entries expanded).
1846
1847 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1848 check it without disturbing anything by passing nothing.
1849
1850 This interface may change in the future.
1851
1852 =cut
1853
1854 sub invoicing_list {
1855   my( $self, $arrayref ) = @_;
1856   if ( $arrayref ) {
1857     my @cust_main_invoice;
1858     if ( $self->custnum ) {
1859       @cust_main_invoice =
1860         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1861     } else {
1862       @cust_main_invoice = ();
1863     }
1864     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1865       #warn $cust_main_invoice->destnum;
1866       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1867         #warn $cust_main_invoice->destnum;
1868         my $error = $cust_main_invoice->delete;
1869         warn $error if $error;
1870       }
1871     }
1872     if ( $self->custnum ) {
1873       @cust_main_invoice =
1874         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1875     } else {
1876       @cust_main_invoice = ();
1877     }
1878     my %seen = map { $_->address => 1 } @cust_main_invoice;
1879     foreach my $address ( @{$arrayref} ) {
1880       next if exists $seen{$address} && $seen{$address};
1881       $seen{$address} = 1;
1882       my $cust_main_invoice = new FS::cust_main_invoice ( {
1883         'custnum' => $self->custnum,
1884         'dest'    => $address,
1885       } );
1886       my $error = $cust_main_invoice->insert;
1887       warn $error if $error;
1888     }
1889   }
1890   if ( $self->custnum ) {
1891     map { $_->address }
1892       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1893   } else {
1894     ();
1895   }
1896 }
1897
1898 =item check_invoicing_list ARRAYREF
1899
1900 Checks these arguements as valid input for the invoicing_list method.  If there
1901 is an error, returns the error, otherwise returns false.
1902
1903 =cut
1904
1905 sub check_invoicing_list {
1906   my( $self, $arrayref ) = @_;
1907   foreach my $address ( @{$arrayref} ) {
1908     my $cust_main_invoice = new FS::cust_main_invoice ( {
1909       'custnum' => $self->custnum,
1910       'dest'    => $address,
1911     } );
1912     my $error = $self->custnum
1913                 ? $cust_main_invoice->check
1914                 : $cust_main_invoice->checkdest
1915     ;
1916     return $error if $error;
1917   }
1918   '';
1919 }
1920
1921 =item set_default_invoicing_list
1922
1923 Sets the invoicing list to all accounts associated with this customer,
1924 overwriting any previous invoicing list.
1925
1926 =cut
1927
1928 sub set_default_invoicing_list {
1929   my $self = shift;
1930   $self->invoicing_list($self->all_emails);
1931 }
1932
1933 =item all_emails
1934
1935 Returns the email addresses of all accounts provisioned for this customer.
1936
1937 =cut
1938
1939 sub all_emails {
1940   my $self = shift;
1941   my %list;
1942   foreach my $cust_pkg ( $self->all_pkgs ) {
1943     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
1944     my @svc_acct =
1945       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1946         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
1947           @cust_svc;
1948     $list{$_}=1 foreach map { $_->email } @svc_acct;
1949   }
1950   keys %list;
1951 }
1952
1953 =item invoicing_list_addpost
1954
1955 Adds postal invoicing to this customer.  If this customer is already configured
1956 to receive postal invoices, does nothing.
1957
1958 =cut
1959
1960 sub invoicing_list_addpost {
1961   my $self = shift;
1962   return if grep { $_ eq 'POST' } $self->invoicing_list;
1963   my @invoicing_list = $self->invoicing_list;
1964   push @invoicing_list, 'POST';
1965   $self->invoicing_list(\@invoicing_list);
1966 }
1967
1968 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
1969
1970 Returns an array of customers referred by this customer (referral_custnum set
1971 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
1972 customers referred by customers referred by this customer and so on, inclusive.
1973 The default behavior is DEPTH 1 (no recursion).
1974
1975 =cut
1976
1977 sub referral_cust_main {
1978   my $self = shift;
1979   my $depth = @_ ? shift : 1;
1980   my $exclude = @_ ? shift : {};
1981
1982   my @cust_main =
1983     map { $exclude->{$_->custnum}++; $_; }
1984       grep { ! $exclude->{ $_->custnum } }
1985         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
1986
1987   if ( $depth > 1 ) {
1988     push @cust_main,
1989       map { $_->referral_cust_main($depth-1, $exclude) }
1990         @cust_main;
1991   }
1992
1993   @cust_main;
1994 }
1995
1996 =item referral_cust_main_ncancelled
1997
1998 Same as referral_cust_main, except only returns customers with uncancelled
1999 packages.
2000
2001 =cut
2002
2003 sub referral_cust_main_ncancelled {
2004   my $self = shift;
2005   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2006 }
2007
2008 =item referral_cust_pkg [ DEPTH ]
2009
2010 Like referral_cust_main, except returns a flat list of all unsuspended (and
2011 uncancelled) packages for each customer.  The number of items in this list may
2012 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2013
2014 =cut
2015
2016 sub referral_cust_pkg {
2017   my $self = shift;
2018   my $depth = @_ ? shift : 1;
2019
2020   map { $_->unsuspended_pkgs }
2021     grep { $_->unsuspended_pkgs }
2022       $self->referral_cust_main($depth);
2023 }
2024
2025 =item credit AMOUNT, REASON
2026
2027 Applies a credit to this customer.  If there is an error, returns the error,
2028 otherwise returns false.
2029
2030 =cut
2031
2032 sub credit {
2033   my( $self, $amount, $reason ) = @_;
2034   my $cust_credit = new FS::cust_credit {
2035     'custnum' => $self->custnum,
2036     'amount'  => $amount,
2037     'reason'  => $reason,
2038   };
2039   $cust_credit->insert;
2040 }
2041
2042 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2043
2044 Creates a one-time charge for this customer.  If there is an error, returns
2045 the error, otherwise returns false.
2046
2047 =cut
2048
2049 sub charge {
2050   my ( $self, $amount ) = ( shift, shift );
2051   my $pkg      = @_ ? shift : 'One-time charge';
2052   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2053   my $taxclass = @_ ? shift : '';
2054
2055   local $SIG{HUP} = 'IGNORE';
2056   local $SIG{INT} = 'IGNORE';
2057   local $SIG{QUIT} = 'IGNORE';
2058   local $SIG{TERM} = 'IGNORE';
2059   local $SIG{TSTP} = 'IGNORE';
2060   local $SIG{PIPE} = 'IGNORE';
2061
2062   my $oldAutoCommit = $FS::UID::AutoCommit;
2063   local $FS::UID::AutoCommit = 0;
2064   my $dbh = dbh;
2065
2066   my $part_pkg = new FS::part_pkg ( {
2067     'pkg'      => $pkg,
2068     'comment'  => $comment,
2069     'setup'    => $amount,
2070     'freq'     => 0,
2071     'recur'    => '0',
2072     'disabled' => 'Y',
2073     'taxclass' => $taxclass,
2074   } );
2075
2076   my $error = $part_pkg->insert;
2077   if ( $error ) {
2078     $dbh->rollback if $oldAutoCommit;
2079     return $error;
2080   }
2081
2082   my $pkgpart = $part_pkg->pkgpart;
2083   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2084   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2085     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2086     $error = $type_pkgs->insert;
2087     if ( $error ) {
2088       $dbh->rollback if $oldAutoCommit;
2089       return $error;
2090     }
2091   }
2092
2093   my $cust_pkg = new FS::cust_pkg ( {
2094     'custnum' => $self->custnum,
2095     'pkgpart' => $pkgpart,
2096   } );
2097
2098   $error = $cust_pkg->insert;
2099   if ( $error ) {
2100     $dbh->rollback if $oldAutoCommit;
2101     return $error;
2102   }
2103
2104   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2105   '';
2106
2107 }
2108
2109 =item cust_bill
2110
2111 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2112
2113 =cut
2114
2115 sub cust_bill {
2116   my $self = shift;
2117   sort { $a->_date <=> $b->_date }
2118     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2119 }
2120
2121 =item open_cust_bill
2122
2123 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2124 customer.
2125
2126 =cut
2127
2128 sub open_cust_bill {
2129   my $self = shift;
2130   grep { $_->owed > 0 } $self->cust_bill;
2131 }
2132
2133 =back
2134
2135 =head1 SUBROUTINES
2136
2137 =over 4
2138
2139 =item check_and_rebuild_fuzzyfiles
2140
2141 =cut
2142
2143 sub check_and_rebuild_fuzzyfiles {
2144   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2145   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2146     or &rebuild_fuzzyfiles;
2147 }
2148
2149 =item rebuild_fuzzyfiles
2150
2151 =cut
2152
2153 sub rebuild_fuzzyfiles {
2154
2155   use Fcntl qw(:flock);
2156
2157   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2158
2159   #last
2160
2161   open(LASTLOCK,">>$dir/cust_main.last")
2162     or die "can't open $dir/cust_main.last: $!";
2163   flock(LASTLOCK,LOCK_EX)
2164     or die "can't lock $dir/cust_main.last: $!";
2165
2166   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2167   push @all_last,
2168                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2169     if defined dbdef->table('cust_main')->column('ship_last');
2170
2171   open (LASTCACHE,">$dir/cust_main.last.tmp")
2172     or die "can't open $dir/cust_main.last.tmp: $!";
2173   print LASTCACHE join("\n", @all_last), "\n";
2174   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2175
2176   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2177   close LASTLOCK;
2178
2179   #company
2180
2181   open(COMPANYLOCK,">>$dir/cust_main.company")
2182     or die "can't open $dir/cust_main.company: $!";
2183   flock(COMPANYLOCK,LOCK_EX)
2184     or die "can't lock $dir/cust_main.company: $!";
2185
2186   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2187   push @all_company,
2188        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2189     if defined dbdef->table('cust_main')->column('ship_last');
2190
2191   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2192     or die "can't open $dir/cust_main.company.tmp: $!";
2193   print COMPANYCACHE join("\n", @all_company), "\n";
2194   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2195
2196   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2197   close COMPANYLOCK;
2198
2199 }
2200
2201 =item all_last
2202
2203 =cut
2204
2205 sub all_last {
2206   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2207   open(LASTCACHE,"<$dir/cust_main.last")
2208     or die "can't open $dir/cust_main.last: $!";
2209   my @array = map { chomp; $_; } <LASTCACHE>;
2210   close LASTCACHE;
2211   \@array;
2212 }
2213
2214 =item all_company
2215
2216 =cut
2217
2218 sub all_company {
2219   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2220   open(COMPANYCACHE,"<$dir/cust_main.company")
2221     or die "can't open $dir/cust_main.last: $!";
2222   my @array = map { chomp; $_; } <COMPANYCACHE>;
2223   close COMPANYCACHE;
2224   \@array;
2225 }
2226
2227 =item append_fuzzyfiles LASTNAME COMPANY
2228
2229 =cut
2230
2231 sub append_fuzzyfiles {
2232   my( $last, $company ) = @_;
2233
2234   &check_and_rebuild_fuzzyfiles;
2235
2236   use Fcntl qw(:flock);
2237
2238   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2239
2240   if ( $last ) {
2241
2242     open(LAST,">>$dir/cust_main.last")
2243       or die "can't open $dir/cust_main.last: $!";
2244     flock(LAST,LOCK_EX)
2245       or die "can't lock $dir/cust_main.last: $!";
2246
2247     print LAST "$last\n";
2248
2249     flock(LAST,LOCK_UN)
2250       or die "can't unlock $dir/cust_main.last: $!";
2251     close LAST;
2252   }
2253
2254   if ( $company ) {
2255
2256     open(COMPANY,">>$dir/cust_main.company")
2257       or die "can't open $dir/cust_main.company: $!";
2258     flock(COMPANY,LOCK_EX)
2259       or die "can't lock $dir/cust_main.company: $!";
2260
2261     print COMPANY "$company\n";
2262
2263     flock(COMPANY,LOCK_UN)
2264       or die "can't unlock $dir/cust_main.company: $!";
2265
2266     close COMPANY;
2267   }
2268
2269   1;
2270 }
2271
2272 =item batch_import
2273
2274 =cut
2275
2276 sub batch_import {
2277   my $param = shift;
2278   #warn join('-',keys %$param);
2279   my $fh = $param->{filehandle};
2280   my $agentnum = $param->{agentnum};
2281   my $refnum = $param->{refnum};
2282   my $pkgpart = $param->{pkgpart};
2283   my @fields = @{$param->{fields}};
2284
2285   eval "use Date::Parse;";
2286   die $@ if $@;
2287   eval "use Text::CSV_XS;";
2288   die $@ if $@;
2289
2290   my $csv = new Text::CSV_XS;
2291   #warn $csv;
2292   #warn $fh;
2293
2294   my $imported = 0;
2295   #my $columns;
2296
2297   local $SIG{HUP} = 'IGNORE';
2298   local $SIG{INT} = 'IGNORE';
2299   local $SIG{QUIT} = 'IGNORE';
2300   local $SIG{TERM} = 'IGNORE';
2301   local $SIG{TSTP} = 'IGNORE';
2302   local $SIG{PIPE} = 'IGNORE';
2303
2304   my $oldAutoCommit = $FS::UID::AutoCommit;
2305   local $FS::UID::AutoCommit = 0;
2306   my $dbh = dbh;
2307
2308   #while ( $columns = $csv->getline($fh) ) {
2309   my $line;
2310   while ( defined($line=<$fh>) ) {
2311
2312     $csv->parse($line) or do {
2313       $dbh->rollback if $oldAutoCommit;
2314       return "can't parse: ". $csv->error_input();
2315     };
2316
2317     my @columns = $csv->fields();
2318     #warn join('-',@columns);
2319
2320     my %cust_main = (
2321       agentnum => $agentnum,
2322       refnum   => $refnum,
2323       country  => 'US', #default
2324       payby    => 'BILL', #default
2325       paydate  => '12/2037', #default
2326     );
2327     my $billtime = time;
2328     my %cust_pkg = ( pkgpart => $pkgpart );
2329     foreach my $field ( @fields ) {
2330       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2331         #$cust_pkg{$1} = str2time( shift @$columns );
2332         if ( $1 eq 'setup' ) {
2333           $billtime = str2time(shift @columns);
2334         } else {
2335           $cust_pkg{$1} = str2time( shift @columns );
2336         }
2337       } else {
2338         #$cust_main{$field} = shift @$columns;
2339         $cust_main{$field} = shift @columns;
2340       }
2341     }
2342
2343     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2344     my $cust_main = new FS::cust_main ( \%cust_main );
2345     use Tie::RefHash;
2346     tie my %hash, 'Tie::RefHash'; #this part is important
2347     $hash{$cust_pkg} = [] if $pkgpart;
2348     my $error = $cust_main->insert( \%hash );
2349
2350     if ( $error ) {
2351       $dbh->rollback if $oldAutoCommit;
2352       return "can't insert customer for $line: $error";
2353     }
2354
2355     #false laziness w/bill.cgi
2356     $error = $cust_main->bill( 'time' => $billtime );
2357     if ( $error ) {
2358       $dbh->rollback if $oldAutoCommit;
2359       return "can't bill customer for $line: $error";
2360     }
2361
2362     $cust_main->apply_payments;
2363     $cust_main->apply_credits;
2364
2365     $error = $cust_main->collect();
2366     if ( $error ) {
2367       $dbh->rollback if $oldAutoCommit;
2368       return "can't collect customer for $line: $error";
2369     }
2370
2371     $imported++;
2372   }
2373
2374   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2375
2376   return "Empty file!" unless $imported;
2377
2378   ''; #no error
2379
2380 }
2381
2382 =item batch_charge
2383
2384 =cut
2385
2386 sub batch_charge {
2387   my $param = shift;
2388   #warn join('-',keys %$param);
2389   my $fh = $param->{filehandle};
2390   my @fields = @{$param->{fields}};
2391
2392   eval "use Date::Parse;";
2393   die $@ if $@;
2394   eval "use Text::CSV_XS;";
2395   die $@ if $@;
2396
2397   my $csv = new Text::CSV_XS;
2398   #warn $csv;
2399   #warn $fh;
2400
2401   my $imported = 0;
2402   #my $columns;
2403
2404   local $SIG{HUP} = 'IGNORE';
2405   local $SIG{INT} = 'IGNORE';
2406   local $SIG{QUIT} = 'IGNORE';
2407   local $SIG{TERM} = 'IGNORE';
2408   local $SIG{TSTP} = 'IGNORE';
2409   local $SIG{PIPE} = 'IGNORE';
2410
2411   my $oldAutoCommit = $FS::UID::AutoCommit;
2412   local $FS::UID::AutoCommit = 0;
2413   my $dbh = dbh;
2414
2415   #while ( $columns = $csv->getline($fh) ) {
2416   my $line;
2417   while ( defined($line=<$fh>) ) {
2418
2419     $csv->parse($line) or do {
2420       $dbh->rollback if $oldAutoCommit;
2421       return "can't parse: ". $csv->error_input();
2422     };
2423
2424     my @columns = $csv->fields();
2425     #warn join('-',@columns);
2426
2427     my %row = ();
2428     foreach my $field ( @fields ) {
2429       $row{$field} = shift @columns;
2430     }
2431
2432     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2433     unless ( $cust_main ) {
2434       $dbh->rollback if $oldAutoCommit;
2435       return "unknown custnum $row{'custnum'}";
2436     }
2437
2438     if ( $row{'amount'} > 0 ) {
2439       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2440       if ( $error ) {
2441         $dbh->rollback if $oldAutoCommit;
2442         return $error;
2443       }
2444       $imported++;
2445     } elsif ( $row{'amount'} < 0 ) {
2446       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2447                                       $row{'pkg'}                         );
2448       if ( $error ) {
2449         $dbh->rollback if $oldAutoCommit;
2450         return $error;
2451       }
2452       $imported++;
2453     } else {
2454       #hmm?
2455     }
2456
2457   }
2458
2459   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2460
2461   return "Empty file!" unless $imported;
2462
2463   ''; #no error
2464
2465 }
2466
2467 =back
2468
2469 =head1 BUGS
2470
2471 The delete method.
2472
2473 The delete method should possibly take an FS::cust_main object reference
2474 instead of a scalar customer number.
2475
2476 Bill and collect options should probably be passed as references instead of a
2477 list.
2478
2479 There should probably be a configuration file with a list of allowed credit
2480 card types.
2481
2482 No multiple currency support (probably a larger project than just this module).
2483
2484 =head1 SEE ALSO
2485
2486 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2487 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2488 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2489
2490 =cut
2491
2492 1;
2493
2494