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        && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
1795   ) {
1796     my $new = new FS::cust_main { $self->hash };
1797     $new->paycvv('');
1798     my $error = $new->replace($self);
1799     if ( $error ) {
1800       warn "error removing cvv: $error\n";
1801     }
1802   }
1803
1804   #result handling
1805   if ( $transaction->is_success() ) {
1806
1807     my %method2payby = (
1808       'CC'     => 'CARD',
1809       'ECHECK' => 'CHEK',
1810       'LEC'    => 'LECB',
1811     );
1812
1813     my $cust_pay = new FS::cust_pay ( {
1814        'custnum'  => $self->custnum,
1815        'invnum'   => $options{'invnum'},
1816        'paid'     => $amount,
1817        '_date'     => '',
1818        'payby'    => $method2payby{$method},
1819        'payinfo'  => $self->payinfo,
1820        'paybatch' => "$processor:". $transaction->authorization,
1821     } );
1822     my $error = $cust_pay->insert;
1823     if ( $error ) {
1824       # gah, even with transactions.
1825       my $e = 'WARNING: Card/ACH debited but database not updated - '.
1826               'error applying payment, invnum #' . $self->invnum.
1827               " ($processor): $error";
1828       warn $e;
1829       return $e;
1830     } else {
1831       return '';
1832     }
1833
1834   } else {
1835
1836     my $perror = "$processor error: ". $transaction->error_message;
1837
1838     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1839          && $conf->exists('emaildecline')
1840          && grep { $_ ne 'POST' } $self->invoicing_list
1841          && ! grep { $_ eq $transaction->error_message }
1842                    $conf->config('emaildecline-exclude')
1843     ) {
1844       my @templ = $conf->config('declinetemplate');
1845       my $template = new Text::Template (
1846         TYPE   => 'ARRAY',
1847         SOURCE => [ map "$_\n", @templ ],
1848       ) or return "($perror) can't create template: $Text::Template::ERROR";
1849       $template->compile()
1850         or return "($perror) can't compile template: $Text::Template::ERROR";
1851
1852       my $templ_hash = { error => $transaction->error_message };
1853
1854       my $error = send_email(
1855         'from'    => $conf->config('invoice_from'),
1856         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1857         'subject' => 'Your payment could not be processed',
1858         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1859       );
1860
1861       $perror .= " (also received error sending decline notification: $error)"
1862         if $error;
1863
1864     }
1865
1866     return $perror;
1867   }
1868
1869 }
1870
1871 =item total_owed
1872
1873 Returns the total owed for this customer on all invoices
1874 (see L<FS::cust_bill/owed>).
1875
1876 =cut
1877
1878 sub total_owed {
1879   my $self = shift;
1880   $self->total_owed_date(2145859200); #12/31/2037
1881 }
1882
1883 =item total_owed_date TIME
1884
1885 Returns the total owed for this customer on all invoices with date earlier than
1886 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
1887 see L<Time::Local> and L<Date::Parse> for conversion functions.
1888
1889 =cut
1890
1891 sub total_owed_date {
1892   my $self = shift;
1893   my $time = shift;
1894   my $total_bill = 0;
1895   foreach my $cust_bill (
1896     grep { $_->_date <= $time }
1897       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
1898   ) {
1899     $total_bill += $cust_bill->owed;
1900   }
1901   sprintf( "%.2f", $total_bill );
1902 }
1903
1904 =item apply_credits
1905
1906 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1907 to outstanding invoice balances in chronological order and returns the value
1908 of any remaining unapplied credits available for refund
1909 (see L<FS::cust_refund>).
1910
1911 =cut
1912
1913 sub apply_credits {
1914   my $self = shift;
1915
1916   return 0 unless $self->total_credited;
1917
1918   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1919       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1920
1921   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1922       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1923
1924   my $credit;
1925
1926   foreach my $cust_bill ( @invoices ) {
1927     my $amount;
1928
1929     if ( !defined($credit) || $credit->credited == 0) {
1930       $credit = pop @credits or last;
1931     }
1932
1933     if ($cust_bill->owed >= $credit->credited) {
1934       $amount=$credit->credited;
1935     }else{
1936       $amount=$cust_bill->owed;
1937     }
1938
1939     my $cust_credit_bill = new FS::cust_credit_bill ( {
1940       'crednum' => $credit->crednum,
1941       'invnum'  => $cust_bill->invnum,
1942       'amount'  => $amount,
1943     } );
1944     my $error = $cust_credit_bill->insert;
1945     die $error if $error;
1946
1947     redo if ($cust_bill->owed > 0);
1948
1949   }
1950
1951   return $self->total_credited;
1952 }
1953
1954 =item apply_payments
1955
1956 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1957 to outstanding invoice balances in chronological order.
1958
1959  #and returns the value of any remaining unapplied payments.
1960
1961 =cut
1962
1963 sub apply_payments {
1964   my $self = shift;
1965
1966   #return 0 unless
1967
1968   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
1969       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
1970
1971   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
1972       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
1973
1974   my $payment;
1975
1976   foreach my $cust_bill ( @invoices ) {
1977     my $amount;
1978
1979     if ( !defined($payment) || $payment->unapplied == 0 ) {
1980       $payment = pop @payments or last;
1981     }
1982
1983     if ( $cust_bill->owed >= $payment->unapplied ) {
1984       $amount = $payment->unapplied;
1985     } else {
1986       $amount = $cust_bill->owed;
1987     }
1988
1989     my $cust_bill_pay = new FS::cust_bill_pay ( {
1990       'paynum' => $payment->paynum,
1991       'invnum' => $cust_bill->invnum,
1992       'amount' => $amount,
1993     } );
1994     my $error = $cust_bill_pay->insert;
1995     die $error if $error;
1996
1997     redo if ( $cust_bill->owed > 0);
1998
1999   }
2000
2001   return $self->total_unapplied_payments;
2002 }
2003
2004 =item total_credited
2005
2006 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2007 customer.  See L<FS::cust_credit/credited>.
2008
2009 =cut
2010
2011 sub total_credited {
2012   my $self = shift;
2013   my $total_credit = 0;
2014   foreach my $cust_credit ( qsearch('cust_credit', {
2015     'custnum' => $self->custnum,
2016   } ) ) {
2017     $total_credit += $cust_credit->credited;
2018   }
2019   sprintf( "%.2f", $total_credit );
2020 }
2021
2022 =item total_unapplied_payments
2023
2024 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2025 See L<FS::cust_pay/unapplied>.
2026
2027 =cut
2028
2029 sub total_unapplied_payments {
2030   my $self = shift;
2031   my $total_unapplied = 0;
2032   foreach my $cust_pay ( qsearch('cust_pay', {
2033     'custnum' => $self->custnum,
2034   } ) ) {
2035     $total_unapplied += $cust_pay->unapplied;
2036   }
2037   sprintf( "%.2f", $total_unapplied );
2038 }
2039
2040 =item balance
2041
2042 Returns the balance for this customer (total_owed minus total_credited
2043 minus total_unapplied_payments).
2044
2045 =cut
2046
2047 sub balance {
2048   my $self = shift;
2049   sprintf( "%.2f",
2050     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2051   );
2052 }
2053
2054 =item balance_date TIME
2055
2056 Returns the balance for this customer, only considering invoices with date
2057 earlier than TIME (total_owed_date minus total_credited minus
2058 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2059 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2060 functions.
2061
2062 =cut
2063
2064 sub balance_date {
2065   my $self = shift;
2066   my $time = shift;
2067   sprintf( "%.2f",
2068     $self->total_owed_date($time)
2069       - $self->total_credited
2070       - $self->total_unapplied_payments
2071   );
2072 }
2073
2074 =item invoicing_list [ ARRAYREF ]
2075
2076 If an arguement is given, sets these email addresses as invoice recipients
2077 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2078 (except as warnings), so use check_invoicing_list first.
2079
2080 Returns a list of email addresses (with svcnum entries expanded).
2081
2082 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2083 check it without disturbing anything by passing nothing.
2084
2085 This interface may change in the future.
2086
2087 =cut
2088
2089 sub invoicing_list {
2090   my( $self, $arrayref ) = @_;
2091   if ( $arrayref ) {
2092     my @cust_main_invoice;
2093     if ( $self->custnum ) {
2094       @cust_main_invoice =
2095         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2096     } else {
2097       @cust_main_invoice = ();
2098     }
2099     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2100       #warn $cust_main_invoice->destnum;
2101       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2102         #warn $cust_main_invoice->destnum;
2103         my $error = $cust_main_invoice->delete;
2104         warn $error if $error;
2105       }
2106     }
2107     if ( $self->custnum ) {
2108       @cust_main_invoice =
2109         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2110     } else {
2111       @cust_main_invoice = ();
2112     }
2113     my %seen = map { $_->address => 1 } @cust_main_invoice;
2114     foreach my $address ( @{$arrayref} ) {
2115       next if exists $seen{$address} && $seen{$address};
2116       $seen{$address} = 1;
2117       my $cust_main_invoice = new FS::cust_main_invoice ( {
2118         'custnum' => $self->custnum,
2119         'dest'    => $address,
2120       } );
2121       my $error = $cust_main_invoice->insert;
2122       warn $error if $error;
2123     }
2124   }
2125   if ( $self->custnum ) {
2126     map { $_->address }
2127       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2128   } else {
2129     ();
2130   }
2131 }
2132
2133 =item check_invoicing_list ARRAYREF
2134
2135 Checks these arguements as valid input for the invoicing_list method.  If there
2136 is an error, returns the error, otherwise returns false.
2137
2138 =cut
2139
2140 sub check_invoicing_list {
2141   my( $self, $arrayref ) = @_;
2142   foreach my $address ( @{$arrayref} ) {
2143     my $cust_main_invoice = new FS::cust_main_invoice ( {
2144       'custnum' => $self->custnum,
2145       'dest'    => $address,
2146     } );
2147     my $error = $self->custnum
2148                 ? $cust_main_invoice->check
2149                 : $cust_main_invoice->checkdest
2150     ;
2151     return $error if $error;
2152   }
2153   '';
2154 }
2155
2156 =item set_default_invoicing_list
2157
2158 Sets the invoicing list to all accounts associated with this customer,
2159 overwriting any previous invoicing list.
2160
2161 =cut
2162
2163 sub set_default_invoicing_list {
2164   my $self = shift;
2165   $self->invoicing_list($self->all_emails);
2166 }
2167
2168 =item all_emails
2169
2170 Returns the email addresses of all accounts provisioned for this customer.
2171
2172 =cut
2173
2174 sub all_emails {
2175   my $self = shift;
2176   my %list;
2177   foreach my $cust_pkg ( $self->all_pkgs ) {
2178     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2179     my @svc_acct =
2180       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2181         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2182           @cust_svc;
2183     $list{$_}=1 foreach map { $_->email } @svc_acct;
2184   }
2185   keys %list;
2186 }
2187
2188 =item invoicing_list_addpost
2189
2190 Adds postal invoicing to this customer.  If this customer is already configured
2191 to receive postal invoices, does nothing.
2192
2193 =cut
2194
2195 sub invoicing_list_addpost {
2196   my $self = shift;
2197   return if grep { $_ eq 'POST' } $self->invoicing_list;
2198   my @invoicing_list = $self->invoicing_list;
2199   push @invoicing_list, 'POST';
2200   $self->invoicing_list(\@invoicing_list);
2201 }
2202
2203 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2204
2205 Returns an array of customers referred by this customer (referral_custnum set
2206 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2207 customers referred by customers referred by this customer and so on, inclusive.
2208 The default behavior is DEPTH 1 (no recursion).
2209
2210 =cut
2211
2212 sub referral_cust_main {
2213   my $self = shift;
2214   my $depth = @_ ? shift : 1;
2215   my $exclude = @_ ? shift : {};
2216
2217   my @cust_main =
2218     map { $exclude->{$_->custnum}++; $_; }
2219       grep { ! $exclude->{ $_->custnum } }
2220         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2221
2222   if ( $depth > 1 ) {
2223     push @cust_main,
2224       map { $_->referral_cust_main($depth-1, $exclude) }
2225         @cust_main;
2226   }
2227
2228   @cust_main;
2229 }
2230
2231 =item referral_cust_main_ncancelled
2232
2233 Same as referral_cust_main, except only returns customers with uncancelled
2234 packages.
2235
2236 =cut
2237
2238 sub referral_cust_main_ncancelled {
2239   my $self = shift;
2240   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2241 }
2242
2243 =item referral_cust_pkg [ DEPTH ]
2244
2245 Like referral_cust_main, except returns a flat list of all unsuspended (and
2246 uncancelled) packages for each customer.  The number of items in this list may
2247 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2248
2249 =cut
2250
2251 sub referral_cust_pkg {
2252   my $self = shift;
2253   my $depth = @_ ? shift : 1;
2254
2255   map { $_->unsuspended_pkgs }
2256     grep { $_->unsuspended_pkgs }
2257       $self->referral_cust_main($depth);
2258 }
2259
2260 =item credit AMOUNT, REASON
2261
2262 Applies a credit to this customer.  If there is an error, returns the error,
2263 otherwise returns false.
2264
2265 =cut
2266
2267 sub credit {
2268   my( $self, $amount, $reason ) = @_;
2269   my $cust_credit = new FS::cust_credit {
2270     'custnum' => $self->custnum,
2271     'amount'  => $amount,
2272     'reason'  => $reason,
2273   };
2274   $cust_credit->insert;
2275 }
2276
2277 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2278
2279 Creates a one-time charge for this customer.  If there is an error, returns
2280 the error, otherwise returns false.
2281
2282 =cut
2283
2284 sub charge {
2285   my ( $self, $amount ) = ( shift, shift );
2286   my $pkg      = @_ ? shift : 'One-time charge';
2287   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2288   my $taxclass = @_ ? shift : '';
2289
2290   local $SIG{HUP} = 'IGNORE';
2291   local $SIG{INT} = 'IGNORE';
2292   local $SIG{QUIT} = 'IGNORE';
2293   local $SIG{TERM} = 'IGNORE';
2294   local $SIG{TSTP} = 'IGNORE';
2295   local $SIG{PIPE} = 'IGNORE';
2296
2297   my $oldAutoCommit = $FS::UID::AutoCommit;
2298   local $FS::UID::AutoCommit = 0;
2299   my $dbh = dbh;
2300
2301   my $part_pkg = new FS::part_pkg ( {
2302     'pkg'      => $pkg,
2303     'comment'  => $comment,
2304     'setup'    => $amount,
2305     'freq'     => 0,
2306     'recur'    => '0',
2307     'disabled' => 'Y',
2308     'taxclass' => $taxclass,
2309   } );
2310
2311   my $error = $part_pkg->insert;
2312   if ( $error ) {
2313     $dbh->rollback if $oldAutoCommit;
2314     return $error;
2315   }
2316
2317   my $pkgpart = $part_pkg->pkgpart;
2318   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2319   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2320     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2321     $error = $type_pkgs->insert;
2322     if ( $error ) {
2323       $dbh->rollback if $oldAutoCommit;
2324       return $error;
2325     }
2326   }
2327
2328   my $cust_pkg = new FS::cust_pkg ( {
2329     'custnum' => $self->custnum,
2330     'pkgpart' => $pkgpart,
2331   } );
2332
2333   $error = $cust_pkg->insert;
2334   if ( $error ) {
2335     $dbh->rollback if $oldAutoCommit;
2336     return $error;
2337   }
2338
2339   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2340   '';
2341
2342 }
2343
2344 =item cust_bill
2345
2346 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2347
2348 =cut
2349
2350 sub cust_bill {
2351   my $self = shift;
2352   sort { $a->_date <=> $b->_date }
2353     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2354 }
2355
2356 =item open_cust_bill
2357
2358 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2359 customer.
2360
2361 =cut
2362
2363 sub open_cust_bill {
2364   my $self = shift;
2365   grep { $_->owed > 0 } $self->cust_bill;
2366 }
2367
2368 =back
2369
2370 =head1 SUBROUTINES
2371
2372 =over 4
2373
2374 =item check_and_rebuild_fuzzyfiles
2375
2376 =cut
2377
2378 sub check_and_rebuild_fuzzyfiles {
2379   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2380   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
2381     or &rebuild_fuzzyfiles;
2382 }
2383
2384 =item rebuild_fuzzyfiles
2385
2386 =cut
2387
2388 sub rebuild_fuzzyfiles {
2389
2390   use Fcntl qw(:flock);
2391
2392   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2393
2394   #last
2395
2396   open(LASTLOCK,">>$dir/cust_main.last")
2397     or die "can't open $dir/cust_main.last: $!";
2398   flock(LASTLOCK,LOCK_EX)
2399     or die "can't lock $dir/cust_main.last: $!";
2400
2401   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
2402   push @all_last,
2403                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
2404     if defined dbdef->table('cust_main')->column('ship_last');
2405
2406   open (LASTCACHE,">$dir/cust_main.last.tmp")
2407     or die "can't open $dir/cust_main.last.tmp: $!";
2408   print LASTCACHE join("\n", @all_last), "\n";
2409   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
2410
2411   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
2412   close LASTLOCK;
2413
2414   #company
2415
2416   open(COMPANYLOCK,">>$dir/cust_main.company")
2417     or die "can't open $dir/cust_main.company: $!";
2418   flock(COMPANYLOCK,LOCK_EX)
2419     or die "can't lock $dir/cust_main.company: $!";
2420
2421   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
2422   push @all_company,
2423        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
2424     if defined dbdef->table('cust_main')->column('ship_last');
2425
2426   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
2427     or die "can't open $dir/cust_main.company.tmp: $!";
2428   print COMPANYCACHE join("\n", @all_company), "\n";
2429   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
2430
2431   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
2432   close COMPANYLOCK;
2433
2434 }
2435
2436 =item all_last
2437
2438 =cut
2439
2440 sub all_last {
2441   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2442   open(LASTCACHE,"<$dir/cust_main.last")
2443     or die "can't open $dir/cust_main.last: $!";
2444   my @array = map { chomp; $_; } <LASTCACHE>;
2445   close LASTCACHE;
2446   \@array;
2447 }
2448
2449 =item all_company
2450
2451 =cut
2452
2453 sub all_company {
2454   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2455   open(COMPANYCACHE,"<$dir/cust_main.company")
2456     or die "can't open $dir/cust_main.last: $!";
2457   my @array = map { chomp; $_; } <COMPANYCACHE>;
2458   close COMPANYCACHE;
2459   \@array;
2460 }
2461
2462 =item append_fuzzyfiles LASTNAME COMPANY
2463
2464 =cut
2465
2466 sub append_fuzzyfiles {
2467   my( $last, $company ) = @_;
2468
2469   &check_and_rebuild_fuzzyfiles;
2470
2471   use Fcntl qw(:flock);
2472
2473   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
2474
2475   if ( $last ) {
2476
2477     open(LAST,">>$dir/cust_main.last")
2478       or die "can't open $dir/cust_main.last: $!";
2479     flock(LAST,LOCK_EX)
2480       or die "can't lock $dir/cust_main.last: $!";
2481
2482     print LAST "$last\n";
2483
2484     flock(LAST,LOCK_UN)
2485       or die "can't unlock $dir/cust_main.last: $!";
2486     close LAST;
2487   }
2488
2489   if ( $company ) {
2490
2491     open(COMPANY,">>$dir/cust_main.company")
2492       or die "can't open $dir/cust_main.company: $!";
2493     flock(COMPANY,LOCK_EX)
2494       or die "can't lock $dir/cust_main.company: $!";
2495
2496     print COMPANY "$company\n";
2497
2498     flock(COMPANY,LOCK_UN)
2499       or die "can't unlock $dir/cust_main.company: $!";
2500
2501     close COMPANY;
2502   }
2503
2504   1;
2505 }
2506
2507 =item batch_import
2508
2509 =cut
2510
2511 sub batch_import {
2512   my $param = shift;
2513   #warn join('-',keys %$param);
2514   my $fh = $param->{filehandle};
2515   my $agentnum = $param->{agentnum};
2516   my $refnum = $param->{refnum};
2517   my $pkgpart = $param->{pkgpart};
2518   my @fields = @{$param->{fields}};
2519
2520   eval "use Date::Parse;";
2521   die $@ if $@;
2522   eval "use Text::CSV_XS;";
2523   die $@ if $@;
2524
2525   my $csv = new Text::CSV_XS;
2526   #warn $csv;
2527   #warn $fh;
2528
2529   my $imported = 0;
2530   #my $columns;
2531
2532   local $SIG{HUP} = 'IGNORE';
2533   local $SIG{INT} = 'IGNORE';
2534   local $SIG{QUIT} = 'IGNORE';
2535   local $SIG{TERM} = 'IGNORE';
2536   local $SIG{TSTP} = 'IGNORE';
2537   local $SIG{PIPE} = 'IGNORE';
2538
2539   my $oldAutoCommit = $FS::UID::AutoCommit;
2540   local $FS::UID::AutoCommit = 0;
2541   my $dbh = dbh;
2542
2543   #while ( $columns = $csv->getline($fh) ) {
2544   my $line;
2545   while ( defined($line=<$fh>) ) {
2546
2547     $csv->parse($line) or do {
2548       $dbh->rollback if $oldAutoCommit;
2549       return "can't parse: ". $csv->error_input();
2550     };
2551
2552     my @columns = $csv->fields();
2553     #warn join('-',@columns);
2554
2555     my %cust_main = (
2556       agentnum => $agentnum,
2557       refnum   => $refnum,
2558       country  => 'US', #default
2559       payby    => 'BILL', #default
2560       paydate  => '12/2037', #default
2561     );
2562     my $billtime = time;
2563     my %cust_pkg = ( pkgpart => $pkgpart );
2564     foreach my $field ( @fields ) {
2565       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
2566         #$cust_pkg{$1} = str2time( shift @$columns );
2567         if ( $1 eq 'setup' ) {
2568           $billtime = str2time(shift @columns);
2569         } else {
2570           $cust_pkg{$1} = str2time( shift @columns );
2571         }
2572       } else {
2573         #$cust_main{$field} = shift @$columns;
2574         $cust_main{$field} = shift @columns;
2575       }
2576     }
2577
2578     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
2579     my $cust_main = new FS::cust_main ( \%cust_main );
2580     use Tie::RefHash;
2581     tie my %hash, 'Tie::RefHash'; #this part is important
2582     $hash{$cust_pkg} = [] if $pkgpart;
2583     my $error = $cust_main->insert( \%hash );
2584
2585     if ( $error ) {
2586       $dbh->rollback if $oldAutoCommit;
2587       return "can't insert customer for $line: $error";
2588     }
2589
2590     #false laziness w/bill.cgi
2591     $error = $cust_main->bill( 'time' => $billtime );
2592     if ( $error ) {
2593       $dbh->rollback if $oldAutoCommit;
2594       return "can't bill customer for $line: $error";
2595     }
2596
2597     $cust_main->apply_payments;
2598     $cust_main->apply_credits;
2599
2600     $error = $cust_main->collect();
2601     if ( $error ) {
2602       $dbh->rollback if $oldAutoCommit;
2603       return "can't collect customer for $line: $error";
2604     }
2605
2606     $imported++;
2607   }
2608
2609   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2610
2611   return "Empty file!" unless $imported;
2612
2613   ''; #no error
2614
2615 }
2616
2617 =item batch_charge
2618
2619 =cut
2620
2621 sub batch_charge {
2622   my $param = shift;
2623   #warn join('-',keys %$param);
2624   my $fh = $param->{filehandle};
2625   my @fields = @{$param->{fields}};
2626
2627   eval "use Date::Parse;";
2628   die $@ if $@;
2629   eval "use Text::CSV_XS;";
2630   die $@ if $@;
2631
2632   my $csv = new Text::CSV_XS;
2633   #warn $csv;
2634   #warn $fh;
2635
2636   my $imported = 0;
2637   #my $columns;
2638
2639   local $SIG{HUP} = 'IGNORE';
2640   local $SIG{INT} = 'IGNORE';
2641   local $SIG{QUIT} = 'IGNORE';
2642   local $SIG{TERM} = 'IGNORE';
2643   local $SIG{TSTP} = 'IGNORE';
2644   local $SIG{PIPE} = 'IGNORE';
2645
2646   my $oldAutoCommit = $FS::UID::AutoCommit;
2647   local $FS::UID::AutoCommit = 0;
2648   my $dbh = dbh;
2649
2650   #while ( $columns = $csv->getline($fh) ) {
2651   my $line;
2652   while ( defined($line=<$fh>) ) {
2653
2654     $csv->parse($line) or do {
2655       $dbh->rollback if $oldAutoCommit;
2656       return "can't parse: ". $csv->error_input();
2657     };
2658
2659     my @columns = $csv->fields();
2660     #warn join('-',@columns);
2661
2662     my %row = ();
2663     foreach my $field ( @fields ) {
2664       $row{$field} = shift @columns;
2665     }
2666
2667     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
2668     unless ( $cust_main ) {
2669       $dbh->rollback if $oldAutoCommit;
2670       return "unknown custnum $row{'custnum'}";
2671     }
2672
2673     if ( $row{'amount'} > 0 ) {
2674       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
2675       if ( $error ) {
2676         $dbh->rollback if $oldAutoCommit;
2677         return $error;
2678       }
2679       $imported++;
2680     } elsif ( $row{'amount'} < 0 ) {
2681       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
2682                                       $row{'pkg'}                         );
2683       if ( $error ) {
2684         $dbh->rollback if $oldAutoCommit;
2685         return $error;
2686       }
2687       $imported++;
2688     } else {
2689       #hmm?
2690     }
2691
2692   }
2693
2694   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2695
2696   return "Empty file!" unless $imported;
2697
2698   ''; #no error
2699
2700 }
2701
2702 =back
2703
2704 =head1 BUGS
2705
2706 The delete method.
2707
2708 The delete method should possibly take an FS::cust_main object reference
2709 instead of a scalar customer number.
2710
2711 Bill and collect options should probably be passed as references instead of a
2712 list.
2713
2714 There should probably be a configuration file with a list of allowed credit
2715 card types.
2716
2717 No multiple currency support (probably a larger project than just this module).
2718
2719 =head1 SEE ALSO
2720
2721 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
2722 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
2723 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
2724
2725 =cut
2726
2727 1;
2728