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 && $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 referring_cust_main
2663
2664 Returns the single cust_main record for the customer who referred this customer
2665 (referral_custnum), or false.
2666
2667 =cut
2668
2669 sub referring_cust_main {
2670   my $self = shift;
2671   return '' unless $self->referral_custnum;
2672   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2673 }
2674
2675 =item credit AMOUNT, REASON
2676
2677 Applies a credit to this customer.  If there is an error, returns the error,
2678 otherwise returns false.
2679
2680 =cut
2681
2682 sub credit {
2683   my( $self, $amount, $reason ) = @_;
2684   my $cust_credit = new FS::cust_credit {
2685     'custnum' => $self->custnum,
2686     'amount'  => $amount,
2687     'reason'  => $reason,
2688   };
2689   $cust_credit->insert;
2690 }
2691
2692 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2693
2694 Creates a one-time charge for this customer.  If there is an error, returns
2695 the error, otherwise returns false.
2696
2697 =cut
2698
2699 sub charge {
2700   my ( $self, $amount ) = ( shift, shift );
2701   my $pkg      = @_ ? shift : 'One-time charge';
2702   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2703   my $taxclass = @_ ? shift : '';
2704
2705   local $SIG{HUP} = 'IGNORE';
2706   local $SIG{INT} = 'IGNORE';
2707   local $SIG{QUIT} = 'IGNORE';
2708   local $SIG{TERM} = 'IGNORE';
2709   local $SIG{TSTP} = 'IGNORE';
2710   local $SIG{PIPE} = 'IGNORE';
2711
2712   my $oldAutoCommit = $FS::UID::AutoCommit;
2713   local $FS::UID::AutoCommit = 0;
2714   my $dbh = dbh;
2715
2716   my $part_pkg = new FS::part_pkg ( {
2717     'pkg'      => $pkg,
2718     'comment'  => $comment,
2719     #'setup'    => $amount,
2720     #'recur'    => '0',
2721     'plan'     => 'flat',
2722     'plandata' => "setup_fee=$amount",
2723     'freq'     => 0,
2724     'disabled' => 'Y',
2725     'taxclass' => $taxclass,
2726   } );
2727
2728   my $error = $part_pkg->insert;
2729   if ( $error ) {
2730     $dbh->rollback if $oldAutoCommit;
2731     return $error;
2732   }
2733
2734   my $pkgpart = $part_pkg->pkgpart;
2735   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2736   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2737     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2738     $error = $type_pkgs->insert;
2739     if ( $error ) {
2740       $dbh->rollback if $oldAutoCommit;
2741       return $error;
2742     }
2743   }
2744
2745   my $cust_pkg = new FS::cust_pkg ( {
2746     'custnum' => $self->custnum,
2747     'pkgpart' => $pkgpart,
2748   } );
2749
2750   $error = $cust_pkg->insert;
2751   if ( $error ) {
2752     $dbh->rollback if $oldAutoCommit;
2753     return $error;
2754   }
2755
2756   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2757   '';
2758
2759 }
2760
2761 =item cust_bill
2762
2763 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2764
2765 =cut
2766
2767 sub cust_bill {
2768   my $self = shift;
2769   sort { $a->_date <=> $b->_date }
2770     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2771 }
2772
2773 =item open_cust_bill
2774
2775 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2776 customer.
2777
2778 =cut
2779
2780 sub open_cust_bill {
2781   my $self = shift;
2782   grep { $_->owed > 0 } $self->cust_bill;
2783 }
2784
2785 =item cust_credit
2786
2787 Returns all the credits (see L<FS::cust_credit>) for this customer.
2788
2789 =cut
2790
2791 sub cust_credit {
2792   my $self = shift;
2793   sort { $a->_date <=> $b->_date }
2794     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2795 }
2796
2797 =item cust_pay
2798
2799 Returns all the payments (see L<FS::cust_pay>) for this customer.
2800
2801 =cut
2802
2803 sub cust_pay {
2804   my $self = shift;
2805   sort { $a->_date <=> $b->_date }
2806     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2807 }
2808
2809 =item cust_pay_void
2810
2811 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2812
2813 =cut
2814
2815 sub cust_pay_void {
2816   my $self = shift;
2817   sort { $a->_date <=> $b->_date }
2818     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2819 }
2820
2821
2822 =item cust_refund
2823
2824 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2825
2826 =cut
2827
2828 sub cust_refund {
2829   my $self = shift;
2830   sort { $a->_date <=> $b->_date }
2831     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2832 }
2833
2834 =item select_for_update
2835
2836 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2837 a mutex.
2838
2839 =cut
2840
2841 sub select_for_update {
2842   my $self = shift;
2843   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2844 }
2845
2846 =item name
2847
2848 Returns a name string for this customer, either "Company (Last, First)" or
2849 "Last, First".
2850
2851 =cut
2852
2853 sub name {
2854   my $self = shift;
2855   my $name = $self->get('last'). ', '. $self->first;
2856   $name = $self->company. " ($name)" if $self->company;
2857   $name;
2858 }
2859
2860 =item status
2861
2862 Returns a status string for this customer, currently:
2863
2864 =over 4
2865
2866 =item prospect - No packages have ever been ordered
2867
2868 =item active - One or more recurring packages is active
2869
2870 =item suspended - All non-cancelled recurring packages are suspended
2871
2872 =item cancelled - All recurring packages are cancelled
2873
2874 =back
2875
2876 =cut
2877
2878 sub status {
2879   my $self = shift;
2880   for my $status (qw( prospect active suspended cancelled )) {
2881     my $method = $status.'_sql';
2882     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2883     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2884     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2885     return $status if $sth->fetchrow_arrayref->[0];
2886   }
2887 }
2888
2889 =item statuscolor
2890
2891 Returns a hex triplet color string for this customer's status.
2892
2893 =cut
2894
2895 my %statuscolor = (
2896   'prospect'  => '000000',
2897   'active'    => '00CC00',
2898   'suspended' => 'FF9900',
2899   'cancelled' => 'FF0000',
2900 );
2901 sub statuscolor {
2902   my $self = shift;
2903   $statuscolor{$self->status};
2904 }
2905
2906 =back
2907
2908 =head1 CLASS METHODS
2909
2910 =over 4
2911
2912 =item prospect_sql
2913
2914 Returns an SQL expression identifying prospective cust_main records (customers
2915 with no packages ever ordered)
2916
2917 =cut
2918
2919 sub prospect_sql { "
2920   0 = ( SELECT COUNT(*) FROM cust_pkg
2921           WHERE cust_pkg.custnum = cust_main.custnum
2922       )
2923 "; }
2924
2925 =item active_sql
2926
2927 Returns an SQL expression identifying active cust_main records.
2928
2929 =cut
2930
2931 sub active_sql { "
2932   0 < ( SELECT COUNT(*) FROM cust_pkg
2933           WHERE cust_pkg.custnum = cust_main.custnum
2934             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2935             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2936       )
2937 "; }
2938
2939 =item susp_sql
2940 =item suspended_sql
2941
2942 Returns an SQL expression identifying suspended cust_main records.
2943
2944 =cut
2945
2946 sub suspended_sql { susp_sql(@_); }
2947 sub susp_sql { "
2948     0 < ( SELECT COUNT(*) FROM cust_pkg
2949             WHERE cust_pkg.custnum = cust_main.custnum
2950               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2951         )
2952     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2953                 WHERE cust_pkg.custnum = cust_main.custnum
2954                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2955                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2956             )
2957 "; }
2958
2959 =item cancel_sql
2960 =item cancelled_sql
2961
2962 Returns an SQL expression identifying cancelled cust_main records.
2963
2964 =cut
2965
2966 sub cancelled_sql { cancel_sql(@_); }
2967 sub cancel_sql { "
2968   0 < ( SELECT COUNT(*) FROM cust_pkg
2969           WHERE cust_pkg.custnum = cust_main.custnum
2970       )
2971   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2972               WHERE cust_pkg.custnum = cust_main.custnum
2973                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2974           )
2975 "; }
2976
2977 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2978
2979 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2980 records.  Currently, only I<last> or I<company> may be specified (the
2981 appropriate ship_ field is also searched if applicable).
2982
2983 Additional options are the same as FS::Record::qsearch
2984
2985 =cut
2986
2987 sub fuzzy_search {
2988   my( $self, $fuzzy, $hash, @opt) = @_;
2989   #$self
2990   $hash ||= {};
2991   my @cust_main = ();
2992
2993   check_and_rebuild_fuzzyfiles();
2994   foreach my $field ( keys %$fuzzy ) {
2995     my $sub = \&{"all_$field"};
2996     my %match = ();
2997     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2998
2999     foreach ( keys %match ) {
3000       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
3001       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
3002         if defined dbdef->table('cust_main')->column('ship_last');
3003     }
3004   }
3005
3006   my %saw = ();
3007   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
3008
3009   @cust_main;
3010
3011 }
3012
3013 =back
3014
3015 =head1 SUBROUTINES
3016
3017 =over 4
3018
3019 =item smart_search OPTION => VALUE ...
3020
3021 Accepts the following options: I<search>, the string to search for.  The string
3022 will be searched for as a customer number, last name or company name, first
3023 searching for an exact match then fuzzy and substring matches.
3024
3025 Any additional options treated as an additional qualifier on the search
3026 (i.e. I<agentnum>).
3027
3028 Returns a (possibly empty) array of FS::cust_main objects.
3029
3030 =cut
3031
3032 sub smart_search {
3033   my %options = @_;
3034   my $search = delete $options{'search'};
3035   my @cust_main = ();
3036
3037   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3038
3039     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3040
3041   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3042
3043     my $value = lc($1);
3044     my $q_value = dbh->quote($value);
3045
3046     #exact
3047     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3048     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3049     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3050       if defined dbdef->table('cust_main')->column('ship_last');
3051     $sql .= ' )';
3052
3053     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3054
3055     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3056
3057       #still some false laziness w/ search/cust_main.cgi
3058
3059       #substring
3060       push @cust_main, qsearch( 'cust_main',
3061                                 { 'last'     => { 'op'    => 'ILIKE',
3062                                                   'value' => "%$q_value%" },
3063                                   %options,
3064                                 }
3065                               );
3066       push @cust_main, qsearch( 'cust_main',
3067                                 { 'ship_last' => { 'op'    => 'ILIKE',
3068                                                    'value' => "%$q_value%" },
3069                                   %options,
3070
3071                                 }
3072                               )
3073         if defined dbdef->table('cust_main')->column('ship_last');
3074
3075       push @cust_main, qsearch( 'cust_main',
3076                                 { 'company'  => { 'op'    => 'ILIKE',
3077                                                   'value' => "%$q_value%" },
3078                                   %options,
3079                                 }
3080                               );
3081       push @cust_main, qsearch( 'cust_main',
3082                                 { 'ship_company' => { 'op' => 'ILIKE',
3083                                                    'value' => "%$q_value%" },
3084                                   %options,
3085                                 }
3086                               )
3087         if defined dbdef->table('cust_main')->column('ship_last');
3088
3089       #fuzzy
3090       push @cust_main, FS::cust_main->fuzzy_search(
3091         { 'last'     => $value },
3092         \%options,
3093       );
3094       push @cust_main, FS::cust_main->fuzzy_search(
3095         { 'company'  => $value },
3096         \%options,
3097       );
3098
3099     }
3100
3101   }
3102
3103   @cust_main;
3104
3105 }
3106
3107 =item check_and_rebuild_fuzzyfiles
3108
3109 =cut
3110
3111 sub check_and_rebuild_fuzzyfiles {
3112   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3113   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3114     or &rebuild_fuzzyfiles;
3115 }
3116
3117 =item rebuild_fuzzyfiles
3118
3119 =cut
3120
3121 sub rebuild_fuzzyfiles {
3122
3123   use Fcntl qw(:flock);
3124
3125   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3126
3127   #last
3128
3129   open(LASTLOCK,">>$dir/cust_main.last")
3130     or die "can't open $dir/cust_main.last: $!";
3131   flock(LASTLOCK,LOCK_EX)
3132     or die "can't lock $dir/cust_main.last: $!";
3133
3134   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3135   push @all_last,
3136                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3137     if defined dbdef->table('cust_main')->column('ship_last');
3138
3139   open (LASTCACHE,">$dir/cust_main.last.tmp")
3140     or die "can't open $dir/cust_main.last.tmp: $!";
3141   print LASTCACHE join("\n", @all_last), "\n";
3142   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3143
3144   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3145   close LASTLOCK;
3146
3147   #company
3148
3149   open(COMPANYLOCK,">>$dir/cust_main.company")
3150     or die "can't open $dir/cust_main.company: $!";
3151   flock(COMPANYLOCK,LOCK_EX)
3152     or die "can't lock $dir/cust_main.company: $!";
3153
3154   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3155   push @all_company,
3156        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3157     if defined dbdef->table('cust_main')->column('ship_last');
3158
3159   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3160     or die "can't open $dir/cust_main.company.tmp: $!";
3161   print COMPANYCACHE join("\n", @all_company), "\n";
3162   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3163
3164   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3165   close COMPANYLOCK;
3166
3167 }
3168
3169 =item all_last
3170
3171 =cut
3172
3173 sub all_last {
3174   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3175   open(LASTCACHE,"<$dir/cust_main.last")
3176     or die "can't open $dir/cust_main.last: $!";
3177   my @array = map { chomp; $_; } <LASTCACHE>;
3178   close LASTCACHE;
3179   \@array;
3180 }
3181
3182 =item all_company
3183
3184 =cut
3185
3186 sub all_company {
3187   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3188   open(COMPANYCACHE,"<$dir/cust_main.company")
3189     or die "can't open $dir/cust_main.last: $!";
3190   my @array = map { chomp; $_; } <COMPANYCACHE>;
3191   close COMPANYCACHE;
3192   \@array;
3193 }
3194
3195 =item append_fuzzyfiles LASTNAME COMPANY
3196
3197 =cut
3198
3199 sub append_fuzzyfiles {
3200   my( $last, $company ) = @_;
3201
3202   &check_and_rebuild_fuzzyfiles;
3203
3204   use Fcntl qw(:flock);
3205
3206   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3207
3208   if ( $last ) {
3209
3210     open(LAST,">>$dir/cust_main.last")
3211       or die "can't open $dir/cust_main.last: $!";
3212     flock(LAST,LOCK_EX)
3213       or die "can't lock $dir/cust_main.last: $!";
3214
3215     print LAST "$last\n";
3216
3217     flock(LAST,LOCK_UN)
3218       or die "can't unlock $dir/cust_main.last: $!";
3219     close LAST;
3220   }
3221
3222   if ( $company ) {
3223
3224     open(COMPANY,">>$dir/cust_main.company")
3225       or die "can't open $dir/cust_main.company: $!";
3226     flock(COMPANY,LOCK_EX)
3227       or die "can't lock $dir/cust_main.company: $!";
3228
3229     print COMPANY "$company\n";
3230
3231     flock(COMPANY,LOCK_UN)
3232       or die "can't unlock $dir/cust_main.company: $!";
3233
3234     close COMPANY;
3235   }
3236
3237   1;
3238 }
3239
3240 =item batch_import
3241
3242 =cut
3243
3244 sub batch_import {
3245   my $param = shift;
3246   #warn join('-',keys %$param);
3247   my $fh = $param->{filehandle};
3248   my $agentnum = $param->{agentnum};
3249   my $refnum = $param->{refnum};
3250   my $pkgpart = $param->{pkgpart};
3251   my @fields = @{$param->{fields}};
3252
3253   eval "use Date::Parse;";
3254   die $@ if $@;
3255   eval "use Text::CSV_XS;";
3256   die $@ if $@;
3257
3258   my $csv = new Text::CSV_XS;
3259   #warn $csv;
3260   #warn $fh;
3261
3262   my $imported = 0;
3263   #my $columns;
3264
3265   local $SIG{HUP} = 'IGNORE';
3266   local $SIG{INT} = 'IGNORE';
3267   local $SIG{QUIT} = 'IGNORE';
3268   local $SIG{TERM} = 'IGNORE';
3269   local $SIG{TSTP} = 'IGNORE';
3270   local $SIG{PIPE} = 'IGNORE';
3271
3272   my $oldAutoCommit = $FS::UID::AutoCommit;
3273   local $FS::UID::AutoCommit = 0;
3274   my $dbh = dbh;
3275
3276   #while ( $columns = $csv->getline($fh) ) {
3277   my $line;
3278   while ( defined($line=<$fh>) ) {
3279
3280     $csv->parse($line) or do {
3281       $dbh->rollback if $oldAutoCommit;
3282       return "can't parse: ". $csv->error_input();
3283     };
3284
3285     my @columns = $csv->fields();
3286     #warn join('-',@columns);
3287
3288     my %cust_main = (
3289       agentnum => $agentnum,
3290       refnum   => $refnum,
3291       country  => $conf->config('countrydefault') || 'US',
3292       payby    => 'BILL', #default
3293       paydate  => '12/2037', #default
3294     );
3295     my $billtime = time;
3296     my %cust_pkg = ( pkgpart => $pkgpart );
3297     foreach my $field ( @fields ) {
3298       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3299         #$cust_pkg{$1} = str2time( shift @$columns );
3300         if ( $1 eq 'setup' ) {
3301           $billtime = str2time(shift @columns);
3302         } else {
3303           $cust_pkg{$1} = str2time( shift @columns );
3304         }
3305       } else {
3306         #$cust_main{$field} = shift @$columns;
3307         $cust_main{$field} = shift @columns;
3308       }
3309     }
3310
3311     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3312     my $cust_main = new FS::cust_main ( \%cust_main );
3313     use Tie::RefHash;
3314     tie my %hash, 'Tie::RefHash'; #this part is important
3315     $hash{$cust_pkg} = [] if $pkgpart;
3316     my $error = $cust_main->insert( \%hash );
3317
3318     if ( $error ) {
3319       $dbh->rollback if $oldAutoCommit;
3320       return "can't insert customer for $line: $error";
3321     }
3322
3323     #false laziness w/bill.cgi
3324     $error = $cust_main->bill( 'time' => $billtime );
3325     if ( $error ) {
3326       $dbh->rollback if $oldAutoCommit;
3327       return "can't bill customer for $line: $error";
3328     }
3329
3330     $cust_main->apply_payments;
3331     $cust_main->apply_credits;
3332
3333     $error = $cust_main->collect();
3334     if ( $error ) {
3335       $dbh->rollback if $oldAutoCommit;
3336       return "can't collect customer for $line: $error";
3337     }
3338
3339     $imported++;
3340   }
3341
3342   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3343
3344   return "Empty file!" unless $imported;
3345
3346   ''; #no error
3347
3348 }
3349
3350 =item batch_charge
3351
3352 =cut
3353
3354 sub batch_charge {
3355   my $param = shift;
3356   #warn join('-',keys %$param);
3357   my $fh = $param->{filehandle};
3358   my @fields = @{$param->{fields}};
3359
3360   eval "use Date::Parse;";
3361   die $@ if $@;
3362   eval "use Text::CSV_XS;";
3363   die $@ if $@;
3364
3365   my $csv = new Text::CSV_XS;
3366   #warn $csv;
3367   #warn $fh;
3368
3369   my $imported = 0;
3370   #my $columns;
3371
3372   local $SIG{HUP} = 'IGNORE';
3373   local $SIG{INT} = 'IGNORE';
3374   local $SIG{QUIT} = 'IGNORE';
3375   local $SIG{TERM} = 'IGNORE';
3376   local $SIG{TSTP} = 'IGNORE';
3377   local $SIG{PIPE} = 'IGNORE';
3378
3379   my $oldAutoCommit = $FS::UID::AutoCommit;
3380   local $FS::UID::AutoCommit = 0;
3381   my $dbh = dbh;
3382
3383   #while ( $columns = $csv->getline($fh) ) {
3384   my $line;
3385   while ( defined($line=<$fh>) ) {
3386
3387     $csv->parse($line) or do {
3388       $dbh->rollback if $oldAutoCommit;
3389       return "can't parse: ". $csv->error_input();
3390     };
3391
3392     my @columns = $csv->fields();
3393     #warn join('-',@columns);
3394
3395     my %row = ();
3396     foreach my $field ( @fields ) {
3397       $row{$field} = shift @columns;
3398     }
3399
3400     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3401     unless ( $cust_main ) {
3402       $dbh->rollback if $oldAutoCommit;
3403       return "unknown custnum $row{'custnum'}";
3404     }
3405
3406     if ( $row{'amount'} > 0 ) {
3407       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3408       if ( $error ) {
3409         $dbh->rollback if $oldAutoCommit;
3410         return $error;
3411       }
3412       $imported++;
3413     } elsif ( $row{'amount'} < 0 ) {
3414       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3415                                       $row{'pkg'}                         );
3416       if ( $error ) {
3417         $dbh->rollback if $oldAutoCommit;
3418         return $error;
3419       }
3420       $imported++;
3421     } else {
3422       #hmm?
3423     }
3424
3425   }
3426
3427   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3428
3429   return "Empty file!" unless $imported;
3430
3431   ''; #no error
3432
3433 }
3434
3435 =back
3436
3437 =head1 BUGS
3438
3439 The delete method.
3440
3441 The delete method should possibly take an FS::cust_main object reference
3442 instead of a scalar customer number.
3443
3444 Bill and collect options should probably be passed as references instead of a
3445 list.
3446
3447 There should probably be a configuration file with a list of allowed credit
3448 card types.
3449
3450 No multiple currency support (probably a larger project than just this module).
3451
3452 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3453
3454 =head1 SEE ALSO
3455
3456 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3457 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3458 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3459
3460 =cut
3461
3462 1;
3463