FS/FS/cust_main.pm

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