FS/FS/cust_main.pm

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