FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import );
   5 use vars qw( $realtime_bop_decline_quiet ); #ugh
   6 use Safe;
   7 use Carp;
   8 use Exporter;
   9 BEGIN {
  10   eval "use Time::Local;";
  11   die "Time::Local minimum version 1.05 required with Perl versions before 5.6"
  12     if $] < 5.006 && !defined($Time::Local::VERSION);
  13   #eval "use Time::Local qw(timelocal timelocal_nocheck);";
  14   eval "use Time::Local qw(timelocal_nocheck);";
  15 }
  16 use Date::Format;
  17 #use Date::Manip;
  18 use String::Approx qw(amatch);
  19 use Business::CreditCard;
  20 use FS::UID qw( getotaker dbh );
  21 use FS::Record qw( qsearchs qsearch dbdef );
  22 use FS::Misc qw( send_email );
  23 use FS::cust_pkg;
  24 use FS::cust_bill;
  25 use FS::cust_bill_pkg;
  26 use FS::cust_pay;
  27 use FS::cust_pay_void;
  28 use FS::cust_credit;
  29 use FS::cust_refund;
  30 use FS::part_referral;
  31 use FS::cust_main_county;
  32 use FS::agent;
  33 use FS::cust_main_invoice;
  34 use FS::cust_credit_bill;
  35 use FS::cust_bill_pay;
  36 use FS::prepay_credit;
  37 use FS::queue;
  38 use FS::part_pkg;
  39 use FS::part_bill_event;
  40 use FS::cust_bill_event;
  41 use FS::cust_tax_exempt;
  42 use FS::type_pkgs;
  43 use FS::Msgcat qw(gettext);
  44
  45 @ISA = qw( FS::Record );
  46
  47 @EXPORT_OK = qw( smart_search );
  48
  49 $realtime_bop_decline_quiet = 0;
  50
  51 $DEBUG = 0;
  52 #$DEBUG = 1;
  53
  54 $import = 0;
  55
  56 #ask FS::UID to run this stuff for us later
  57 #$FS::UID::callback{'FS::cust_main'} = sub {
  58 install_callback FS::UID sub {
  59   $conf = new FS::Conf;
  60   #yes, need it for stuff below (prolly should be cached)
  61 };
  62
  63 sub _cache {
  64   my $self = shift;
  65   my ( $hashref, $cache ) = @_;
  66   if ( exists $hashref->{'pkgnum'} ) {
  67 #    #@{ $self->{'_pkgnum'} } = ();
  68     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  69     $self->{'_pkgnum'} = $subcache;
  70     #push @{ $self->{'_pkgnum'} },
  71     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
  72   }
  73 }
  74
  75 =head1 NAME
  76
  77 FS::cust_main - Object methods for cust_main records
  78
  79 =head1 SYNOPSIS
  80
  81   use FS::cust_main;
  82
  83   $record = new FS::cust_main \%hash;
  84   $record = new FS::cust_main { 'column' => 'value' };
  85
  86   $error = $record->insert;
  87
  88   $error = $new_record->replace($old_record);
  89
  90   $error = $record->delete;
  91
  92   $error = $record->check;
  93
  94   @cust_pkg = $record->all_pkgs;
  95
  96   @cust_pkg = $record->ncancelled_pkgs;
  97
  98   @cust_pkg = $record->suspended_pkgs;
  99
 100   $error = $record->bill;
 101   $error = $record->bill %options;
 102   $error = $record->bill 'time' => $time;
 103
 104   $error = $record->collect;
 105   $error = $record->collect %options;
 106   $error = $record->collect 'invoice_time'   => $time,
 107                             'batch_card'     => 'yes',
 108                             'report_badcard' => 'yes',
 109                           ;
 110
 111 =head1 DESCRIPTION
 112
 113 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 114 FS::Record.  The following fields are currently supported:
 115
 116 =over 4
 117
 118 =item custnum - primary key (assigned automatically for new customers)
 119
 120 =item agentnum - agent (see L<FS::agent>)
 121
 122 =item refnum - Advertising source (see L<FS::part_referral>)
 123
 124 =item first - name
 125
 126 =item last - name
 127
 128 =item ss - social security number (optional)
 129
 130 =item company - (optional)
 131
 132 =item address1
 133
 134 =item address2 - (optional)
 135
 136 =item city
 137
 138 =item county - (optional, see L<FS::cust_main_county>)
 139
 140 =item state - (see L<FS::cust_main_county>)
 141
 142 =item zip
 143
 144 =item country - (see L<FS::cust_main_county>)
 145
 146 =item daytime - phone (optional)
 147
 148 =item night - phone (optional)
 149
 150 =item fax - phone (optional)
 151
 152 =item ship_first - name
 153
 154 =item ship_last - name
 155
 156 =item ship_company - (optional)
 157
 158 =item ship_address1
 159
 160 =item ship_address2 - (optional)
 161
 162 =item ship_city
 163
 164 =item ship_county - (optional, see L<FS::cust_main_county>)
 165
 166 =item ship_state - (see L<FS::cust_main_county>)
 167
 168 =item ship_zip
 169
 170 =item ship_country - (see L<FS::cust_main_county>)
 171
 172 =item ship_daytime - phone (optional)
 173
 174 =item ship_night - phone (optional)
 175
 176 =item ship_fax - phone (optional)
 177
 178 =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>)
 179
 180 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 181
 182 =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
 183
 184 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 185
 186 =item payname - name on card or billing name
 187
 188 =item tax - tax exempt, empty or `Y'
 189
 190 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 191
 192 =item comments - comments (optional)
 193
 194 =item referral_custnum - referring customer number
 195
 196 =back
 197
 198 =head1 METHODS
 199
 200 =over 4
 201
 202 =item new HASHREF
 203
 204 Creates a new customer.  To add the customer to the database, see L<"insert">.
 205
 206 Note that this stores the hash reference, not a distinct copy of the hash it
 207 points to.  You can ask the object for a copy with the I<hash> method.
 208
 209 =cut
 210
 211 sub table { 'cust_main'; }
 212
 213 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 214
 215 Adds this customer to the database.  If there is an error, returns the error,
 216 otherwise returns false.
 217
 218 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 219 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 220 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 221 hash reference is equivalent to not supplying this parameter.  There should be
 222 a better explanation of this, but until then, here's an example:
 223
 224   use Tie::RefHash;
 225   tie %hash, 'Tie::RefHash'; #this part is important
 226   %hash = (
 227     $cust_pkg => [ $svc_acct ],
 228     ...
 229   );
 230   $cust_main->insert( \%hash );
 231
 232 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 233 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 234 expected and rollback the entire transaction; it is not necessary to call
 235 check_invoicing_list first.  The invoicing_list is set after the records in the
 236 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 237 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 238
 239   $cust_main->insert( {}, [ $email, 'POST' ] );
 240
 241 Currently available options are: I<depend_jobnum> and I<noexport>.
 242
 243 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 244 on the supplied jobnum (they will not run until the specific job completes).
 245 This can be used to defer provisioning until some action completes (such
 246 as running the customer's credit card sucessfully).
 247
 248 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 249 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 250 the B<reexport> method.)
 251
 252 =cut
 253
 254 sub insert {
 255   my $self = shift;
 256   my $cust_pkgs = @_ ? shift : {};
 257   my $invoicing_list = @_ ? shift : '';
 258   my %options = @_;
 259   warn "FS::cust_main::insert called with options ".
 260        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 261     if $DEBUG;
 262
 263   local $SIG{HUP} = 'IGNORE';
 264   local $SIG{INT} = 'IGNORE';
 265   local $SIG{QUIT} = 'IGNORE';
 266   local $SIG{TERM} = 'IGNORE';
 267   local $SIG{TSTP} = 'IGNORE';
 268   local $SIG{PIPE} = 'IGNORE';
 269
 270   my $oldAutoCommit = $FS::UID::AutoCommit;
 271   local $FS::UID::AutoCommit = 0;
 272   my $dbh = dbh;
 273
 274   my $amount = 0;
 275   my $seconds = 0;
 276   if ( $self->payby eq 'PREPAY' ) {
 277     $self->payby('BILL');
 278     my $prepay_credit = qsearchs(
 279       'prepay_credit',
 280       { 'identifier' => $self->payinfo },
 281       '',
 282       'FOR UPDATE'
 283     );
 284     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 285       unless $prepay_credit;
 286     $amount = $prepay_credit->amount;
 287     $seconds = $prepay_credit->seconds;
 288     my $error = $prepay_credit->delete;
 289     if ( $error ) {
 290       $dbh->rollback if $oldAutoCommit;
 291       return "removing prepay_credit (transaction rolled back): $error";
 292     }
 293   }
 294
 295   my $error = $self->SUPER::insert;
 296   if ( $error ) {
 297     $dbh->rollback if $oldAutoCommit;
 298     #return "inserting cust_main record (transaction rolled back): $error";
 299     return $error;
 300   }
 301
 302   # invoicing list
 303   if ( $invoicing_list ) {
 304     $error = $self->check_invoicing_list( $invoicing_list );
 305     if ( $error ) {
 306       $dbh->rollback if $oldAutoCommit;
 307       return "checking invoicing_list (transaction rolled back): $error";
 308     }
 309     $self->invoicing_list( $invoicing_list );
 310   }
 311
 312   # packages
 313   $error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
 314   if ( $error ) {
 315     $dbh->rollback if $oldAutoCommit;
 316     return $error;
 317   }
 318
 319   if ( $seconds ) {
 320     $dbh->rollback if $oldAutoCommit;
 321     return "No svc_acct record to apply pre-paid time";
 322   }
 323
 324   if ( $amount ) {
 325     my $cust_credit = new FS::cust_credit {
 326       'custnum' => $self->custnum,
 327       'amount'  => $amount,
 328     };
 329     $error = $cust_credit->insert;
 330     if ( $error ) {
 331       $dbh->rollback if $oldAutoCommit;
 332       return "inserting credit (transaction rolled back): $error";
 333     }
 334   }
 335
 336   $error = $self->queue_fuzzyfiles_update;
 337   if ( $error ) {
 338     $dbh->rollback if $oldAutoCommit;
 339     return "updating fuzzy search cache: $error";
 340   }
 341
 342   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 343   '';
 344
 345 }
 346
 347 =item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
 348
 349 Like the insert method on an existing record, this method orders a package
 350 and included services atomicaly.  Pass a Tie::RefHash data structure to this
 351 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  There should
 352 be a better explanation of this, but until then, here's an example:
 353
 354   use Tie::RefHash;
 355   tie %hash, 'Tie::RefHash'; #this part is important
 356   %hash = (
 357     $cust_pkg => [ $svc_acct ],
 358     ...
 359   );
 360   $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
 361
 362 Currently available options are: I<depend_jobnum> and I<noexport>.
 363
 364 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 365 on the supplied jobnum (they will not run until the specific job completes).
 366 This can be used to defer provisioning until some action completes (such
 367 as running the customer's credit card sucessfully).
 368
 369 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 370 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 371 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 372 on the cust_main object is not recommended, as existing services will also be
 373 reexported.)
 374
 375 =cut
 376
 377 sub order_pkgs {
 378   my $self = shift;
 379   my $cust_pkgs = shift;
 380   my $seconds = shift;
 381   my %options = @_;
 382   my %svc_options = ();
 383   $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
 384     if exists $options{'depend_jobnum'};
 385   warn "FS::cust_main::order_pkgs called with options ".
 386        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 387     if $DEBUG;
 388
 389   local $SIG{HUP} = 'IGNORE';
 390   local $SIG{INT} = 'IGNORE';
 391   local $SIG{QUIT} = 'IGNORE';
 392   local $SIG{TERM} = 'IGNORE';
 393   local $SIG{TSTP} = 'IGNORE';
 394   local $SIG{PIPE} = 'IGNORE';
 395
 396   my $oldAutoCommit = $FS::UID::AutoCommit;
 397   local $FS::UID::AutoCommit = 0;
 398   my $dbh = dbh;
 399
 400   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 401
 402   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 403     $cust_pkg->custnum( $self->custnum );
 404     my $error = $cust_pkg->insert;
 405     if ( $error ) {
 406       $dbh->rollback if $oldAutoCommit;
 407       return "inserting cust_pkg (transaction rolled back): $error";
 408     }
 409     foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 410       $svc_something->pkgnum( $cust_pkg->pkgnum );
 411       if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
 412         $svc_something->seconds( $svc_something->seconds + $$seconds );
 413         $$seconds = 0;
 414       }
 415       $error = $svc_something->insert(%svc_options);
 416       if ( $error ) {
 417         $dbh->rollback if $oldAutoCommit;
 418         #return "inserting svc_ (transaction rolled back): $error";
 419         return $error;
 420       }
 421     }
 422   }
 423
 424   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 425   ''; #no error
 426 }
 427
 428 =item reexport
 429
 430 This method is deprecated.  See the I<depend_jobnum> option to the insert and
 431 order_pkgs methods for a better way to defer provisioning.
 432
 433 Re-schedules all exports by calling the B<reexport> method of all associated
 434 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
 435 otherwise returns false.
 436
 437 =cut
 438
 439 sub reexport {
 440   my $self = shift;
 441
 442   carp "warning: FS::cust_main::reexport is deprectated; ".
 443        "use the depend_jobnum option to insert or order_pkgs to delay export";
 444
 445   local $SIG{HUP} = 'IGNORE';
 446   local $SIG{INT} = 'IGNORE';
 447   local $SIG{QUIT} = 'IGNORE';
 448   local $SIG{TERM} = 'IGNORE';
 449   local $SIG{TSTP} = 'IGNORE';
 450   local $SIG{PIPE} = 'IGNORE';
 451
 452   my $oldAutoCommit = $FS::UID::AutoCommit;
 453   local $FS::UID::AutoCommit = 0;
 454   my $dbh = dbh;
 455
 456   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
 457     my $error = $cust_pkg->reexport;
 458     if ( $error ) {
 459       $dbh->rollback if $oldAutoCommit;
 460       return $error;
 461     }
 462   }
 463
 464   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 465   '';
 466
 467 }
 468
 469 =item delete NEW_CUSTNUM
 470
 471 This deletes the customer.  If there is an error, returns the error, otherwise
 472 returns false.
 473
 474 This will completely remove all traces of the customer record.  This is not
 475 what you want when a customer cancels service; for that, cancel all of the
 476 customer's packages (see L</cancel>).
 477
 478 If the customer has any uncancelled packages, you need to pass a new (valid)
 479 customer number for those packages to be transferred to.  Cancelled packages
 480 will be deleted.  Did I mention that this is NOT what you want when a customer
 481 cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
 482
 483 You can't delete a customer with invoices (see L<FS::cust_bill>),
 484 or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
 485 refunds (see L<FS::cust_refund>).
 486
 487 =cut
 488
 489 sub delete {
 490   my $self = shift;
 491
 492   local $SIG{HUP} = 'IGNORE';
 493   local $SIG{INT} = 'IGNORE';
 494   local $SIG{QUIT} = 'IGNORE';
 495   local $SIG{TERM} = 'IGNORE';
 496   local $SIG{TSTP} = 'IGNORE';
 497   local $SIG{PIPE} = 'IGNORE';
 498
 499   my $oldAutoCommit = $FS::UID::AutoCommit;
 500   local $FS::UID::AutoCommit = 0;
 501   my $dbh = dbh;
 502
 503   if ( $self->cust_bill ) {
 504     $dbh->rollback if $oldAutoCommit;
 505     return "Can't delete a customer with invoices";
 506   }
 507   if ( $self->cust_credit ) {
 508     $dbh->rollback if $oldAutoCommit;
 509     return "Can't delete a customer with credits";
 510   }
 511   if ( $self->cust_pay ) {
 512     $dbh->rollback if $oldAutoCommit;
 513     return "Can't delete a customer with payments";
 514   }
 515   if ( $self->cust_refund ) {
 516     $dbh->rollback if $oldAutoCommit;
 517     return "Can't delete a customer with refunds";
 518   }
 519
 520   my @cust_pkg = $self->ncancelled_pkgs;
 521   if ( @cust_pkg ) {
 522     my $new_custnum = shift;
 523     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 524       $dbh->rollback if $oldAutoCommit;
 525       return "Invalid new customer number: $new_custnum";
 526     }
 527     foreach my $cust_pkg ( @cust_pkg ) {
 528       my %hash = $cust_pkg->hash;
 529       $hash{'custnum'} = $new_custnum;
 530       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 531       my $error = $new_cust_pkg->replace($cust_pkg);
 532       if ( $error ) {
 533         $dbh->rollback if $oldAutoCommit;
 534         return $error;
 535       }
 536     }
 537   }
 538   my @cancelled_cust_pkg = $self->all_pkgs;
 539   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
 540     my $error = $cust_pkg->delete;
 541     if ( $error ) {
 542       $dbh->rollback if $oldAutoCommit;
 543       return $error;
 544     }
 545   }
 546
 547   foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
 548     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 549   ) {
 550     my $error = $cust_main_invoice->delete;
 551     if ( $error ) {
 552       $dbh->rollback if $oldAutoCommit;
 553       return $error;
 554     }
 555   }
 556
 557   my $error = $self->SUPER::delete;
 558   if ( $error ) {
 559     $dbh->rollback if $oldAutoCommit;
 560     return $error;
 561   }
 562
 563   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 564   '';
 565
 566 }
 567
 568 =item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
 569
 570 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 571 returns the error, otherwise returns false.
 572
 573 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 574 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 575 expected and rollback the entire transaction; it is not necessary to call
 576 check_invoicing_list first.  Here's an example:
 577
 578   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
 579
 580 =cut
 581
 582 sub replace {
 583   my $self = shift;
 584   my $old = shift;
 585   my @param = @_;
 586
 587   local $SIG{HUP} = 'IGNORE';
 588   local $SIG{INT} = 'IGNORE';
 589   local $SIG{QUIT} = 'IGNORE';
 590   local $SIG{TERM} = 'IGNORE';
 591   local $SIG{TSTP} = 'IGNORE';
 592   local $SIG{PIPE} = 'IGNORE';
 593
 594   if ( $self->payby eq 'COMP' && $self->payby ne $old->payby
 595        && $conf->config('users-allow_comp')                  ) {
 596     return "You are not permitted to create complimentary accounts."
 597       unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 598   }
 599
 600   my $oldAutoCommit = $FS::UID::AutoCommit;
 601   local $FS::UID::AutoCommit = 0;
 602   my $dbh = dbh;
 603
 604   my $error = $self->SUPER::replace($old);
 605
 606   if ( $error ) {
 607     $dbh->rollback if $oldAutoCommit;
 608     return $error;
 609   }
 610
 611   if ( @param ) { # INVOICING_LIST_ARYREF
 612     my $invoicing_list = shift @param;
 613     $error = $self->check_invoicing_list( $invoicing_list );
 614     if ( $error ) {
 615       $dbh->rollback if $oldAutoCommit;
 616       return $error;
 617     }
 618     $self->invoicing_list( $invoicing_list );
 619   }
 620
 621   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
 622        grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
 623     # card/check/lec info has changed, want to retry realtime_ invoice events
 624     my $error = $self->retry_realtime;
 625     if ( $error ) {
 626       $dbh->rollback if $oldAutoCommit;
 627       return $error;
 628     }
 629   }
 630
 631   $error = $self->queue_fuzzyfiles_update;
 632   if ( $error ) {
 633     $dbh->rollback if $oldAutoCommit;
 634     return "updating fuzzy search cache: $error";
 635   }
 636
 637   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 638   '';
 639
 640 }
 641
 642 =item queue_fuzzyfiles_update
 643
 644 Used by insert & replace to update the fuzzy search cache
 645
 646 =cut
 647
 648 sub queue_fuzzyfiles_update {
 649   my $self = shift;
 650
 651   local $SIG{HUP} = 'IGNORE';
 652   local $SIG{INT} = 'IGNORE';
 653   local $SIG{QUIT} = 'IGNORE';
 654   local $SIG{TERM} = 'IGNORE';
 655   local $SIG{TSTP} = 'IGNORE';
 656   local $SIG{PIPE} = 'IGNORE';
 657
 658   my $oldAutoCommit = $FS::UID::AutoCommit;
 659   local $FS::UID::AutoCommit = 0;
 660   my $dbh = dbh;
 661
 662   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 663   my $error = $queue->insert($self->getfield('last'), $self->company);
 664   if ( $error ) {
 665     $dbh->rollback if $oldAutoCommit;
 666     return "queueing job (transaction rolled back): $error";
 667   }
 668
 669   if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
 670     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
 671     $error = $queue->insert($self->getfield('ship_last'), $self->ship_company);
 672     if ( $error ) {
 673       $dbh->rollback if $oldAutoCommit;
 674       return "queueing job (transaction rolled back): $error";
 675     }
 676   }
 677
 678   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 679   '';
 680
 681 }
 682
 683 =item check
 684
 685 Checks all fields to make sure this is a valid customer record.  If there is
 686 an error, returns the error, otherwise returns false.  Called by the insert
 687 and repalce methods.
 688
 689 =cut
 690
 691 sub check {
 692   my $self = shift;
 693
 694   #warn "BEFORE: \n". $self->_dump;
 695
 696   my $error =
 697     $self->ut_numbern('custnum')
 698     || $self->ut_number('agentnum')
 699     || $self->ut_number('refnum')
 700     || $self->ut_name('last')
 701     || $self->ut_name('first')
 702     || $self->ut_textn('company')
 703     || $self->ut_text('address1')
 704     || $self->ut_textn('address2')
 705     || $self->ut_text('city')
 706     || $self->ut_textn('county')
 707     || $self->ut_textn('state')
 708     || $self->ut_country('country')
 709     || $self->ut_anything('comments')
 710     || $self->ut_numbern('referral_custnum')
 711   ;
 712   #barf.  need message catalogs.  i18n.  etc.
 713   $error .= "Please select an advertising source."
 714     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 715   return $error if $error;
 716
 717   return "Unknown agent"
 718     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 719
 720   return "Unknown refnum"
 721     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 722
 723   return "Unknown referring custnum ". $self->referral_custnum
 724     unless ! $self->referral_custnum
 725            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
 726
 727   if ( $self->ss eq '' ) {
 728     $self->ss('');
 729   } else {
 730     my $ss = $self->ss;
 731     $ss =~ s/\D//g;
 732     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 733       or return "Illegal social security number: ". $self->ss;
 734     $self->ss("$1-$2-$3");
 735   }
 736
 737
 738 # bad idea to disable, causes billing to fail because of no tax rates later
 739 #  unless ( $import ) {
 740     unless ( qsearch('cust_main_county', {
 741       'country' => $self->country,
 742       'state'   => '',
 743      } ) ) {
 744       return "Unknown state/county/country: ".
 745         $self->state. "/". $self->county. "/". $self->country
 746         unless qsearch('cust_main_county',{
 747           'state'   => $self->state,
 748           'county'  => $self->county,
 749           'country' => $self->country,
 750         } );
 751     }
 752 #  }
 753
 754   $error =
 755     $self->ut_phonen('daytime', $self->country)
 756     || $self->ut_phonen('night', $self->country)
 757     || $self->ut_phonen('fax', $self->country)
 758     || $self->ut_zip('zip', $self->country)
 759   ;
 760   return $error if $error;
 761
 762   my @addfields = qw(
 763     last first company address1 address2 city county state zip
 764     country daytime night fax
 765   );
 766
 767   if ( defined $self->dbdef_table->column('ship_last') ) {
 768     if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 769                        @addfields )
 770          && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
 771        )
 772     {
 773       my $error =
 774         $self->ut_name('ship_last')
 775         || $self->ut_name('ship_first')
 776         || $self->ut_textn('ship_company')
 777         || $self->ut_text('ship_address1')
 778         || $self->ut_textn('ship_address2')
 779         || $self->ut_text('ship_city')
 780         || $self->ut_textn('ship_county')
 781         || $self->ut_textn('ship_state')
 782         || $self->ut_country('ship_country')
 783       ;
 784       return $error if $error;
 785
 786       #false laziness with above
 787       unless ( qsearchs('cust_main_county', {
 788         'country' => $self->ship_country,
 789         'state'   => '',
 790        } ) ) {
 791         return "Unknown ship_state/ship_county/ship_country: ".
 792           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 793           unless qsearchs('cust_main_county',{
 794             'state'   => $self->ship_state,
 795             'county'  => $self->ship_county,
 796             'country' => $self->ship_country,
 797           } );
 798       }
 799       #eofalse
 800
 801       $error =
 802         $self->ut_phonen('ship_daytime', $self->ship_country)
 803         || $self->ut_phonen('ship_night', $self->ship_country)
 804         || $self->ut_phonen('ship_fax', $self->ship_country)
 805         || $self->ut_zip('ship_zip', $self->ship_country)
 806       ;
 807       return $error if $error;
 808
 809     } else { # ship_ info eq billing info, so don't store dup info in database
 810       $self->setfield("ship_$_", '')
 811         foreach qw( last first company address1 address2 city county state zip
 812                     country daytime night fax );
 813     }
 814   }
 815
 816   $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
 817     or return "Illegal payby: ". $self->payby;
 818   $self->payby($1);
 819
 820   if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
 821
 822     my $payinfo = $self->payinfo;
 823     $payinfo =~ s/\D//g;
 824     $payinfo =~ /^(\d{13,16})$/
 825       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 826     $payinfo = $1;
 827     $self->payinfo($payinfo);
 828     validate($payinfo)
 829       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 830     return gettext('unknown_card_type')
 831       if cardtype($self->payinfo) eq "Unknown";
 832     if ( defined $self->dbdef_table->column('paycvv') ) {
 833       if ( length($self->paycvv) ) {
 834         if ( cardtype($self->payinfo) eq 'American Express card' ) {
 835           $self->paycvv =~ /^(\d{4})$/
 836             or return "CVV2 (CID) for American Express cards is four digits.";
 837           $self->paycvv($1);
 838         } else {
 839           $self->paycvv =~ /^(\d{3})$/
 840             or return "CVV2 (CVC2/CID) is three digits.";
 841           $self->paycvv($1);
 842         }
 843       } else {
 844         $self->paycvv('');
 845       }
 846     }
 847
 848   } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
 849
 850     my $payinfo = $self->payinfo;
 851     $payinfo =~ s/[^\d\@]//g;
 852     $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
 853     $payinfo = "$1\@$2";
 854     $self->payinfo($payinfo);
 855     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 856
 857   } elsif ( $self->payby eq 'LECB' ) {
 858
 859     my $payinfo = $self->payinfo;
 860     $payinfo =~ s/\D//g;
 861     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
 862     $payinfo = $1;
 863     $self->payinfo($payinfo);
 864     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 865
 866   } elsif ( $self->payby eq 'BILL' ) {
 867
 868     $error = $self->ut_textn('payinfo');
 869     return "Illegal P.O. number: ". $self->payinfo if $error;
 870     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 871
 872   } elsif ( $self->payby eq 'COMP' ) {
 873
 874     if ( !$self->custnum && $conf->config('users-allow_comp') ) {
 875       return "You are not permitted to create complimentary accounts."
 876         unless grep { $_ eq getotaker } $conf->config('users-allow_comp');
 877     }
 878
 879     $error = $self->ut_textn('payinfo');
 880     return "Illegal comp account issuer: ". $self->payinfo if $error;
 881     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 882
 883   } elsif ( $self->payby eq 'PREPAY' ) {
 884
 885     my $payinfo = $self->payinfo;
 886     $payinfo =~ s/\W//g; #anything else would just confuse things
 887     $self->payinfo($payinfo);
 888     $error = $self->ut_alpha('payinfo');
 889     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 890     return "Unknown prepayment identifier"
 891       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 892     $self->paycvv('') if $self->dbdef_table->column('paycvv');
 893
 894   }
 895
 896   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 897     return "Expriation date required"
 898       unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
 899     $self->paydate('');
 900   } else {
 901     my( $m, $y );
 902     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 903       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 904     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 905       ( $m, $y ) = ( $3, "20$2" );
 906     } else {
 907       return "Illegal expiration date: ". $self->paydate;
 908     }
 909     $self->paydate("$y-$m-01");
 910     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
 911     return gettext('expired_card')
 912       if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
 913   }
 914
 915   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
 916        ( ! $conf->exists('require_cardname')
 917          || $self->payby !~ /^(CARD|DCRD)$/  )
 918   ) {
 919     $self->payname( $self->first. " ". $self->getfield('last') );
 920   } else {
 921     $self->payname =~ /^([\w \,\.\-\']+)$/
 922       or return gettext('illegal_name'). " payname: ". $self->payname;
 923     $self->payname($1);
 924   }
 925
 926   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 927   $self->tax($1);
 928
 929   $self->otaker(getotaker) unless $self->otaker;
 930
 931   #warn "AFTER: \n". $self->_dump;
 932
 933   $self->SUPER::check;
 934 }
 935
 936 =item all_pkgs
 937
 938 Returns all packages (see L<FS::cust_pkg>) for this customer.
 939
 940 =cut
 941
 942 sub all_pkgs {
 943   my $self = shift;
 944   if ( $self->{'_pkgnum'} ) {
 945     values %{ $self->{'_pkgnum'}->cache };
 946   } else {
 947     qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 948   }
 949 }
 950
 951 =item ncancelled_pkgs
 952
 953 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 954
 955 =cut
 956
 957 sub ncancelled_pkgs {
 958   my $self = shift;
 959   if ( $self->{'_pkgnum'} ) {
 960     grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
 961   } else {
 962     @{ [ # force list context
 963       qsearch( 'cust_pkg', {
 964         'custnum' => $self->custnum,
 965         'cancel'  => '',
 966       }),
 967       qsearch( 'cust_pkg', {
 968         'custnum' => $self->custnum,
 969         'cancel'  => 0,
 970       }),
 971     ] };
 972   }
 973 }
 974
 975 =item suspended_pkgs
 976
 977 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
 978
 979 =cut
 980
 981 sub suspended_pkgs {
 982   my $self = shift;
 983   grep { $_->susp } $self->ncancelled_pkgs;
 984 }
 985
 986 =item unflagged_suspended_pkgs
 987
 988 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
 989 customer (thouse packages without the `manual_flag' set).
 990
 991 =cut
 992
 993 sub unflagged_suspended_pkgs {
 994   my $self = shift;
 995   return $self->suspended_pkgs
 996     unless dbdef->table('cust_pkg')->column('manual_flag');
 997   grep { ! $_->manual_flag } $self->suspended_pkgs;
 998 }
 999
1000 =item unsuspended_pkgs
1001
1002 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
1003 this customer.
1004
1005 =cut
1006
1007 sub unsuspended_pkgs {
1008   my $self = shift;
1009   grep { ! $_->susp } $self->ncancelled_pkgs;
1010 }
1011
1012 =item num_cancelled_pkgs
1013
1014 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
1015 customer.
1016
1017 =cut
1018
1019 sub num_cancelled_pkgs {
1020   my $self = shift;
1021   $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
1022 }
1023
1024 sub num_pkgs {
1025   my( $self, $sql ) = @_;
1026   my $sth = dbh->prepare(
1027     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql"
1028   ) or die dbh->errstr;
1029   $sth->execute($self->custnum) or die $sth->errstr;
1030   $sth->fetchrow_arrayref->[0];
1031 }
1032
1033 =item unsuspend
1034
1035 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1036 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1037 on success or a list of errors.
1038
1039 =cut
1040
1041 sub unsuspend {
1042   my $self = shift;
1043   grep { $_->unsuspend } $self->suspended_pkgs;
1044 }
1045
1046 =item suspend
1047
1048 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1049 Always returns a list: an empty list on success or a list of errors.
1050
1051 =cut
1052
1053 sub suspend {
1054   my $self = shift;
1055   grep { $_->suspend } $self->unsuspended_pkgs;
1056 }
1057
1058 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1059
1060 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1061 PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list on
1062 success or a list of errors.
1063
1064 =cut
1065
1066 sub suspend_if_pkgpart {
1067   my $self = shift;
1068   my @pkgparts = @_;
1069   grep { $_->suspend }
1070     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1071       $self->unsuspended_pkgs;
1072 }
1073
1074 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1075
1076 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1077 listed PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list
1078 on success or a list of errors.
1079
1080 =cut
1081
1082 sub suspend_unless_pkgpart {
1083   my $self = shift;
1084   my @pkgparts = @_;
1085   grep { $_->suspend }
1086     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1087       $self->unsuspended_pkgs;
1088 }
1089
1090 =item cancel [ OPTION => VALUE ... ]
1091
1092 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1093
1094 Available options are: I<quiet>
1095
1096 I<quiet> can be set true to supress email cancellation notices.
1097
1098 Always returns a list: an empty list on success or a list of errors.
1099
1100 =cut
1101
1102 sub cancel {
1103   my $self = shift;
1104   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1105 }
1106
1107 =item agent
1108
1109 Returns the agent (see L<FS::agent>) for this customer.
1110
1111 =cut
1112
1113 sub agent {
1114   my $self = shift;
1115   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1116 }
1117
1118 =item bill OPTIONS
1119
1120 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1121 conjunction with the collect method.
1122
1123 Options are passed as name-value pairs.
1124
1125 Currently available options are:
1126
1127 resetup - if set true, re-charges setup fees.
1128
1129 time - bills the customer as if it were that time.  Specified as a UNIX
1130 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1131 L<Date::Parse> for conversion functions.  For example:
1132
1133  use Date::Parse;
1134  ...
1135  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1136
1137
1138 If there is an error, returns the error, otherwise returns false.
1139
1140 =cut
1141
1142 sub bill {
1143   my( $self, %options ) = @_;
1144   return '' if $self->payby eq 'COMP';
1145   warn "bill customer ". $self->custnum if $DEBUG;
1146
1147   my $time = $options{'time'} || time;
1148
1149   my $error;
1150
1151   #put below somehow?
1152   local $SIG{HUP} = 'IGNORE';
1153   local $SIG{INT} = 'IGNORE';
1154   local $SIG{QUIT} = 'IGNORE';
1155   local $SIG{TERM} = 'IGNORE';
1156   local $SIG{TSTP} = 'IGNORE';
1157   local $SIG{PIPE} = 'IGNORE';
1158
1159   my $oldAutoCommit = $FS::UID::AutoCommit;
1160   local $FS::UID::AutoCommit = 0;
1161   my $dbh = dbh;
1162
1163   $self->select_for_update; #mutex
1164
1165   # find the packages which are due for billing, find out how much they are
1166   # & generate invoice database.
1167
1168   my( $total_setup, $total_recur ) = ( 0, 0 );
1169   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1170   my @cust_bill_pkg = ();
1171   #my $tax = 0;##
1172   #my $taxable_charged = 0;##
1173   #my $charged = 0;##
1174
1175   my %tax;
1176
1177   foreach my $cust_pkg (
1178     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1179   ) {
1180
1181     #NO!! next if $cust_pkg->cancel;
1182     next if $cust_pkg->getfield('cancel');
1183
1184     warn "  bill package ". $cust_pkg->pkgnum if $DEBUG;
1185
1186     #? to avoid use of uninitialized value errors... ?
1187     $cust_pkg->setfield('bill', '')
1188       unless defined($cust_pkg->bill);
1189
1190     my $part_pkg = $cust_pkg->part_pkg;
1191
1192     my %hash = $cust_pkg->hash;
1193     my $old_cust_pkg = new FS::cust_pkg \%hash;
1194
1195     my @details = ();
1196
1197     # bill setup
1198     my $setup = 0;
1199     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1200
1201       warn "    bill setup" if $DEBUG;
1202
1203       $setup = eval { $cust_pkg->calc_setup( $time ) };
1204       if ( $@ ) {
1205         $dbh->rollback if $oldAutoCommit;
1206         return $@;
1207       }
1208
1209       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1210     }
1211
1212     #bill recurring fee
1213     my $recur = 0;
1214     my $sdate;
1215     if ( $part_pkg->getfield('freq') ne '0' &&
1216          ! $cust_pkg->getfield('susp') &&
1217          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1218     ) {
1219
1220       warn "    bill recur" if $DEBUG;
1221
1222       # XXX shared with $recur_prog
1223       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1224
1225       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1226       if ( $@ ) {
1227         $dbh->rollback if $oldAutoCommit;
1228         return $@;
1229       }
1230
1231       #change this bit to use Date::Manip? CAREFUL with timezones (see
1232       # mailing list archive)
1233       my ($sec,$min,$hour,$mday,$mon,$year) =
1234         (localtime($sdate) )[0,1,2,3,4,5];
1235
1236       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1237       # only for figuring next bill date, nothing else, so, reset $sdate again
1238       # here
1239       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1240       $cust_pkg->last_bill($sdate)
1241         if $cust_pkg->dbdef_table->column('last_bill');
1242
1243       if ( $part_pkg->freq =~ /^\d+$/ ) {
1244         $mon += $part_pkg->freq;
1245         until ( $mon < 12 ) { $mon -= 12; $year++; }
1246       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1247         my $weeks = $1;
1248         $mday += $weeks * 7;
1249       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1250         my $days = $1;
1251         $mday += $days;
1252       } else {
1253         $dbh->rollback if $oldAutoCommit;
1254         return "unparsable frequency: ". $part_pkg->freq;
1255       }
1256       $cust_pkg->setfield('bill',
1257         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1258     }
1259
1260     warn "\$setup is undefined" unless defined($setup);
1261     warn "\$recur is undefined" unless defined($recur);
1262     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1263
1264     if ( $cust_pkg->modified ) {
1265
1266       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1267
1268       $error=$cust_pkg->replace($old_cust_pkg);
1269       if ( $error ) { #just in case
1270         $dbh->rollback if $oldAutoCommit;
1271         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1272       }
1273
1274       $setup = sprintf( "%.2f", $setup );
1275       $recur = sprintf( "%.2f", $recur );
1276       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1277         $dbh->rollback if $oldAutoCommit;
1278         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1279       }
1280       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1281         $dbh->rollback if $oldAutoCommit;
1282         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1283       }
1284       if ( $setup != 0 || $recur != 0 ) {
1285         warn "    charges (setup=$setup, recur=$recur); queueing line items\n"
1286           if $DEBUG;
1287         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1288           'pkgnum'  => $cust_pkg->pkgnum,
1289           'setup'   => $setup,
1290           'recur'   => $recur,
1291           'sdate'   => $sdate,
1292           'edate'   => $cust_pkg->bill,
1293           'details' => \@details,
1294         });
1295         push @cust_bill_pkg, $cust_bill_pkg;
1296         $total_setup += $setup;
1297         $total_recur += $recur;
1298
1299         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1300
1301           my @taxes = qsearch( 'cust_main_county', {
1302                                  'state'    => $self->state,
1303                                  'county'   => $self->county,
1304                                  'country'  => $self->country,
1305                                  'taxclass' => $part_pkg->taxclass,
1306                                                                       } );
1307           unless ( @taxes ) {
1308             @taxes =  qsearch( 'cust_main_county', {
1309                                   'state'    => $self->state,
1310                                   'county'   => $self->county,
1311                                   'country'  => $self->country,
1312                                   'taxclass' => '',
1313                                                                       } );
1314           }
1315
1316           #one more try at a whole-country tax rate
1317           unless ( @taxes ) {
1318             @taxes =  qsearch( 'cust_main_county', {
1319                                   'state'    => '',
1320                                   'county'   => '',
1321                                   'country'  => $self->country,
1322                                   'taxclass' => '',
1323                                                                       } );
1324           }
1325
1326           # maybe eliminate this entirely, along with all the 0% records
1327           unless ( @taxes ) {
1328             $dbh->rollback if $oldAutoCommit;
1329             return
1330               "fatal: can't find tax rate for state/county/country/taxclass ".
1331               join('/', ( map $self->$_(), qw(state county country) ),
1332                         $part_pkg->taxclass ).  "\n";
1333           }
1334
1335           foreach my $tax ( @taxes ) {
1336
1337             my $taxable_charged = 0;
1338             $taxable_charged += $setup
1339               unless $part_pkg->setuptax =~ /^Y$/i
1340                   || $tax->setuptax =~ /^Y$/i;
1341             $taxable_charged += $recur
1342               unless $part_pkg->recurtax =~ /^Y$/i
1343                   || $tax->recurtax =~ /^Y$/i;
1344             next unless $taxable_charged;
1345
1346             if ( $tax->exempt_amount > 0 ) {
1347               my ($mon,$year) = (localtime($sdate) )[4,5];
1348               $mon++;
1349               my $freq = $part_pkg->freq || 1;
1350               if ( $freq !~ /(\d+)$/ ) {
1351                 $dbh->rollback if $oldAutoCommit;
1352                 return "daily/weekly package definitions not (yet?)".
1353                        " compatible with monthly tax exemptions";
1354               }
1355               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1356               foreach my $which_month ( 1 .. $freq ) {
1357                 my %hash = (
1358                   'custnum' => $self->custnum,
1359                   'taxnum'  => $tax->taxnum,
1360                   'year'    => 1900+$year,
1361                   'month'   => $mon++,
1362                 );
1363                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1364                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1365                 my $cust_tax_exempt =
1366                   qsearchs('cust_tax_exempt', \%hash)
1367                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1368                 my $remaining_exemption = sprintf("%.2f",
1369                   $tax->exempt_amount - $cust_tax_exempt->amount );
1370                 if ( $remaining_exemption > 0 ) {
1371                   my $addl = $remaining_exemption > $taxable_per_month
1372                     ? $taxable_per_month
1373                     : $remaining_exemption;
1374                   $taxable_charged -= $addl;
1375                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1376                     $cust_tax_exempt->hash,
1377                     'amount' =>
1378                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1379                   } );
1380                   $error = $new_cust_tax_exempt->exemptnum
1381                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1382                     : $new_cust_tax_exempt->insert;
1383                   if ( $error ) {
1384                     $dbh->rollback if $oldAutoCommit;
1385                     return "fatal: can't update cust_tax_exempt: $error";
1386                   }
1387
1388                 } # if $remaining_exemption > 0
1389
1390               } #foreach $which_month
1391
1392             } #if $tax->exempt_amount
1393
1394             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1395
1396             #$tax += $taxable_charged * $cust_main_county->tax / 100
1397             $tax{ $tax->taxname || 'Tax' } +=
1398               $taxable_charged * $tax->tax / 100
1399
1400           } #foreach my $tax ( @taxes )
1401
1402         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1403
1404       } #if $setup != 0 || $recur != 0
1405
1406     } #if $cust_pkg->modified
1407
1408   } #foreach my $cust_pkg
1409
1410   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1411 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1412
1413   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1414     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1415     return '';
1416   }
1417
1418 #  unless ( $self->tax =~ /Y/i
1419 #           || $self->payby eq 'COMP'
1420 #           || $taxable_charged == 0 ) {
1421 #    my $cust_main_county = qsearchs('cust_main_county',{
1422 #        'state'   => $self->state,
1423 #        'county'  => $self->county,
1424 #        'country' => $self->country,
1425 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1426 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1427 #    my $tax = sprintf( "%.2f",
1428 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1429 #    );
1430
1431   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1432
1433     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1434       my $tax = sprintf("%.2f", $tax{$taxname} );
1435       $charged = sprintf( "%.2f", $charged+$tax );
1436
1437       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1438         'pkgnum'   => 0,
1439         'setup'    => $tax,
1440         'recur'    => 0,
1441         'sdate'    => '',
1442         'edate'    => '',
1443         'itemdesc' => $taxname,
1444       });
1445       push @cust_bill_pkg, $cust_bill_pkg;
1446     }
1447
1448   } else { #1.4 schema
1449
1450     my $tax = 0;
1451     foreach ( values %tax ) { $tax += $_ };
1452     $tax = sprintf("%.2f", $tax);
1453     if ( $tax > 0 ) {
1454       $charged = sprintf( "%.2f", $charged+$tax );
1455
1456       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1457         'pkgnum' => 0,
1458         'setup'  => $tax,
1459         'recur'  => 0,
1460         'sdate'  => '',
1461         'edate'  => '',
1462       });
1463       push @cust_bill_pkg, $cust_bill_pkg;
1464     }
1465
1466   }
1467
1468   my $cust_bill = new FS::cust_bill ( {
1469     'custnum' => $self->custnum,
1470     '_date'   => $time,
1471     'charged' => $charged,
1472   } );
1473   $error = $cust_bill->insert;
1474   if ( $error ) {
1475     $dbh->rollback if $oldAutoCommit;
1476     return "can't create invoice for customer #". $self->custnum. ": $error";
1477   }
1478
1479   my $invnum = $cust_bill->invnum;
1480   my $cust_bill_pkg;
1481   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1482     #warn $invnum;
1483     $cust_bill_pkg->invnum($invnum);
1484     $error = $cust_bill_pkg->insert;
1485     if ( $error ) {
1486       $dbh->rollback if $oldAutoCommit;
1487       return "can't create invoice line item for customer #". $self->custnum.
1488              ": $error";
1489     }
1490   }
1491
1492   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1493   ''; #no error
1494 }
1495
1496 =item collect OPTIONS
1497
1498 (Attempt to) collect money for this customer's outstanding invoices (see
1499 L<FS::cust_bill>).  Usually used after the bill method.
1500
1501 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1502 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1503 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1504
1505 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1506 and the invoice events web interface.
1507
1508 If there is an error, returns the error, otherwise returns false.
1509
1510 Options are passed as name-value pairs.
1511
1512 Currently available options are:
1513
1514 invoice_time - Use this time when deciding when to print invoices and
1515 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>
1516 for conversion functions.
1517
1518 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1519 events.
1520
1521 retry_card - Deprecated alias for 'retry'
1522
1523 batch_card - This option is deprecated.  See the invoice events web interface
1524 to control whether cards are batched or run against a realtime gateway.
1525
1526 report_badcard - This option is deprecated.
1527
1528 force_print - This option is deprecated; see the invoice events web interface.
1529
1530 quiet - set true to surpress email card/ACH decline notices.
1531
1532 =cut
1533
1534 sub collect {
1535   my( $self, %options ) = @_;
1536   my $invoice_time = $options{'invoice_time'} || time;
1537
1538   #put below somehow?
1539   local $SIG{HUP} = 'IGNORE';
1540   local $SIG{INT} = 'IGNORE';
1541   local $SIG{QUIT} = 'IGNORE';
1542   local $SIG{TERM} = 'IGNORE';
1543   local $SIG{TSTP} = 'IGNORE';
1544   local $SIG{PIPE} = 'IGNORE';
1545
1546   my $oldAutoCommit = $FS::UID::AutoCommit;
1547   local $FS::UID::AutoCommit = 0;
1548   my $dbh = dbh;
1549
1550   $self->select_for_update; #mutex
1551
1552   my $balance = $self->balance;
1553   warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1554   unless ( $balance > 0 ) { #redundant?????
1555     $dbh->rollback if $oldAutoCommit; #hmm
1556     return '';
1557   }
1558
1559   if ( exists($options{'retry_card'}) ) {
1560     carp 'retry_card option passed to collect is deprecated; use retry';
1561     $options{'retry'} ||= $options{'retry_card'};
1562   }
1563   if ( exists($options{'retry'}) && $options{'retry'} ) {
1564     my $error = $self->retry_realtime;
1565     if ( $error ) {
1566       $dbh->rollback if $oldAutoCommit;
1567       return $error;
1568     }
1569   }
1570
1571   foreach my $cust_bill ( $self->open_cust_bill ) {
1572
1573     # don't try to charge for the same invoice if it's already in a batch
1574     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1575
1576     last if $self->balance <= 0;
1577
1578     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1579       if $DEBUG;
1580
1581     foreach my $part_bill_event (
1582       sort {    $a->seconds   <=> $b->seconds
1583              || $a->weight    <=> $b->weight
1584              || $a->eventpart <=> $b->eventpart }
1585         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1586                && ! qsearch( 'cust_bill_event', {
1587                                 'invnum'    => $cust_bill->invnum,
1588                                 'eventpart' => $_->eventpart,
1589                                 'status'    => 'done',
1590                                                                    } )
1591              }
1592           qsearch('part_bill_event', { 'payby'    => $self->payby,
1593                                        'disabled' => '',           } )
1594     ) {
1595
1596       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1597            || $self->balance   <= 0; # or if balance<=0
1598
1599       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1600         if $DEBUG;
1601       my $cust_main = $self; #for callback
1602
1603       my $error;
1604       {
1605         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1606         local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
1607         $error = eval $part_bill_event->eventcode;
1608       }
1609
1610       my $status = '';
1611       my $statustext = '';
1612       if ( $@ ) {
1613         $status = 'failed';
1614         $statustext = $@;
1615       } elsif ( $error ) {
1616         $status = 'done';
1617         $statustext = $error;
1618       } else {
1619         $status = 'done'
1620       }
1621
1622       #add cust_bill_event
1623       my $cust_bill_event = new FS::cust_bill_event {
1624         'invnum'     => $cust_bill->invnum,
1625         'eventpart'  => $part_bill_event->eventpart,
1626         #'_date'      => $invoice_time,
1627         '_date'      => time,
1628         'status'     => $status,
1629         'statustext' => $statustext,
1630       };
1631       $error = $cust_bill_event->insert;
1632       if ( $error ) {
1633         #$dbh->rollback if $oldAutoCommit;
1634         #return "error: $error";
1635
1636         # gah, even with transactions.
1637         $dbh->commit if $oldAutoCommit; #well.
1638         my $e = 'WARNING: Event run but database not updated - '.
1639                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1640                 ', eventpart '. $part_bill_event->eventpart.
1641                 ": $error";
1642         warn $e;
1643         return $e;
1644       }
1645
1646
1647     }
1648
1649   }
1650
1651   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1652   '';
1653
1654 }
1655
1656 =item retry_realtime
1657
1658 Schedules realtime credit card / electronic check / LEC billing events for
1659 for retry.  Useful if card information has changed or manual retry is desired.
1660 The 'collect' method must be called to actually retry the transaction.
1661
1662 Implementation details: For each of this customer's open invoices, changes
1663 the status of the first "done" (with statustext error) realtime processing
1664 event to "failed".
1665
1666 =cut
1667
1668 sub retry_realtime {
1669   my $self = shift;
1670
1671   local $SIG{HUP} = 'IGNORE';
1672   local $SIG{INT} = 'IGNORE';
1673   local $SIG{QUIT} = 'IGNORE';
1674   local $SIG{TERM} = 'IGNORE';
1675   local $SIG{TSTP} = 'IGNORE';
1676   local $SIG{PIPE} = 'IGNORE';
1677
1678   my $oldAutoCommit = $FS::UID::AutoCommit;
1679   local $FS::UID::AutoCommit = 0;
1680   my $dbh = dbh;
1681
1682   foreach my $cust_bill (
1683     grep { $_->cust_bill_event }
1684       $self->open_cust_bill
1685   ) {
1686     my @cust_bill_event =
1687       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1688         grep {
1689                #$_->part_bill_event->plan eq 'realtime-card'
1690                $_->part_bill_event->eventcode =~
1691                    /\$cust_bill\->realtime_(card|ach|lec)/
1692                  && $_->status eq 'done'
1693                  && $_->statustext
1694              }
1695           $cust_bill->cust_bill_event;
1696     next unless @cust_bill_event;
1697     my $error = $cust_bill_event[0]->retry;
1698     if ( $error ) {
1699       $dbh->rollback if $oldAutoCommit;
1700       return "error scheduling invoice event for retry: $error";
1701     }
1702
1703   }
1704
1705   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1706   '';
1707
1708 }
1709
1710 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1711
1712 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1713 via a Business::OnlinePayment realtime gateway.  See
1714 L<http://420.am/business-onlinepayment> for supported gateways.
1715
1716 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1717
1718 Available options are: I<description>, I<invnum>, I<quiet>
1719
1720 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1721 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1722 if set, will override the value from the customer record.
1723
1724 I<description> is a free-text field passed to the gateway.  It defaults to
1725 "Internet services".
1726
1727 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1728 specified invoice.  If you don't specify an I<invnum> you might want to
1729 call the B<apply_payments> method.
1730
1731 I<quiet> can be set true to surpress email decline notices.
1732
1733 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1734
1735 =cut
1736
1737 sub realtime_bop {
1738   my( $self, $method, $amount, %options ) = @_;
1739   if ( $DEBUG ) {
1740     warn "$self $method $amount\n";
1741     warn "  $_ => $options{$_}\n" foreach keys %options;
1742   }
1743
1744   $options{'description'} ||= 'Internet services';
1745
1746   #pre-requisites
1747   die "Real-time processing not enabled\n"
1748     unless $conf->exists('business-onlinepayment');
1749   eval "use Business::OnlinePayment";
1750   die $@ if $@;
1751
1752   #load up config
1753   my $bop_config = 'business-onlinepayment';
1754   $bop_config .= '-ach'
1755     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1756   my ( $processor, $login, $password, $action, @bop_options ) =
1757     $conf->config($bop_config);
1758   $action ||= 'normal authorization';
1759   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1760   die "No real-time processor is enabled - ".
1761       "did you set the business-onlinepayment configuration value?\n"
1762     unless $processor;
1763
1764   #massage data
1765
1766   my $address = exists($options{'address1'})
1767                     ? $options{'address1'}
1768                     : $self->address1;
1769   my $address2 = exists($options{'address2'})
1770                     ? $options{'address2'}
1771                     : $self->address2;
1772   $address .= ", ". $address2 if length($address2);
1773
1774   my $o_payname = exists($options{'payname'})
1775                     ? $options{'payname'}
1776                     : $self->payname;
1777   my($payname, $payfirst, $paylast);
1778   if ( $o_payname && $method ne 'ECHECK' ) {
1779     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1780       or return "Illegal payname $payname";
1781     ($payfirst, $paylast) = ($1, $2);
1782   } else {
1783     $payfirst = $self->getfield('first');
1784     $paylast = $self->getfield('last');
1785     $payname =  "$payfirst $paylast";
1786   }
1787
1788   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1789   if ( $conf->exists('emailinvoiceauto')
1790        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1791     push @invoicing_list, $self->all_emails;
1792   }
1793   my $email = $invoicing_list[0];
1794
1795   my $payinfo = exists($options{'payinfo'})
1796                   ? $options{'payinfo'}
1797                   : $self->payinfo;
1798
1799   my %content = ();
1800   if ( $method eq 'CC' ) {
1801
1802     $content{card_number} = $payinfo;
1803     my $paydate = exists($options{'paydate'})
1804                     ? $options{'paydate'}
1805                     : $self->paydate;
1806     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1807     $content{expiration} = "$2/$1";
1808
1809     if ( defined $self->dbdef_table->column('paycvv') ) {
1810       my $paycvv = exists($options{'paycvv'})
1811                      ? $options{'paycvv'}
1812                      : $self->paycvv;
1813       $content{cvv2} = $self->paycvv
1814         if length($paycvv);
1815     }
1816
1817     $content{recurring_billing} = 'YES'
1818       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1819                                'payby'   => 'CARD',
1820                                'payinfo' => $payinfo,
1821                              } );
1822
1823   } elsif ( $method eq 'ECHECK' ) {
1824     ( $content{account_number}, $content{routing_code} ) =
1825       split('@', $payinfo);
1826     $content{bank_name} = $o_payname;
1827     $content{account_type} = 'CHECKING';
1828     $content{account_name} = $payname;
1829     $content{customer_org} = $self->company ? 'B' : 'I';
1830     $content{customer_ssn} = exists($options{'ss'})
1831                                ? $options{'ss'}
1832                                : $self->ss;
1833   } elsif ( $method eq 'LEC' ) {
1834     $content{phone} = $payinfo;
1835   }
1836
1837   #transaction(s)
1838
1839   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1840
1841   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1842   $transaction->content(
1843     'type'           => $method,
1844     'login'          => $login,
1845     'password'       => $password,
1846     'action'         => $action1,
1847     'description'    => $options{'description'},
1848     'amount'         => $amount,
1849     'invoice_number' => $options{'invnum'},
1850     'customer_id'    => $self->custnum,
1851     'last_name'      => $paylast,
1852     'first_name'     => $payfirst,
1853     'name'           => $payname,
1854     'address'        => $address,
1855     'city'           => ( exists($options{'city'})
1856                             ? $options{'city'}
1857                             : $self->city          ),
1858     'state'          => ( exists($options{'state'})
1859                             ? $options{'state'}
1860                             : $self->state          ),
1861     'zip'            => ( exists($options{'zip'})
1862                             ? $options{'zip'}
1863                             : $self->zip          ),
1864     'country'        => ( exists($options{'country'})
1865                             ? $options{'country'}
1866                             : $self->country          ),
1867     'referer'        => 'http://cleanwhisker.420.am/',
1868     'email'          => $email,
1869     'phone'          => $self->daytime || $self->night,
1870     %content, #after
1871   );
1872   $transaction->submit();
1873
1874   if ( $transaction->is_success() && $action2 ) {
1875     my $auth = $transaction->authorization;
1876     my $ordernum = $transaction->can('order_number')
1877                    ? $transaction->order_number
1878                    : '';
1879
1880     my $capture =
1881       new Business::OnlinePayment( $processor, @bop_options );
1882
1883     my %capture = (
1884       %content,
1885       type           => $method,
1886       action         => $action2,
1887       login          => $login,
1888       password       => $password,
1889       order_number   => $ordernum,
1890       amount         => $amount,
1891       authorization  => $auth,
1892       description    => $options{'description'},
1893     );
1894
1895     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1896                            transaction_sequence_num local_transaction_date
1897                            local_transaction_time AVS_result_code          )) {
1898       $capture{$field} = $transaction->$field() if $transaction->can($field);
1899     }
1900
1901     $capture->content( %capture );
1902
1903     $capture->submit();
1904
1905     unless ( $capture->is_success ) {
1906       my $e = "Authorization sucessful but capture failed, custnum #".
1907               $self->custnum. ': '.  $capture->result_code.
1908               ": ". $capture->error_message;
1909       warn $e;
1910       return $e;
1911     }
1912
1913   }
1914
1915   #remove paycvv after initial transaction
1916   #false laziness w/misc/process/payment.cgi - check both to make sure working
1917   # correctly
1918   if ( defined $self->dbdef_table->column('paycvv')
1919        && length($self->paycvv)
1920        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
1921   ) {
1922     my $error = $self->remove_cvv;
1923     if ( $error ) {
1924       warn "error removing cvv: $error\n";
1925     }
1926   }
1927
1928   #result handling
1929   if ( $transaction->is_success() ) {
1930
1931     my %method2payby = (
1932       'CC'     => 'CARD',
1933       'ECHECK' => 'CHEK',
1934       'LEC'    => 'LECB',
1935     );
1936
1937     my $paybatch = "$processor:". $transaction->authorization;
1938     $paybatch .= ':'. $transaction->order_number
1939       if $transaction->can('order_number')
1940       && length($transaction->order_number);
1941
1942     my $cust_pay = new FS::cust_pay ( {
1943        'custnum'  => $self->custnum,
1944        'invnum'   => $options{'invnum'},
1945        'paid'     => $amount,
1946        '_date'     => '',
1947        'payby'    => $method2payby{$method},
1948        'payinfo'  => $payinfo,
1949        'paybatch' => $paybatch,
1950     } );
1951     my $error = $cust_pay->insert;
1952     if ( $error ) {
1953       $cust_pay->invnum(''); #try again with no specific invnum
1954       my $error2 = $cust_pay->insert;
1955       if ( $error2 ) {
1956         # gah, even with transactions.
1957         my $e = 'WARNING: Card/ACH debited but database not updated - '.
1958                 "error inserting payment ($processor): $error2".
1959                 " (previously tried insert with invnum #$options{'invnum'}" .
1960                 ": $error )";
1961         warn $e;
1962         return $e;
1963       }
1964     }
1965     return ''; #no error
1966
1967   } else {
1968
1969     my $perror = "$processor error: ". $transaction->error_message;
1970
1971     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1972          && $conf->exists('emaildecline')
1973          && grep { $_ ne 'POST' } $self->invoicing_list
1974          && ! grep { $transaction->error_message =~ /$_/ }
1975                    $conf->config('emaildecline-exclude')
1976     ) {
1977       my @templ = $conf->config('declinetemplate');
1978       my $template = new Text::Template (
1979         TYPE   => 'ARRAY',
1980         SOURCE => [ map "$_\n", @templ ],
1981       ) or return "($perror) can't create template: $Text::Template::ERROR";
1982       $template->compile()
1983         or return "($perror) can't compile template: $Text::Template::ERROR";
1984
1985       my $templ_hash = { error => $transaction->error_message };
1986
1987       my $error = send_email(
1988         'from'    => $conf->config('invoice_from'),
1989         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1990         'subject' => 'Your payment could not be processed',
1991         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1992       );
1993
1994       $perror .= " (also received error sending decline notification: $error)"
1995         if $error;
1996
1997     }
1998
1999     return $perror;
2000   }
2001
2002 }
2003
2004 =item remove_cvv
2005
2006 Removes the I<paycvv> field from the database directly.
2007
2008 If there is an error, returns the error, otherwise returns false.
2009
2010 =cut
2011
2012 sub remove_cvv {
2013   my $self = shift;
2014   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2015     or return dbh->errstr;
2016   $sth->execute($self->custnum)
2017     or return $sth->errstr;
2018   $self->paycvv('');
2019   '';
2020 }
2021
2022 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2023
2024 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2025 via a Business::OnlinePayment realtime gateway.  See
2026 L<http://420.am/business-onlinepayment> for supported gateways.
2027
2028 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2029
2030 Available options are: I<amount>, I<reason>, I<paynum>
2031
2032 Most gateways require a reference to an original payment transaction to refund,
2033 so you probably need to specify a I<paynum>.
2034
2035 I<amount> defaults to the original amount of the payment if not specified.
2036
2037 I<reason> specifies a reason for the refund.
2038
2039 Implementation note: If I<amount> is unspecified or equal to the amount of the
2040 orignal payment, first an attempt is made to "void" the transaction via
2041 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2042 the normal attempt is made to "refund" ("credit") the transaction via the
2043 gateway is attempted.
2044
2045 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2046 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2047 #if set, will override the value from the customer record.
2048
2049 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2050 #specified invoice.  If you don't specify an I<invnum> you might want to
2051 #call the B<apply_payments> method.
2052
2053 =cut
2054
2055 #some false laziness w/realtime_bop, not enough to make it worth merging
2056 #but some useful small subs should be pulled out
2057 sub realtime_refund_bop {
2058   my( $self, $method, %options ) = @_;
2059   if ( $DEBUG ) {
2060     warn "$self $method refund\n";
2061     warn "  $_ => $options{$_}\n" foreach keys %options;
2062   }
2063
2064   #pre-requisites
2065   die "Real-time processing not enabled\n"
2066     unless $conf->exists('business-onlinepayment');
2067   eval "use Business::OnlinePayment";
2068   die $@ if $@;
2069
2070   #load up config
2071   my $bop_config = 'business-onlinepayment';
2072   $bop_config .= '-ach'
2073     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2074   my ( $processor, $login, $password, $unused_action, @bop_options ) =
2075     $conf->config($bop_config);
2076   #$action ||= 'normal authorization';
2077   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2078   die "No real-time processor is enabled - ".
2079       "did you set the business-onlinepayment configuration value?\n"
2080     unless $processor;
2081
2082   my $cust_pay = '';
2083   my $amount = $options{'amount'};
2084   my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2085   if ( $options{'paynum'} ) {
2086     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2087     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2088       or return "Unknown paynum $options{'paynum'}";
2089     $amount ||= $cust_pay->paid;
2090     $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2091       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2092                 $cust_pay->paybatch;
2093     ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2094     return "processor of payment $options{'paynum'} $pay_processor does not".
2095            " match current processor $processor"
2096       unless $pay_processor eq $processor;
2097   }
2098   return "neither amount nor paynum specified" unless $amount;
2099
2100   my %content = (
2101     'type'           => $method,
2102     'login'          => $login,
2103     'password'       => $password,
2104     'order_number'   => $order_number,
2105     'amount'         => $amount,
2106     'referer'        => 'http://cleanwhisker.420.am/',
2107   );
2108   $content{authorization} = $auth
2109     if length($auth); #echeck/ACH transactions have an order # but no auth
2110                       #(at least with authorize.net)
2111
2112   #first try void if applicable
2113   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2114     my $void = new Business::OnlinePayment( $processor, @bop_options );
2115     $void->content( 'action' => 'void', %content );
2116     $void->submit();
2117     if ( $void->is_success ) {
2118       my $error = $cust_pay->void($options{'reason'});
2119       if ( $error ) {
2120         # gah, even with transactions.
2121         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2122                 "error voiding payment: $error";
2123         warn $e;
2124         return $e;
2125       }
2126       return '';
2127     }
2128   }
2129
2130   #massage data
2131   my $address = $self->address1;
2132   $address .= ", ". $self->address2 if $self->address2;
2133
2134   my($payname, $payfirst, $paylast);
2135   if ( $self->payname && $method ne 'ECHECK' ) {
2136     $payname = $self->payname;
2137     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2138       or return "Illegal payname $payname";
2139     ($payfirst, $paylast) = ($1, $2);
2140   } else {
2141     $payfirst = $self->getfield('first');
2142     $paylast = $self->getfield('last');
2143     $payname =  "$payfirst $paylast";
2144   }
2145
2146   if ( $method eq 'CC' ) {
2147
2148     $content{card_number} = $self->payinfo;
2149     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2150     $content{expiration} = "$2/$1";
2151
2152     #$content{cvv2} = $self->paycvv
2153     #  if defined $self->dbdef_table->column('paycvv')
2154     #     && length($self->paycvv);
2155
2156     #$content{recurring_billing} = 'YES'
2157     #  if qsearch('cust_pay', { 'custnum' => $self->custnum,
2158     #                           'payby'   => 'CARD',
2159     #                           'payinfo' => $self->payinfo, } );
2160
2161   } elsif ( $method eq 'ECHECK' ) {
2162     ( $content{account_number}, $content{routing_code} ) =
2163       split('@', $self->payinfo);
2164     $content{bank_name} = $self->payname;
2165     $content{account_type} = 'CHECKING';
2166     $content{account_name} = $payname;
2167     $content{customer_org} = $self->company ? 'B' : 'I';
2168     $content{customer_ssn} = $self->ss;
2169   } elsif ( $method eq 'LEC' ) {
2170     $content{phone} = $self->payinfo;
2171   }
2172
2173   #then try refund
2174   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2175   $refund->content(
2176     'action'         => 'credit',
2177     'customer_id'    => $self->custnum,
2178     'last_name'      => $paylast,
2179     'first_name'     => $payfirst,
2180     'name'           => $payname,
2181     'address'        => $address,
2182     'city'           => $self->city,
2183     'state'          => $self->state,
2184     'zip'            => $self->zip,
2185     'country'        => $self->country,
2186     %content, #after
2187   );
2188   $refund->submit();
2189
2190   return "$processor error: ". $refund->error_message
2191     unless $refund->is_success();
2192
2193   my %method2payby = (
2194     'CC'     => 'CARD',
2195     'ECHECK' => 'CHEK',
2196     'LEC'    => 'LECB',
2197   );
2198
2199   my $paybatch = "$processor:". $refund->authorization;
2200   $paybatch .= ':'. $refund->order_number
2201     if $refund->can('order_number') && $refund->order_number;
2202
2203   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2204     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2205     last unless @cust_bill_pay;
2206     my $cust_bill_pay = pop @cust_bill_pay;
2207     my $error = $cust_bill_pay->delete;
2208     last if $error;
2209   }
2210
2211   my $cust_refund = new FS::cust_refund ( {
2212     'custnum'  => $self->custnum,
2213     'paynum'   => $options{'paynum'},
2214     'refund'   => $amount,
2215     '_date'    => '',
2216     'payby'    => $method2payby{$method},
2217     'payinfo'  => $self->payinfo,
2218     'paybatch' => $paybatch,
2219     'reason'   => $options{'reason'} || 'card or ACH refund',
2220   } );
2221   my $error = $cust_refund->insert;
2222   if ( $error ) {
2223     $cust_refund->paynum(''); #try again with no specific paynum
2224     my $error2 = $cust_refund->insert;
2225     if ( $error2 ) {
2226       # gah, even with transactions.
2227       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2228               "error inserting refund ($processor): $error2".
2229               " (previously tried insert with paynum #$options{'paynum'}" .
2230               ": $error )";
2231       warn $e;
2232       return $e;
2233     }
2234   }
2235
2236   ''; #no error
2237
2238 }
2239
2240 =item total_owed
2241
2242 Returns the total owed for this customer on all invoices
2243 (see L<FS::cust_bill/owed>).
2244
2245 =cut
2246
2247 sub total_owed {
2248   my $self = shift;
2249   $self->total_owed_date(2145859200); #12/31/2037
2250 }
2251
2252 =item total_owed_date TIME
2253
2254 Returns the total owed for this customer on all invoices with date earlier than
2255 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2256 see L<Time::Local> and L<Date::Parse> for conversion functions.
2257
2258 =cut
2259
2260 sub total_owed_date {
2261   my $self = shift;
2262   my $time = shift;
2263   my $total_bill = 0;
2264   foreach my $cust_bill (
2265     grep { $_->_date <= $time }
2266       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2267   ) {
2268     $total_bill += $cust_bill->owed;
2269   }
2270   sprintf( "%.2f", $total_bill );
2271 }
2272
2273 =item apply_credits OPTION => VALUE ...
2274
2275 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2276 to outstanding invoice balances in chronological order (or reverse
2277 chronological order if the I<order> option is set to B<newest>) and returns the
2278 value of any remaining unapplied credits available for refund (see
2279 L<FS::cust_refund>).
2280
2281 =cut
2282
2283 sub apply_credits {
2284   my $self = shift;
2285   my %opt = @_;
2286
2287   return 0 unless $self->total_credited;
2288
2289   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2290       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2291
2292   my @invoices = $self->open_cust_bill;
2293   @invoices = sort { $b->_date <=> $a->_date } @invoices
2294     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2295
2296   my $credit;
2297   foreach my $cust_bill ( @invoices ) {
2298     my $amount;
2299
2300     if ( !defined($credit) || $credit->credited == 0) {
2301       $credit = pop @credits or last;
2302     }
2303
2304     if ($cust_bill->owed >= $credit->credited) {
2305       $amount=$credit->credited;
2306     }else{
2307       $amount=$cust_bill->owed;
2308     }
2309
2310     my $cust_credit_bill = new FS::cust_credit_bill ( {
2311       'crednum' => $credit->crednum,
2312       'invnum'  => $cust_bill->invnum,
2313       'amount'  => $amount,
2314     } );
2315     my $error = $cust_credit_bill->insert;
2316     die $error if $error;
2317
2318     redo if ($cust_bill->owed > 0);
2319
2320   }
2321
2322   return $self->total_credited;
2323 }
2324
2325 =item apply_payments
2326
2327 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2328 to outstanding invoice balances in chronological order.
2329
2330  #and returns the value of any remaining unapplied payments.
2331
2332 =cut
2333
2334 sub apply_payments {
2335   my $self = shift;
2336
2337   #return 0 unless
2338
2339   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2340       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2341
2342   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2343       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2344
2345   my $payment;
2346
2347   foreach my $cust_bill ( @invoices ) {
2348     my $amount;
2349
2350     if ( !defined($payment) || $payment->unapplied == 0 ) {
2351       $payment = pop @payments or last;
2352     }
2353
2354     if ( $cust_bill->owed >= $payment->unapplied ) {
2355       $amount = $payment->unapplied;
2356     } else {
2357       $amount = $cust_bill->owed;
2358     }
2359
2360     my $cust_bill_pay = new FS::cust_bill_pay ( {
2361       'paynum' => $payment->paynum,
2362       'invnum' => $cust_bill->invnum,
2363       'amount' => $amount,
2364     } );
2365     my $error = $cust_bill_pay->insert;
2366     die $error if $error;
2367
2368     redo if ( $cust_bill->owed > 0);
2369
2370   }
2371
2372   return $self->total_unapplied_payments;
2373 }
2374
2375 =item total_credited
2376
2377 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2378 customer.  See L<FS::cust_credit/credited>.
2379
2380 =cut
2381
2382 sub total_credited {
2383   my $self = shift;
2384   my $total_credit = 0;
2385   foreach my $cust_credit ( qsearch('cust_credit', {
2386     'custnum' => $self->custnum,
2387   } ) ) {
2388     $total_credit += $cust_credit->credited;
2389   }
2390   sprintf( "%.2f", $total_credit );
2391 }
2392
2393 =item total_unapplied_payments
2394
2395 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2396 See L<FS::cust_pay/unapplied>.
2397
2398 =cut
2399
2400 sub total_unapplied_payments {
2401   my $self = shift;
2402   my $total_unapplied = 0;
2403   foreach my $cust_pay ( qsearch('cust_pay', {
2404     'custnum' => $self->custnum,
2405   } ) ) {
2406     $total_unapplied += $cust_pay->unapplied;
2407   }
2408   sprintf( "%.2f", $total_unapplied );
2409 }
2410
2411 =item balance
2412
2413 Returns the balance for this customer (total_owed minus total_credited
2414 minus total_unapplied_payments).
2415
2416 =cut
2417
2418 sub balance {
2419   my $self = shift;
2420   sprintf( "%.2f",
2421     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2422   );
2423 }
2424
2425 =item balance_date TIME
2426
2427 Returns the balance for this customer, only considering invoices with date
2428 earlier than TIME (total_owed_date minus total_credited minus
2429 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2430 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2431 functions.
2432
2433 =cut
2434
2435 sub balance_date {
2436   my $self = shift;
2437   my $time = shift;
2438   sprintf( "%.2f",
2439     $self->total_owed_date($time)
2440       - $self->total_credited
2441       - $self->total_unapplied_payments
2442   );
2443 }
2444
2445 =item paydate_monthyear
2446
2447 Returns a two-element list consisting of the month and year of this customer's
2448 paydate (credit card expiration date for CARD customers)
2449
2450 =cut
2451
2452 sub paydate_monthyear {
2453   my $self = shift;
2454   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2455     ( $2, $1 );
2456   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2457     ( $1, $3 );
2458   } else {
2459     ('', '');
2460   }
2461 }
2462
2463 =item payinfo_masked
2464
2465 Returns a "masked" payinfo field with all but the last four characters replaced
2466 by 'x'es.  Useful for displaying credit cards.
2467
2468 =cut
2469
2470 sub payinfo_masked {
2471   my $self = shift;
2472   my $payinfo = $self->payinfo;
2473   'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2474 }
2475
2476 =item invoicing_list [ ARRAYREF ]
2477
2478 If an arguement is given, sets these email addresses as invoice recipients
2479 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2480 (except as warnings), so use check_invoicing_list first.
2481
2482 Returns a list of email addresses (with svcnum entries expanded).
2483
2484 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2485 check it without disturbing anything by passing nothing.
2486
2487 This interface may change in the future.
2488
2489 =cut
2490
2491 sub invoicing_list {
2492   my( $self, $arrayref ) = @_;
2493   if ( $arrayref ) {
2494     my @cust_main_invoice;
2495     if ( $self->custnum ) {
2496       @cust_main_invoice =
2497         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2498     } else {
2499       @cust_main_invoice = ();
2500     }
2501     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2502       #warn $cust_main_invoice->destnum;
2503       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2504         #warn $cust_main_invoice->destnum;
2505         my $error = $cust_main_invoice->delete;
2506         warn $error if $error;
2507       }
2508     }
2509     if ( $self->custnum ) {
2510       @cust_main_invoice =
2511         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2512     } else {
2513       @cust_main_invoice = ();
2514     }
2515     my %seen = map { $_->address => 1 } @cust_main_invoice;
2516     foreach my $address ( @{$arrayref} ) {
2517       next if exists $seen{$address} && $seen{$address};
2518       $seen{$address} = 1;
2519       my $cust_main_invoice = new FS::cust_main_invoice ( {
2520         'custnum' => $self->custnum,
2521         'dest'    => $address,
2522       } );
2523       my $error = $cust_main_invoice->insert;
2524       warn $error if $error;
2525     }
2526   }
2527   if ( $self->custnum ) {
2528     map { $_->address }
2529       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2530   } else {
2531     ();
2532   }
2533 }
2534
2535 =item check_invoicing_list ARRAYREF
2536
2537 Checks these arguements as valid input for the invoicing_list method.  If there
2538 is an error, returns the error, otherwise returns false.
2539
2540 =cut
2541
2542 sub check_invoicing_list {
2543   my( $self, $arrayref ) = @_;
2544   foreach my $address ( @{$arrayref} ) {
2545     my $cust_main_invoice = new FS::cust_main_invoice ( {
2546       'custnum' => $self->custnum,
2547       'dest'    => $address,
2548     } );
2549     my $error = $self->custnum
2550                 ? $cust_main_invoice->check
2551                 : $cust_main_invoice->checkdest
2552     ;
2553     return $error if $error;
2554   }
2555   '';
2556 }
2557
2558 =item set_default_invoicing_list
2559
2560 Sets the invoicing list to all accounts associated with this customer,
2561 overwriting any previous invoicing list.
2562
2563 =cut
2564
2565 sub set_default_invoicing_list {
2566   my $self = shift;
2567   $self->invoicing_list($self->all_emails);
2568 }
2569
2570 =item all_emails
2571
2572 Returns the email addresses of all accounts provisioned for this customer.
2573
2574 =cut
2575
2576 sub all_emails {
2577   my $self = shift;
2578   my %list;
2579   foreach my $cust_pkg ( $self->all_pkgs ) {
2580     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2581     my @svc_acct =
2582       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2583         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2584           @cust_svc;
2585     $list{$_}=1 foreach map { $_->email } @svc_acct;
2586   }
2587   keys %list;
2588 }
2589
2590 =item invoicing_list_addpost
2591
2592 Adds postal invoicing to this customer.  If this customer is already configured
2593 to receive postal invoices, does nothing.
2594
2595 =cut
2596
2597 sub invoicing_list_addpost {
2598   my $self = shift;
2599   return if grep { $_ eq 'POST' } $self->invoicing_list;
2600   my @invoicing_list = $self->invoicing_list;
2601   push @invoicing_list, 'POST';
2602   $self->invoicing_list(\@invoicing_list);
2603 }
2604
2605 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2606
2607 Returns an array of customers referred by this customer (referral_custnum set
2608 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2609 customers referred by customers referred by this customer and so on, inclusive.
2610 The default behavior is DEPTH 1 (no recursion).
2611
2612 =cut
2613
2614 sub referral_cust_main {
2615   my $self = shift;
2616   my $depth = @_ ? shift : 1;
2617   my $exclude = @_ ? shift : {};
2618
2619   my @cust_main =
2620     map { $exclude->{$_->custnum}++; $_; }
2621       grep { ! $exclude->{ $_->custnum } }
2622         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2623
2624   if ( $depth > 1 ) {
2625     push @cust_main,
2626       map { $_->referral_cust_main($depth-1, $exclude) }
2627         @cust_main;
2628   }
2629
2630   @cust_main;
2631 }
2632
2633 =item referral_cust_main_ncancelled
2634
2635 Same as referral_cust_main, except only returns customers with uncancelled
2636 packages.
2637
2638 =cut
2639
2640 sub referral_cust_main_ncancelled {
2641   my $self = shift;
2642   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2643 }
2644
2645 =item referral_cust_pkg [ DEPTH ]
2646
2647 Like referral_cust_main, except returns a flat list of all unsuspended (and
2648 uncancelled) packages for each customer.  The number of items in this list may
2649 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2650
2651 =cut
2652
2653 sub referral_cust_pkg {
2654   my $self = shift;
2655   my $depth = @_ ? shift : 1;
2656
2657   map { $_->unsuspended_pkgs }
2658     grep { $_->unsuspended_pkgs }
2659       $self->referral_cust_main($depth);
2660 }
2661
2662 =item credit AMOUNT, REASON
2663
2664 Applies a credit to this customer.  If there is an error, returns the error,
2665 otherwise returns false.
2666
2667 =cut
2668
2669 sub credit {
2670   my( $self, $amount, $reason ) = @_;
2671   my $cust_credit = new FS::cust_credit {
2672     'custnum' => $self->custnum,
2673     'amount'  => $amount,
2674     'reason'  => $reason,
2675   };
2676   $cust_credit->insert;
2677 }
2678
2679 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2680
2681 Creates a one-time charge for this customer.  If there is an error, returns
2682 the error, otherwise returns false.
2683
2684 =cut
2685
2686 sub charge {
2687   my ( $self, $amount ) = ( shift, shift );
2688   my $pkg      = @_ ? shift : 'One-time charge';
2689   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2690   my $taxclass = @_ ? shift : '';
2691
2692   local $SIG{HUP} = 'IGNORE';
2693   local $SIG{INT} = 'IGNORE';
2694   local $SIG{QUIT} = 'IGNORE';
2695   local $SIG{TERM} = 'IGNORE';
2696   local $SIG{TSTP} = 'IGNORE';
2697   local $SIG{PIPE} = 'IGNORE';
2698
2699   my $oldAutoCommit = $FS::UID::AutoCommit;
2700   local $FS::UID::AutoCommit = 0;
2701   my $dbh = dbh;
2702
2703   my $part_pkg = new FS::part_pkg ( {
2704     'pkg'      => $pkg,
2705     'comment'  => $comment,
2706     #'setup'    => $amount,
2707     #'recur'    => '0',
2708     'plan'     => 'flat',
2709     'plandata' => "setup_fee=$amount",
2710     'freq'     => 0,
2711     'disabled' => 'Y',
2712     'taxclass' => $taxclass,
2713   } );
2714
2715   my $error = $part_pkg->insert;
2716   if ( $error ) {
2717     $dbh->rollback if $oldAutoCommit;
2718     return $error;
2719   }
2720
2721   my $pkgpart = $part_pkg->pkgpart;
2722   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2723   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2724     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2725     $error = $type_pkgs->insert;
2726     if ( $error ) {
2727       $dbh->rollback if $oldAutoCommit;
2728       return $error;
2729     }
2730   }
2731
2732   my $cust_pkg = new FS::cust_pkg ( {
2733     'custnum' => $self->custnum,
2734     'pkgpart' => $pkgpart,
2735   } );
2736
2737   $error = $cust_pkg->insert;
2738   if ( $error ) {
2739     $dbh->rollback if $oldAutoCommit;
2740     return $error;
2741   }
2742
2743   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2744   '';
2745
2746 }
2747
2748 =item cust_bill
2749
2750 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2751
2752 =cut
2753
2754 sub cust_bill {
2755   my $self = shift;
2756   sort { $a->_date <=> $b->_date }
2757     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2758 }
2759
2760 =item open_cust_bill
2761
2762 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2763 customer.
2764
2765 =cut
2766
2767 sub open_cust_bill {
2768   my $self = shift;
2769   grep { $_->owed > 0 } $self->cust_bill;
2770 }
2771
2772 =item cust_credit
2773
2774 Returns all the credits (see L<FS::cust_credit>) for this customer.
2775
2776 =cut
2777
2778 sub cust_credit {
2779   my $self = shift;
2780   sort { $a->_date <=> $b->_date }
2781     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2782 }
2783
2784 =item cust_pay
2785
2786 Returns all the payments (see L<FS::cust_pay>) for this customer.
2787
2788 =cut
2789
2790 sub cust_pay {
2791   my $self = shift;
2792   sort { $a->_date <=> $b->_date }
2793     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2794 }
2795
2796 =item cust_pay_void
2797
2798 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2799
2800 =cut
2801
2802 sub cust_pay_void {
2803   my $self = shift;
2804   sort { $a->_date <=> $b->_date }
2805     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2806 }
2807
2808
2809 =item cust_refund
2810
2811 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2812
2813 =cut
2814
2815 sub cust_refund {
2816   my $self = shift;
2817   sort { $a->_date <=> $b->_date }
2818     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2819 }
2820
2821 =item select_for_update
2822
2823 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2824 a mutex.
2825
2826 =cut
2827
2828 sub select_for_update {
2829   my $self = shift;
2830   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2831 }
2832
2833 =item name
2834
2835 Returns a name string for this customer, either "Company (Last, First)" or
2836 "Last, First".
2837
2838 =cut
2839
2840 sub name {
2841   my $self = shift;
2842   my $name = $self->get('last'). ', '. $self->first;
2843   $name = $self->company. " ($name)" if $self->company;
2844   $name;
2845 }
2846
2847 =item status
2848
2849 Returns a status string for this customer, currently:
2850
2851 =over 4
2852
2853 =item prospect - No packages have ever been ordered
2854
2855 =item active - One or more recurring packages is active
2856
2857 =item suspended - All non-cancelled recurring packages are suspended
2858
2859 =item cancelled - All recurring packages are cancelled
2860
2861 =back
2862
2863 =cut
2864
2865 sub status {
2866   my $self = shift;
2867   for my $status (qw( prospect active suspended cancelled )) {
2868     my $method = $status.'_sql';
2869     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2870     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2871     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2872     return $status if $sth->fetchrow_arrayref->[0];
2873   }
2874 }
2875
2876 =item statuscolor
2877
2878 Returns a hex triplet color string for this customer's status.
2879
2880 =cut
2881
2882 my %statuscolor = (
2883   'prospect'  => '000000',
2884   'active'    => '00CC00',
2885   'suspended' => 'FF9900',
2886   'cancelled' => 'FF0000',
2887 );
2888 sub statuscolor {
2889   my $self = shift;
2890   $statuscolor{$self->status};
2891 }
2892
2893 =back
2894
2895 =head1 CLASS METHODS
2896
2897 =over 4
2898
2899 =item prospect_sql
2900
2901 Returns an SQL expression identifying prospective cust_main records (customers
2902 with no packages ever ordered)
2903
2904 =cut
2905
2906 sub prospect_sql { "
2907   0 = ( SELECT COUNT(*) FROM cust_pkg
2908           WHERE cust_pkg.custnum = cust_main.custnum
2909       )
2910 "; }
2911
2912 =item active_sql
2913
2914 Returns an SQL expression identifying active cust_main records.
2915
2916 =cut
2917
2918 sub active_sql { "
2919   0 < ( SELECT COUNT(*) FROM cust_pkg
2920           WHERE cust_pkg.custnum = cust_main.custnum
2921             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2922             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2923       )
2924 "; }
2925
2926 =item susp_sql
2927 =item suspended_sql
2928
2929 Returns an SQL expression identifying suspended cust_main records.
2930
2931 =cut
2932
2933 sub suspended_sql { susp_sql(@_); }
2934 sub susp_sql { "
2935     0 < ( SELECT COUNT(*) FROM cust_pkg
2936             WHERE cust_pkg.custnum = cust_main.custnum
2937               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2938         )
2939     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2940                 WHERE cust_pkg.custnum = cust_main.custnum
2941                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2942                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2943             )
2944 "; }
2945
2946 =item cancel_sql
2947 =item cancelled_sql
2948
2949 Returns an SQL expression identifying cancelled cust_main records.
2950
2951 =cut
2952
2953 sub cancelled_sql { cancel_sql(@_); }
2954 sub cancel_sql { "
2955   0 < ( SELECT COUNT(*) FROM cust_pkg
2956           WHERE cust_pkg.custnum = cust_main.custnum
2957       )
2958   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2959               WHERE cust_pkg.custnum = cust_main.custnum
2960                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2961           )
2962 "; }
2963
2964 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2965
2966 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2967 records.  Currently, only I<last> or I<company> may be specified (the
2968 appropriate ship_ field is also searched if applicable).
2969
2970 Additional options are the same as FS::Record::qsearch
2971
2972 =cut
2973
2974 sub fuzzy_search {
2975   my( $self, $fuzzy, $hash, @opt) = @_;
2976   #$self
2977   $hash ||= {};
2978   my @cust_main = ();
2979
2980   check_and_rebuild_fuzzyfiles();
2981   foreach my $field ( keys %$fuzzy ) {
2982     my $sub = \&{"all_$field"};
2983     my %match = ();
2984     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2985
2986     foreach ( keys %match ) {
2987       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
2988       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
2989         if defined dbdef->table('cust_main')->column('ship_last');
2990     }
2991   }
2992
2993   my %saw = ();
2994   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
2995
2996   @cust_main;
2997
2998 }
2999
3000 =back
3001
3002 =head1 SUBROUTINES
3003
3004 =over 4
3005
3006 =item smart_search OPTION => VALUE ...
3007
3008 Accepts the following options: I<search>, the string to search for.  The string
3009 will be searched for as a customer number, last name or company name, first
3010 searching for an exact match then fuzzy and substring matches.
3011
3012 Any additional options treated as an additional qualifier on the search
3013 (i.e. I<agentnum>).
3014
3015 Returns a (possibly empty) array of FS::cust_main objects.
3016
3017 =cut
3018
3019 sub smart_search {
3020   my %options = @_;
3021   my $search = delete $options{'search'};
3022   my @cust_main = ();
3023
3024   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3025
3026     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3027
3028   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3029
3030     my $value = lc($1);
3031     my $q_value = dbh->quote($value);
3032
3033     #exact
3034     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3035     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3036     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3037       if defined dbdef->table('cust_main')->column('ship_last');
3038     $sql .= ' )';
3039
3040     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3041
3042     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3043
3044       #still some false laziness w/ search/cust_main.cgi
3045
3046       #substring
3047       push @cust_main, qsearch( 'cust_main',
3048                                 { 'last'     => { 'op'    => 'ILIKE',
3049                                                   'value' => "%$q_value%" },
3050                                   %options,
3051                                 }
3052                               );
3053       push @cust_main, qsearch( 'cust_main',
3054                                 { 'ship_last' => { 'op'    => 'ILIKE',
3055                                                    'value' => "%$q_value%" },
3056                                   %options,
3057
3058                                 }
3059                               )
3060         if defined dbdef->table('cust_main')->column('ship_last');
3061
3062       push @cust_main, qsearch( 'cust_main',
3063                                 { 'company'  => { 'op'    => 'ILIKE',
3064                                                   'value' => "%$q_value%" },
3065                                   %options,
3066                                 }
3067                               );
3068       push @cust_main, qsearch( 'cust_main',
3069                                 { 'ship_company' => { 'op' => 'ILIKE',
3070                                                    'value' => "%$q_value%" },
3071                                   %options,
3072                                 }
3073                               )
3074         if defined dbdef->table('cust_main')->column('ship_last');
3075
3076       #fuzzy
3077       push @cust_main, FS::cust_main->fuzzy_search(
3078         { 'last'     => $value },
3079         \%options,
3080       );
3081       push @cust_main, FS::cust_main->fuzzy_search(
3082         { 'company'  => $value },
3083         \%options,
3084       );
3085
3086     }
3087
3088   }
3089
3090   @cust_main;
3091
3092 }
3093
3094 =item check_and_rebuild_fuzzyfiles
3095
3096 =cut
3097
3098 sub check_and_rebuild_fuzzyfiles {
3099   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3100   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3101     or &rebuild_fuzzyfiles;
3102 }
3103
3104 =item rebuild_fuzzyfiles
3105
3106 =cut
3107
3108 sub rebuild_fuzzyfiles {
3109
3110   use Fcntl qw(:flock);
3111
3112   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3113
3114   #last
3115
3116   open(LASTLOCK,">>$dir/cust_main.last")
3117     or die "can't open $dir/cust_main.last: $!";
3118   flock(LASTLOCK,LOCK_EX)
3119     or die "can't lock $dir/cust_main.last: $!";
3120
3121   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3122   push @all_last,
3123                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3124     if defined dbdef->table('cust_main')->column('ship_last');
3125
3126   open (LASTCACHE,">$dir/cust_main.last.tmp")
3127     or die "can't open $dir/cust_main.last.tmp: $!";
3128   print LASTCACHE join("\n", @all_last), "\n";
3129   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3130
3131   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3132   close LASTLOCK;
3133
3134   #company
3135
3136   open(COMPANYLOCK,">>$dir/cust_main.company")
3137     or die "can't open $dir/cust_main.company: $!";
3138   flock(COMPANYLOCK,LOCK_EX)
3139     or die "can't lock $dir/cust_main.company: $!";
3140
3141   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3142   push @all_company,
3143        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3144     if defined dbdef->table('cust_main')->column('ship_last');
3145
3146   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3147     or die "can't open $dir/cust_main.company.tmp: $!";
3148   print COMPANYCACHE join("\n", @all_company), "\n";
3149   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3150
3151   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3152   close COMPANYLOCK;
3153
3154 }
3155
3156 =item all_last
3157
3158 =cut
3159
3160 sub all_last {
3161   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3162   open(LASTCACHE,"<$dir/cust_main.last")
3163     or die "can't open $dir/cust_main.last: $!";
3164   my @array = map { chomp; $_; } <LASTCACHE>;
3165   close LASTCACHE;
3166   \@array;
3167 }
3168
3169 =item all_company
3170
3171 =cut
3172
3173 sub all_company {
3174   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3175   open(COMPANYCACHE,"<$dir/cust_main.company")
3176     or die "can't open $dir/cust_main.last: $!";
3177   my @array = map { chomp; $_; } <COMPANYCACHE>;
3178   close COMPANYCACHE;
3179   \@array;
3180 }
3181
3182 =item append_fuzzyfiles LASTNAME COMPANY
3183
3184 =cut
3185
3186 sub append_fuzzyfiles {
3187   my( $last, $company ) = @_;
3188
3189   &check_and_rebuild_fuzzyfiles;
3190
3191   use Fcntl qw(:flock);
3192
3193   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3194
3195   if ( $last ) {
3196
3197     open(LAST,">>$dir/cust_main.last")
3198       or die "can't open $dir/cust_main.last: $!";
3199     flock(LAST,LOCK_EX)
3200       or die "can't lock $dir/cust_main.last: $!";
3201
3202     print LAST "$last\n";
3203
3204     flock(LAST,LOCK_UN)
3205       or die "can't unlock $dir/cust_main.last: $!";
3206     close LAST;
3207   }
3208
3209   if ( $company ) {
3210
3211     open(COMPANY,">>$dir/cust_main.company")
3212       or die "can't open $dir/cust_main.company: $!";
3213     flock(COMPANY,LOCK_EX)
3214       or die "can't lock $dir/cust_main.company: $!";
3215
3216     print COMPANY "$company\n";
3217
3218     flock(COMPANY,LOCK_UN)
3219       or die "can't unlock $dir/cust_main.company: $!";
3220
3221     close COMPANY;
3222   }
3223
3224   1;
3225 }
3226
3227 =item batch_import
3228
3229 =cut
3230
3231 sub batch_import {
3232   my $param = shift;
3233   #warn join('-',keys %$param);
3234   my $fh = $param->{filehandle};
3235   my $agentnum = $param->{agentnum};
3236   my $refnum = $param->{refnum};
3237   my $pkgpart = $param->{pkgpart};
3238   my @fields = @{$param->{fields}};
3239
3240   eval "use Date::Parse;";
3241   die $@ if $@;
3242   eval "use Text::CSV_XS;";
3243   die $@ if $@;
3244
3245   my $csv = new Text::CSV_XS;
3246   #warn $csv;
3247   #warn $fh;
3248
3249   my $imported = 0;
3250   #my $columns;
3251
3252   local $SIG{HUP} = 'IGNORE';
3253   local $SIG{INT} = 'IGNORE';
3254   local $SIG{QUIT} = 'IGNORE';
3255   local $SIG{TERM} = 'IGNORE';
3256   local $SIG{TSTP} = 'IGNORE';
3257   local $SIG{PIPE} = 'IGNORE';
3258
3259   my $oldAutoCommit = $FS::UID::AutoCommit;
3260   local $FS::UID::AutoCommit = 0;
3261   my $dbh = dbh;
3262
3263   #while ( $columns = $csv->getline($fh) ) {
3264   my $line;
3265   while ( defined($line=<$fh>) ) {
3266
3267     $csv->parse($line) or do {
3268       $dbh->rollback if $oldAutoCommit;
3269       return "can't parse: ". $csv->error_input();
3270     };
3271
3272     my @columns = $csv->fields();
3273     #warn join('-',@columns);
3274
3275     my %cust_main = (
3276       agentnum => $agentnum,
3277       refnum   => $refnum,
3278       country  => $conf->config('countrydefault') || 'US',
3279       payby    => 'BILL', #default
3280       paydate  => '12/2037', #default
3281     );
3282     my $billtime = time;
3283     my %cust_pkg = ( pkgpart => $pkgpart );
3284     foreach my $field ( @fields ) {
3285       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3286         #$cust_pkg{$1} = str2time( shift @$columns );
3287         if ( $1 eq 'setup' ) {
3288           $billtime = str2time(shift @columns);
3289         } else {
3290           $cust_pkg{$1} = str2time( shift @columns );
3291         }
3292       } else {
3293         #$cust_main{$field} = shift @$columns;
3294         $cust_main{$field} = shift @columns;
3295       }
3296     }
3297
3298     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3299     my $cust_main = new FS::cust_main ( \%cust_main );
3300     use Tie::RefHash;
3301     tie my %hash, 'Tie::RefHash'; #this part is important
3302     $hash{$cust_pkg} = [] if $pkgpart;
3303     my $error = $cust_main->insert( \%hash );
3304
3305     if ( $error ) {
3306       $dbh->rollback if $oldAutoCommit;
3307       return "can't insert customer for $line: $error";
3308     }
3309
3310     #false laziness w/bill.cgi
3311     $error = $cust_main->bill( 'time' => $billtime );
3312     if ( $error ) {
3313       $dbh->rollback if $oldAutoCommit;
3314       return "can't bill customer for $line: $error";
3315     }
3316
3317     $cust_main->apply_payments;
3318     $cust_main->apply_credits;
3319
3320     $error = $cust_main->collect();
3321     if ( $error ) {
3322       $dbh->rollback if $oldAutoCommit;
3323       return "can't collect customer for $line: $error";
3324     }
3325
3326     $imported++;
3327   }
3328
3329   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3330
3331   return "Empty file!" unless $imported;
3332
3333   ''; #no error
3334
3335 }
3336
3337 =item batch_charge
3338
3339 =cut
3340
3341 sub batch_charge {
3342   my $param = shift;
3343   #warn join('-',keys %$param);
3344   my $fh = $param->{filehandle};
3345   my @fields = @{$param->{fields}};
3346
3347   eval "use Date::Parse;";
3348   die $@ if $@;
3349   eval "use Text::CSV_XS;";
3350   die $@ if $@;
3351
3352   my $csv = new Text::CSV_XS;
3353   #warn $csv;
3354   #warn $fh;
3355
3356   my $imported = 0;
3357   #my $columns;
3358
3359   local $SIG{HUP} = 'IGNORE';
3360   local $SIG{INT} = 'IGNORE';
3361   local $SIG{QUIT} = 'IGNORE';
3362   local $SIG{TERM} = 'IGNORE';
3363   local $SIG{TSTP} = 'IGNORE';
3364   local $SIG{PIPE} = 'IGNORE';
3365
3366   my $oldAutoCommit = $FS::UID::AutoCommit;
3367   local $FS::UID::AutoCommit = 0;
3368   my $dbh = dbh;
3369
3370   #while ( $columns = $csv->getline($fh) ) {
3371   my $line;
3372   while ( defined($line=<$fh>) ) {
3373
3374     $csv->parse($line) or do {
3375       $dbh->rollback if $oldAutoCommit;
3376       return "can't parse: ". $csv->error_input();
3377     };
3378
3379     my @columns = $csv->fields();
3380     #warn join('-',@columns);
3381
3382     my %row = ();
3383     foreach my $field ( @fields ) {
3384       $row{$field} = shift @columns;
3385     }
3386
3387     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3388     unless ( $cust_main ) {
3389       $dbh->rollback if $oldAutoCommit;
3390       return "unknown custnum $row{'custnum'}";
3391     }
3392
3393     if ( $row{'amount'} > 0 ) {
3394       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3395       if ( $error ) {
3396         $dbh->rollback if $oldAutoCommit;
3397         return $error;
3398       }
3399       $imported++;
3400     } elsif ( $row{'amount'} < 0 ) {
3401       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3402                                       $row{'pkg'}                         );
3403       if ( $error ) {
3404         $dbh->rollback if $oldAutoCommit;
3405         return $error;
3406       }
3407       $imported++;
3408     } else {
3409       #hmm?
3410     }
3411
3412   }
3413
3414   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3415
3416   return "Empty file!" unless $imported;
3417
3418   ''; #no error
3419
3420 }
3421
3422 =back
3423
3424 =head1 BUGS
3425
3426 The delete method.
3427
3428 The delete method should possibly take an FS::cust_main object reference
3429 instead of a scalar customer number.
3430
3431 Bill and collect options should probably be passed as references instead of a
3432 list.
3433
3434 There should probably be a configuration file with a list of allowed credit
3435 card types.
3436
3437 No multiple currency support (probably a larger project than just this module).
3438
3439 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3440
3441 =head1 SEE ALSO
3442
3443 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3444 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3445 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3446
3447 =cut
3448
3449 1;
3450