FS/FS/cust_main.pm

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