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 unsuspend
1013
1014 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1015 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1016 on success or a list of errors.
1017
1018 =cut
1019
1020 sub unsuspend {
1021   my $self = shift;
1022   grep { $_->unsuspend } $self->suspended_pkgs;
1023 }
1024
1025 =item suspend
1026
1027 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1028 Always returns a list: an empty list on success or a list of errors.
1029
1030 =cut
1031
1032 sub suspend {
1033   my $self = shift;
1034   grep { $_->suspend } $self->unsuspended_pkgs;
1035 }
1036
1037 =item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
1038
1039 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1040 PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list on
1041 success or a list of errors.
1042
1043 =cut
1044
1045 sub suspend_if_pkgpart {
1046   my $self = shift;
1047   my @pkgparts = @_;
1048   grep { $_->suspend }
1049     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1050       $self->unsuspended_pkgs;
1051 }
1052
1053 =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
1054
1055 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1056 listed PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list
1057 on success or a list of errors.
1058
1059 =cut
1060
1061 sub suspend_unless_pkgpart {
1062   my $self = shift;
1063   my @pkgparts = @_;
1064   grep { $_->suspend }
1065     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1066       $self->unsuspended_pkgs;
1067 }
1068
1069 =item cancel [ OPTION => VALUE ... ]
1070
1071 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1072
1073 Available options are: I<quiet>
1074
1075 I<quiet> can be set true to supress email cancellation notices.
1076
1077 Always returns a list: an empty list on success or a list of errors.
1078
1079 =cut
1080
1081 sub cancel {
1082   my $self = shift;
1083   grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
1084 }
1085
1086 =item agent
1087
1088 Returns the agent (see L<FS::agent>) for this customer.
1089
1090 =cut
1091
1092 sub agent {
1093   my $self = shift;
1094   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1095 }
1096
1097 =item bill OPTIONS
1098
1099 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
1100 conjunction with the collect method.
1101
1102 Options are passed as name-value pairs.
1103
1104 Currently available options are:
1105
1106 resetup - if set true, re-charges setup fees.
1107
1108 time - bills the customer as if it were that time.  Specified as a UNIX
1109 timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and
1110 L<Date::Parse> for conversion functions.  For example:
1111
1112  use Date::Parse;
1113  ...
1114  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
1115
1116
1117 If there is an error, returns the error, otherwise returns false.
1118
1119 =cut
1120
1121 sub bill {
1122   my( $self, %options ) = @_;
1123   return '' if $self->payby eq 'COMP';
1124   warn "bill customer ". $self->custnum if $DEBUG;
1125
1126   my $time = $options{'time'} || time;
1127
1128   my $error;
1129
1130   #put below somehow?
1131   local $SIG{HUP} = 'IGNORE';
1132   local $SIG{INT} = 'IGNORE';
1133   local $SIG{QUIT} = 'IGNORE';
1134   local $SIG{TERM} = 'IGNORE';
1135   local $SIG{TSTP} = 'IGNORE';
1136   local $SIG{PIPE} = 'IGNORE';
1137
1138   my $oldAutoCommit = $FS::UID::AutoCommit;
1139   local $FS::UID::AutoCommit = 0;
1140   my $dbh = dbh;
1141
1142   $self->select_for_update; #mutex
1143
1144   # find the packages which are due for billing, find out how much they are
1145   # & generate invoice database.
1146
1147   my( $total_setup, $total_recur ) = ( 0, 0 );
1148   #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
1149   my @cust_bill_pkg = ();
1150   #my $tax = 0;##
1151   #my $taxable_charged = 0;##
1152   #my $charged = 0;##
1153
1154   my %tax;
1155
1156   foreach my $cust_pkg (
1157     qsearch('cust_pkg', { 'custnum' => $self->custnum } )
1158   ) {
1159
1160     #NO!! next if $cust_pkg->cancel;
1161     next if $cust_pkg->getfield('cancel');
1162
1163     warn "  bill package ". $cust_pkg->pkgnum if $DEBUG;
1164
1165     #? to avoid use of uninitialized value errors... ?
1166     $cust_pkg->setfield('bill', '')
1167       unless defined($cust_pkg->bill);
1168
1169     my $part_pkg = $cust_pkg->part_pkg;
1170
1171     my %hash = $cust_pkg->hash;
1172     my $old_cust_pkg = new FS::cust_pkg \%hash;
1173
1174     my @details = ();
1175
1176     # bill setup
1177     my $setup = 0;
1178     if ( !$cust_pkg->setup || $options{'resetup'} ) {
1179
1180       warn "    bill setup" if $DEBUG;
1181
1182       $setup = eval { $cust_pkg->calc_setup( $time ) };
1183       if ( $@ ) {
1184         $dbh->rollback if $oldAutoCommit;
1185         return $@;
1186       }
1187
1188       $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup;
1189     }
1190
1191     #bill recurring fee
1192     my $recur = 0;
1193     my $sdate;
1194     if ( $part_pkg->getfield('freq') ne '0' &&
1195          ! $cust_pkg->getfield('susp') &&
1196          ( $cust_pkg->getfield('bill') || 0 ) <= $time
1197     ) {
1198
1199       warn "    bill recur" if $DEBUG;
1200
1201       # XXX shared with $recur_prog
1202       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1203
1204       $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) };
1205       if ( $@ ) {
1206         $dbh->rollback if $oldAutoCommit;
1207         return $@;
1208       }
1209
1210       #change this bit to use Date::Manip? CAREFUL with timezones (see
1211       # mailing list archive)
1212       my ($sec,$min,$hour,$mday,$mon,$year) =
1213         (localtime($sdate) )[0,1,2,3,4,5];
1214
1215       #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
1216       # only for figuring next bill date, nothing else, so, reset $sdate again
1217       # here
1218       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1219       $cust_pkg->last_bill($sdate)
1220         if $cust_pkg->dbdef_table->column('last_bill');
1221
1222       if ( $part_pkg->freq =~ /^\d+$/ ) {
1223         $mon += $part_pkg->freq;
1224         until ( $mon < 12 ) { $mon -= 12; $year++; }
1225       } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
1226         my $weeks = $1;
1227         $mday += $weeks * 7;
1228       } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
1229         my $days = $1;
1230         $mday += $days;
1231       } else {
1232         $dbh->rollback if $oldAutoCommit;
1233         return "unparsable frequency: ". $part_pkg->freq;
1234       }
1235       $cust_pkg->setfield('bill',
1236         timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
1237     }
1238
1239     warn "\$setup is undefined" unless defined($setup);
1240     warn "\$recur is undefined" unless defined($recur);
1241     warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1242
1243     if ( $cust_pkg->modified ) {
1244
1245       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG;
1246
1247       $error=$cust_pkg->replace($old_cust_pkg);
1248       if ( $error ) { #just in case
1249         $dbh->rollback if $oldAutoCommit;
1250         return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
1251       }
1252
1253       $setup = sprintf( "%.2f", $setup );
1254       $recur = sprintf( "%.2f", $recur );
1255       if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1256         $dbh->rollback if $oldAutoCommit;
1257         return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1258       }
1259       if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1260         $dbh->rollback if $oldAutoCommit;
1261         return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1262       }
1263       if ( $setup != 0 || $recur != 0 ) {
1264         warn "    charges (setup=$setup, recur=$recur); queueing line items\n"
1265           if $DEBUG;
1266         my $cust_bill_pkg = new FS::cust_bill_pkg ({
1267           'pkgnum'  => $cust_pkg->pkgnum,
1268           'setup'   => $setup,
1269           'recur'   => $recur,
1270           'sdate'   => $sdate,
1271           'edate'   => $cust_pkg->bill,
1272           'details' => \@details,
1273         });
1274         push @cust_bill_pkg, $cust_bill_pkg;
1275         $total_setup += $setup;
1276         $total_recur += $recur;
1277
1278         unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
1279
1280           my @taxes = qsearch( 'cust_main_county', {
1281                                  'state'    => $self->state,
1282                                  'county'   => $self->county,
1283                                  'country'  => $self->country,
1284                                  'taxclass' => $part_pkg->taxclass,
1285                                                                       } );
1286           unless ( @taxes ) {
1287             @taxes =  qsearch( 'cust_main_county', {
1288                                   'state'    => $self->state,
1289                                   'county'   => $self->county,
1290                                   'country'  => $self->country,
1291                                   'taxclass' => '',
1292                                                                       } );
1293           }
1294
1295           #one more try at a whole-country tax rate
1296           unless ( @taxes ) {
1297             @taxes =  qsearch( 'cust_main_county', {
1298                                   'state'    => '',
1299                                   'county'   => '',
1300                                   'country'  => $self->country,
1301                                   'taxclass' => '',
1302                                                                       } );
1303           }
1304
1305           # maybe eliminate this entirely, along with all the 0% records
1306           unless ( @taxes ) {
1307             $dbh->rollback if $oldAutoCommit;
1308             return
1309               "fatal: can't find tax rate for state/county/country/taxclass ".
1310               join('/', ( map $self->$_(), qw(state county country) ),
1311                         $part_pkg->taxclass ).  "\n";
1312           }
1313
1314           foreach my $tax ( @taxes ) {
1315
1316             my $taxable_charged = 0;
1317             $taxable_charged += $setup
1318               unless $part_pkg->setuptax =~ /^Y$/i
1319                   || $tax->setuptax =~ /^Y$/i;
1320             $taxable_charged += $recur
1321               unless $part_pkg->recurtax =~ /^Y$/i
1322                   || $tax->recurtax =~ /^Y$/i;
1323             next unless $taxable_charged;
1324
1325             if ( $tax->exempt_amount > 0 ) {
1326               my ($mon,$year) = (localtime($sdate) )[4,5];
1327               $mon++;
1328               my $freq = $part_pkg->freq || 1;
1329               if ( $freq !~ /(\d+)$/ ) {
1330                 $dbh->rollback if $oldAutoCommit;
1331                 return "daily/weekly package definitions not (yet?)".
1332                        " compatible with monthly tax exemptions";
1333               }
1334               my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
1335               foreach my $which_month ( 1 .. $freq ) {
1336                 my %hash = (
1337                   'custnum' => $self->custnum,
1338                   'taxnum'  => $tax->taxnum,
1339                   'year'    => 1900+$year,
1340                   'month'   => $mon++,
1341                 );
1342                 #until ( $mon < 12 ) { $mon -= 12; $year++; }
1343                 until ( $mon < 13 ) { $mon -= 12; $year++; }
1344                 my $cust_tax_exempt =
1345                   qsearchs('cust_tax_exempt', \%hash)
1346                   || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
1347                 my $remaining_exemption = sprintf("%.2f",
1348                   $tax->exempt_amount - $cust_tax_exempt->amount );
1349                 if ( $remaining_exemption > 0 ) {
1350                   my $addl = $remaining_exemption > $taxable_per_month
1351                     ? $taxable_per_month
1352                     : $remaining_exemption;
1353                   $taxable_charged -= $addl;
1354                   my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
1355                     $cust_tax_exempt->hash,
1356                     'amount' =>
1357                       sprintf("%.2f", $cust_tax_exempt->amount + $addl),
1358                   } );
1359                   $error = $new_cust_tax_exempt->exemptnum
1360                     ? $new_cust_tax_exempt->replace($cust_tax_exempt)
1361                     : $new_cust_tax_exempt->insert;
1362                   if ( $error ) {
1363                     $dbh->rollback if $oldAutoCommit;
1364                     return "fatal: can't update cust_tax_exempt: $error";
1365                   }
1366
1367                 } # if $remaining_exemption > 0
1368
1369               } #foreach $which_month
1370
1371             } #if $tax->exempt_amount
1372
1373             $taxable_charged = sprintf( "%.2f", $taxable_charged);
1374
1375             #$tax += $taxable_charged * $cust_main_county->tax / 100
1376             $tax{ $tax->taxname || 'Tax' } +=
1377               $taxable_charged * $tax->tax / 100
1378
1379           } #foreach my $tax ( @taxes )
1380
1381         } #unless $self->tax =~ /Y/i || $self->payby eq 'COMP'
1382
1383       } #if $setup != 0 || $recur != 0
1384
1385     } #if $cust_pkg->modified
1386
1387   } #foreach my $cust_pkg
1388
1389   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
1390 #  my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
1391
1392   unless ( @cust_bill_pkg ) { #don't create invoices with no line items
1393     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1394     return '';
1395   }
1396
1397 #  unless ( $self->tax =~ /Y/i
1398 #           || $self->payby eq 'COMP'
1399 #           || $taxable_charged == 0 ) {
1400 #    my $cust_main_county = qsearchs('cust_main_county',{
1401 #        'state'   => $self->state,
1402 #        'county'  => $self->county,
1403 #        'country' => $self->country,
1404 #    } ) or die "fatal: can't find tax rate for state/county/country ".
1405 #               $self->state. "/". $self->county. "/". $self->country. "\n";
1406 #    my $tax = sprintf( "%.2f",
1407 #      $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
1408 #    );
1409
1410   if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema
1411
1412     foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
1413       my $tax = sprintf("%.2f", $tax{$taxname} );
1414       $charged = sprintf( "%.2f", $charged+$tax );
1415
1416       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1417         'pkgnum'   => 0,
1418         'setup'    => $tax,
1419         'recur'    => 0,
1420         'sdate'    => '',
1421         'edate'    => '',
1422         'itemdesc' => $taxname,
1423       });
1424       push @cust_bill_pkg, $cust_bill_pkg;
1425     }
1426
1427   } else { #1.4 schema
1428
1429     my $tax = 0;
1430     foreach ( values %tax ) { $tax += $_ };
1431     $tax = sprintf("%.2f", $tax);
1432     if ( $tax > 0 ) {
1433       $charged = sprintf( "%.2f", $charged+$tax );
1434
1435       my $cust_bill_pkg = new FS::cust_bill_pkg ({
1436         'pkgnum' => 0,
1437         'setup'  => $tax,
1438         'recur'  => 0,
1439         'sdate'  => '',
1440         'edate'  => '',
1441       });
1442       push @cust_bill_pkg, $cust_bill_pkg;
1443     }
1444
1445   }
1446
1447   my $cust_bill = new FS::cust_bill ( {
1448     'custnum' => $self->custnum,
1449     '_date'   => $time,
1450     'charged' => $charged,
1451   } );
1452   $error = $cust_bill->insert;
1453   if ( $error ) {
1454     $dbh->rollback if $oldAutoCommit;
1455     return "can't create invoice for customer #". $self->custnum. ": $error";
1456   }
1457
1458   my $invnum = $cust_bill->invnum;
1459   my $cust_bill_pkg;
1460   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
1461     #warn $invnum;
1462     $cust_bill_pkg->invnum($invnum);
1463     $error = $cust_bill_pkg->insert;
1464     if ( $error ) {
1465       $dbh->rollback if $oldAutoCommit;
1466       return "can't create invoice line item for customer #". $self->custnum.
1467              ": $error";
1468     }
1469   }
1470
1471   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1472   ''; #no error
1473 }
1474
1475 =item collect OPTIONS
1476
1477 (Attempt to) collect money for this customer's outstanding invoices (see
1478 L<FS::cust_bill>).  Usually used after the bill method.
1479
1480 Depending on the value of `payby', this may print or email an invoice (I<BILL>,
1481 I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
1482 check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
1483
1484 Most actions are now triggered by invoice events; see L<FS::part_bill_event>
1485 and the invoice events web interface.
1486
1487 If there is an error, returns the error, otherwise returns false.
1488
1489 Options are passed as name-value pairs.
1490
1491 Currently available options are:
1492
1493 invoice_time - Use this time when deciding when to print invoices and
1494 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>
1495 for conversion functions.
1496
1497 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
1498 events.
1499
1500 retry_card - Deprecated alias for 'retry'
1501
1502 batch_card - This option is deprecated.  See the invoice events web interface
1503 to control whether cards are batched or run against a realtime gateway.
1504
1505 report_badcard - This option is deprecated.
1506
1507 force_print - This option is deprecated; see the invoice events web interface.
1508
1509 quiet - set true to surpress email card/ACH decline notices.
1510
1511 =cut
1512
1513 sub collect {
1514   my( $self, %options ) = @_;
1515   my $invoice_time = $options{'invoice_time'} || time;
1516
1517   #put below somehow?
1518   local $SIG{HUP} = 'IGNORE';
1519   local $SIG{INT} = 'IGNORE';
1520   local $SIG{QUIT} = 'IGNORE';
1521   local $SIG{TERM} = 'IGNORE';
1522   local $SIG{TSTP} = 'IGNORE';
1523   local $SIG{PIPE} = 'IGNORE';
1524
1525   my $oldAutoCommit = $FS::UID::AutoCommit;
1526   local $FS::UID::AutoCommit = 0;
1527   my $dbh = dbh;
1528
1529   $self->select_for_update; #mutex
1530
1531   my $balance = $self->balance;
1532   warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG;
1533   unless ( $balance > 0 ) { #redundant?????
1534     $dbh->rollback if $oldAutoCommit; #hmm
1535     return '';
1536   }
1537
1538   if ( exists($options{'retry_card'}) ) {
1539     carp 'retry_card option passed to collect is deprecated; use retry';
1540     $options{'retry'} ||= $options{'retry_card'};
1541   }
1542   if ( exists($options{'retry'}) && $options{'retry'} ) {
1543     my $error = $self->retry_realtime;
1544     if ( $error ) {
1545       $dbh->rollback if $oldAutoCommit;
1546       return $error;
1547     }
1548   }
1549
1550   foreach my $cust_bill ( $self->open_cust_bill ) {
1551
1552     # don't try to charge for the same invoice if it's already in a batch
1553     #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
1554
1555     last if $self->balance <= 0;
1556
1557     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
1558       if $DEBUG;
1559
1560     foreach my $part_bill_event (
1561       sort {    $a->seconds   <=> $b->seconds
1562              || $a->weight    <=> $b->weight
1563              || $a->eventpart <=> $b->eventpart }
1564         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
1565                && ! qsearch( 'cust_bill_event', {
1566                                 'invnum'    => $cust_bill->invnum,
1567                                 'eventpart' => $_->eventpart,
1568                                 'status'    => 'done',
1569                                                                    } )
1570              }
1571           qsearch('part_bill_event', { 'payby'    => $self->payby,
1572                                        'disabled' => '',           } )
1573     ) {
1574
1575       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
1576            || $self->balance   <= 0; # or if balance<=0
1577
1578       warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
1579         if $DEBUG;
1580       my $cust_main = $self; #for callback
1581
1582       my $error;
1583       {
1584         local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
1585         $error = eval $part_bill_event->eventcode;
1586       }
1587
1588       my $status = '';
1589       my $statustext = '';
1590       if ( $@ ) {
1591         $status = 'failed';
1592         $statustext = $@;
1593       } elsif ( $error ) {
1594         $status = 'done';
1595         $statustext = $error;
1596       } else {
1597         $status = 'done'
1598       }
1599
1600       #add cust_bill_event
1601       my $cust_bill_event = new FS::cust_bill_event {
1602         'invnum'     => $cust_bill->invnum,
1603         'eventpart'  => $part_bill_event->eventpart,
1604         #'_date'      => $invoice_time,
1605         '_date'      => time,
1606         'status'     => $status,
1607         'statustext' => $statustext,
1608       };
1609       $error = $cust_bill_event->insert;
1610       if ( $error ) {
1611         #$dbh->rollback if $oldAutoCommit;
1612         #return "error: $error";
1613
1614         # gah, even with transactions.
1615         $dbh->commit if $oldAutoCommit; #well.
1616         my $e = 'WARNING: Event run but database not updated - '.
1617                 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
1618                 ', eventpart '. $part_bill_event->eventpart.
1619                 ": $error";
1620         warn $e;
1621         return $e;
1622       }
1623
1624
1625     }
1626
1627   }
1628
1629   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1630   '';
1631
1632 }
1633
1634 =item retry_realtime
1635
1636 Schedules realtime credit card / electronic check / LEC billing events for
1637 for retry.  Useful if card information has changed or manual retry is desired.
1638 The 'collect' method must be called to actually retry the transaction.
1639
1640 Implementation details: For each of this customer's open invoices, changes
1641 the status of the first "done" (with statustext error) realtime processing
1642 event to "failed".
1643
1644 =cut
1645
1646 sub retry_realtime {
1647   my $self = shift;
1648
1649   local $SIG{HUP} = 'IGNORE';
1650   local $SIG{INT} = 'IGNORE';
1651   local $SIG{QUIT} = 'IGNORE';
1652   local $SIG{TERM} = 'IGNORE';
1653   local $SIG{TSTP} = 'IGNORE';
1654   local $SIG{PIPE} = 'IGNORE';
1655
1656   my $oldAutoCommit = $FS::UID::AutoCommit;
1657   local $FS::UID::AutoCommit = 0;
1658   my $dbh = dbh;
1659
1660   foreach my $cust_bill (
1661     grep { $_->cust_bill_event }
1662       $self->open_cust_bill
1663   ) {
1664     my @cust_bill_event =
1665       sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
1666         grep {
1667                #$_->part_bill_event->plan eq 'realtime-card'
1668                $_->part_bill_event->eventcode =~
1669                    /\$cust_bill\->realtime_(card|ach|lec)/
1670                  && $_->status eq 'done'
1671                  && $_->statustext
1672              }
1673           $cust_bill->cust_bill_event;
1674     next unless @cust_bill_event;
1675     my $error = $cust_bill_event[0]->retry;
1676     if ( $error ) {
1677       $dbh->rollback if $oldAutoCommit;
1678       return "error scheduling invoice event for retry: $error";
1679     }
1680
1681   }
1682
1683   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1684   '';
1685
1686 }
1687
1688 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
1689
1690 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
1691 via a Business::OnlinePayment realtime gateway.  See
1692 L<http://420.am/business-onlinepayment> for supported gateways.
1693
1694 Available methods are: I<CC>, I<ECHECK> and I<LEC>
1695
1696 Available options are: I<description>, I<invnum>, I<quiet>
1697
1698 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1699 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1700 if set, will override the value from the customer record.
1701
1702 I<description> is a free-text field passed to the gateway.  It defaults to
1703 "Internet services".
1704
1705 If an I<invnum> is specified, this payment (if sucessful) is applied to the
1706 specified invoice.  If you don't specify an I<invnum> you might want to
1707 call the B<apply_payments> method.
1708
1709 I<quiet> can be set true to surpress email decline notices.
1710
1711 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
1712
1713 =cut
1714
1715 sub realtime_bop {
1716   my( $self, $method, $amount, %options ) = @_;
1717   if ( $DEBUG ) {
1718     warn "$self $method $amount\n";
1719     warn "  $_ => $options{$_}\n" foreach keys %options;
1720   }
1721
1722   $options{'description'} ||= 'Internet services';
1723
1724   #pre-requisites
1725   die "Real-time processing not enabled\n"
1726     unless $conf->exists('business-onlinepayment');
1727   eval "use Business::OnlinePayment";
1728   die $@ if $@;
1729
1730   #load up config
1731   my $bop_config = 'business-onlinepayment';
1732   $bop_config .= '-ach'
1733     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
1734   my ( $processor, $login, $password, $action, @bop_options ) =
1735     $conf->config($bop_config);
1736   $action ||= 'normal authorization';
1737   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1738   die "No real-time processor is enabled - ".
1739       "did you set the business-onlinepayment configuration value?\n"
1740     unless $processor;
1741
1742   #massage data
1743
1744   my $address = exists($options{'address1'})
1745                     ? $options{'address1'}
1746                     : $self->address1;
1747   my $address2 = exists($options{'address2'})
1748                     ? $options{'address2'}
1749                     : $self->address2;
1750   $address .= ", ". $address2 if length($address2);
1751
1752   my $o_payname = exists($options{'payname'})
1753                     ? $options{'payname'}
1754                     : $self->payname;
1755   my($payname, $payfirst, $paylast);
1756   if ( $o_payname && $method ne 'ECHECK' ) {
1757     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1758       or return "Illegal payname $payname";
1759     ($payfirst, $paylast) = ($1, $2);
1760   } else {
1761     $payfirst = $self->getfield('first');
1762     $paylast = $self->getfield('last');
1763     $payname =  "$payfirst $paylast";
1764   }
1765
1766   my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
1767   if ( $conf->exists('emailinvoiceauto')
1768        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1769     push @invoicing_list, $self->all_emails;
1770   }
1771   my $email = $invoicing_list[0];
1772
1773   my $payinfo = exists($options{'payinfo'})
1774                   ? $options{'payinfo'}
1775                   : $self->payinfo;
1776
1777   my %content = ();
1778   if ( $method eq 'CC' ) {
1779
1780     $content{card_number} = $payinfo;
1781     my $paydate = exists($options{'paydate'})
1782                     ? $options{'paydate'}
1783                     : $self->paydate;
1784     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1785     $content{expiration} = "$2/$1";
1786
1787     if ( defined $self->dbdef_table->column('paycvv') ) {
1788       my $paycvv = exists($options{'paycvv'})
1789                      ? $options{'paycvv'}
1790                      : $self->paycvv;
1791       $content{cvv2} = $self->paycvv
1792         if length($paycvv);
1793     }
1794
1795     $content{recurring_billing} = 'YES'
1796       if qsearch('cust_pay', { 'custnum' => $self->custnum,
1797                                'payby'   => 'CARD',
1798                                'payinfo' => $payinfo,
1799                              } );
1800
1801   } elsif ( $method eq 'ECHECK' ) {
1802     ( $content{account_number}, $content{routing_code} ) =
1803       split('@', $payinfo);
1804     $content{bank_name} = $o_payname;
1805     $content{account_type} = 'CHECKING';
1806     $content{account_name} = $payname;
1807     $content{customer_org} = $self->company ? 'B' : 'I';
1808     $content{customer_ssn} = exists($options{'ss'})
1809                                ? $options{'ss'}
1810                                : $self->ss;
1811   } elsif ( $method eq 'LEC' ) {
1812     $content{phone} = $payinfo;
1813   }
1814
1815   #transaction(s)
1816
1817   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
1818
1819   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
1820   $transaction->content(
1821     'type'           => $method,
1822     'login'          => $login,
1823     'password'       => $password,
1824     'action'         => $action1,
1825     'description'    => $options{'description'},
1826     'amount'         => $amount,
1827     'invoice_number' => $options{'invnum'},
1828     'customer_id'    => $self->custnum,
1829     'last_name'      => $paylast,
1830     'first_name'     => $payfirst,
1831     'name'           => $payname,
1832     'address'        => $address,
1833     'city'           => ( exists($options{'city'})
1834                             ? $options{'city'}
1835                             : $self->city          ),
1836     'state'          => ( exists($options{'state'})
1837                             ? $options{'state'}
1838                             : $self->state          ),
1839     'zip'            => ( exists($options{'zip'})
1840                             ? $options{'zip'}
1841                             : $self->zip          ),
1842     'country'        => ( exists($options{'country'})
1843                             ? $options{'country'}
1844                             : $self->country          ),
1845     'referer'        => 'http://cleanwhisker.420.am/',
1846     'email'          => $email,
1847     'phone'          => $self->daytime || $self->night,
1848     %content, #after
1849   );
1850   $transaction->submit();
1851
1852   if ( $transaction->is_success() && $action2 ) {
1853     my $auth = $transaction->authorization;
1854     my $ordernum = $transaction->can('order_number')
1855                    ? $transaction->order_number
1856                    : '';
1857
1858     my $capture =
1859       new Business::OnlinePayment( $processor, @bop_options );
1860
1861     my %capture = (
1862       %content,
1863       type           => $method,
1864       action         => $action2,
1865       login          => $login,
1866       password       => $password,
1867       order_number   => $ordernum,
1868       amount         => $amount,
1869       authorization  => $auth,
1870       description    => $options{'description'},
1871     );
1872
1873     foreach my $field (qw( authorization_source_code returned_ACI                                          transaction_identifier validation_code
1874                            transaction_sequence_num local_transaction_date
1875                            local_transaction_time AVS_result_code          )) {
1876       $capture{$field} = $transaction->$field() if $transaction->can($field);
1877     }
1878
1879     $capture->content( %capture );
1880
1881     $capture->submit();
1882
1883     unless ( $capture->is_success ) {
1884       my $e = "Authorization sucessful but capture failed, custnum #".
1885               $self->custnum. ': '.  $capture->result_code.
1886               ": ". $capture->error_message;
1887       warn $e;
1888       return $e;
1889     }
1890
1891   }
1892
1893   #remove paycvv after initial transaction
1894   #false laziness w/misc/process/payment.cgi - check both to make sure working
1895   # correctly
1896   if ( defined $self->dbdef_table->column('paycvv')
1897        && length($self->paycvv)
1898        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
1899   ) {
1900     my $error = $self->remove_cvv;
1901     if ( $error ) {
1902       warn "error removing cvv: $error\n";
1903     }
1904   }
1905
1906   #result handling
1907   if ( $transaction->is_success() ) {
1908
1909     my %method2payby = (
1910       'CC'     => 'CARD',
1911       'ECHECK' => 'CHEK',
1912       'LEC'    => 'LECB',
1913     );
1914
1915     my $paybatch = "$processor:". $transaction->authorization;
1916     $paybatch .= ':'. $transaction->order_number
1917       if $transaction->can('order_number')
1918       && length($transaction->order_number);
1919
1920     my $cust_pay = new FS::cust_pay ( {
1921        'custnum'  => $self->custnum,
1922        'invnum'   => $options{'invnum'},
1923        'paid'     => $amount,
1924        '_date'     => '',
1925        'payby'    => $method2payby{$method},
1926        'payinfo'  => $payinfo,
1927        'paybatch' => $paybatch,
1928     } );
1929     my $error = $cust_pay->insert;
1930     if ( $error ) {
1931       $cust_pay->invnum(''); #try again with no specific invnum
1932       my $error2 = $cust_pay->insert;
1933       if ( $error2 ) {
1934         # gah, even with transactions.
1935         my $e = 'WARNING: Card/ACH debited but database not updated - '.
1936                 "error inserting payment ($processor): $error2".
1937                 " (previously tried insert with invnum #$options{'invnum'}" .
1938                 ": $error )";
1939         warn $e;
1940         return $e;
1941       }
1942     }
1943     return ''; #no error
1944
1945   } else {
1946
1947     my $perror = "$processor error: ". $transaction->error_message;
1948
1949     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1950          && $conf->exists('emaildecline')
1951          && grep { $_ ne 'POST' } $self->invoicing_list
1952          && ! grep { $transaction->error_message =~ /$_/ }
1953                    $conf->config('emaildecline-exclude')
1954     ) {
1955       my @templ = $conf->config('declinetemplate');
1956       my $template = new Text::Template (
1957         TYPE   => 'ARRAY',
1958         SOURCE => [ map "$_\n", @templ ],
1959       ) or return "($perror) can't create template: $Text::Template::ERROR";
1960       $template->compile()
1961         or return "($perror) can't compile template: $Text::Template::ERROR";
1962
1963       my $templ_hash = { error => $transaction->error_message };
1964
1965       my $error = send_email(
1966         'from'    => $conf->config('invoice_from'),
1967         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
1968         'subject' => 'Your payment could not be processed',
1969         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
1970       );
1971
1972       $perror .= " (also received error sending decline notification: $error)"
1973         if $error;
1974
1975     }
1976
1977     return $perror;
1978   }
1979
1980 }
1981
1982 =item remove_cvv
1983
1984 Removes the I<paycvv> field from the database directly.
1985
1986 If there is an error, returns the error, otherwise returns false.
1987
1988 =cut
1989
1990 sub remove_cvv {
1991   my $self = shift;
1992   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
1993     or return dbh->errstr;
1994   $sth->execute($self->custnum)
1995     or return $sth->errstr;
1996   $self->paycvv('');
1997   '';
1998 }
1999
2000 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
2001
2002 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
2003 via a Business::OnlinePayment realtime gateway.  See
2004 L<http://420.am/business-onlinepayment> for supported gateways.
2005
2006 Available methods are: I<CC>, I<ECHECK> and I<LEC>
2007
2008 Available options are: I<amount>, I<reason>, I<paynum>
2009
2010 Most gateways require a reference to an original payment transaction to refund,
2011 so you probably need to specify a I<paynum>.
2012
2013 I<amount> defaults to the original amount of the payment if not specified.
2014
2015 I<reason> specifies a reason for the refund.
2016
2017 Implementation note: If I<amount> is unspecified or equal to the amount of the
2018 orignal payment, first an attempt is made to "void" the transaction via
2019 the gateway (to cancel a not-yet settled transaction) and then if that fails,
2020 the normal attempt is made to "refund" ("credit") the transaction via the
2021 gateway is attempted.
2022
2023 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
2024 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
2025 #if set, will override the value from the customer record.
2026
2027 #If an I<invnum> is specified, this payment (if sucessful) is applied to the
2028 #specified invoice.  If you don't specify an I<invnum> you might want to
2029 #call the B<apply_payments> method.
2030
2031 =cut
2032
2033 #some false laziness w/realtime_bop, not enough to make it worth merging
2034 #but some useful small subs should be pulled out
2035 sub realtime_refund_bop {
2036   my( $self, $method, %options ) = @_;
2037   if ( $DEBUG ) {
2038     warn "$self $method refund\n";
2039     warn "  $_ => $options{$_}\n" foreach keys %options;
2040   }
2041
2042   #pre-requisites
2043   die "Real-time processing not enabled\n"
2044     unless $conf->exists('business-onlinepayment');
2045   eval "use Business::OnlinePayment";
2046   die $@ if $@;
2047
2048   #load up config
2049   my $bop_config = 'business-onlinepayment';
2050   $bop_config .= '-ach'
2051     if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
2052   my ( $processor, $login, $password, $unused_action, @bop_options ) =
2053     $conf->config($bop_config);
2054   #$action ||= 'normal authorization';
2055   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
2056   die "No real-time processor is enabled - ".
2057       "did you set the business-onlinepayment configuration value?\n"
2058     unless $processor;
2059
2060   my $cust_pay = '';
2061   my $amount = $options{'amount'};
2062   my( $pay_processor, $auth, $order_number ) = ( '', '', '' );
2063   if ( $options{'paynum'} ) {
2064     warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG;
2065     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
2066       or return "Unknown paynum $options{'paynum'}";
2067     $amount ||= $cust_pay->paid;
2068     $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/
2069       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
2070                 $cust_pay->paybatch;
2071     ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 );
2072     return "processor of payment $options{'paynum'} $pay_processor does not".
2073            " match current processor $processor"
2074       unless $pay_processor eq $processor;
2075   }
2076   return "neither amount nor paynum specified" unless $amount;
2077
2078   my %content = (
2079     'type'           => $method,
2080     'login'          => $login,
2081     'password'       => $password,
2082     'order_number'   => $order_number,
2083     'amount'         => $amount,
2084     'referer'        => 'http://cleanwhisker.420.am/',
2085   );
2086   $content{authorization} = $auth
2087     if length($auth); #echeck/ACH transactions have an order # but no auth
2088                       #(at least with authorize.net)
2089
2090   #first try void if applicable
2091   if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates?
2092     my $void = new Business::OnlinePayment( $processor, @bop_options );
2093     $void->content( 'action' => 'void', %content );
2094     $void->submit();
2095     if ( $void->is_success ) {
2096       my $error = $cust_pay->void($options{'reason'});
2097       if ( $error ) {
2098         # gah, even with transactions.
2099         my $e = 'WARNING: Card/ACH voided but database not updated - '.
2100                 "error voiding payment: $error";
2101         warn $e;
2102         return $e;
2103       }
2104       return '';
2105     }
2106   }
2107
2108   #massage data
2109   my $address = $self->address1;
2110   $address .= ", ". $self->address2 if $self->address2;
2111
2112   my($payname, $payfirst, $paylast);
2113   if ( $self->payname && $method ne 'ECHECK' ) {
2114     $payname = $self->payname;
2115     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
2116       or return "Illegal payname $payname";
2117     ($payfirst, $paylast) = ($1, $2);
2118   } else {
2119     $payfirst = $self->getfield('first');
2120     $paylast = $self->getfield('last');
2121     $payname =  "$payfirst $paylast";
2122   }
2123
2124   if ( $method eq 'CC' ) {
2125
2126     $content{card_number} = $self->payinfo;
2127     $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2128     $content{expiration} = "$2/$1";
2129
2130     #$content{cvv2} = $self->paycvv
2131     #  if defined $self->dbdef_table->column('paycvv')
2132     #     && length($self->paycvv);
2133
2134     #$content{recurring_billing} = 'YES'
2135     #  if qsearch('cust_pay', { 'custnum' => $self->custnum,
2136     #                           'payby'   => 'CARD',
2137     #                           'payinfo' => $self->payinfo, } );
2138
2139   } elsif ( $method eq 'ECHECK' ) {
2140     ( $content{account_number}, $content{routing_code} ) =
2141       split('@', $self->payinfo);
2142     $content{bank_name} = $self->payname;
2143     $content{account_type} = 'CHECKING';
2144     $content{account_name} = $payname;
2145     $content{customer_org} = $self->company ? 'B' : 'I';
2146     $content{customer_ssn} = $self->ss;
2147   } elsif ( $method eq 'LEC' ) {
2148     $content{phone} = $self->payinfo;
2149   }
2150
2151   #then try refund
2152   my $refund = new Business::OnlinePayment( $processor, @bop_options );
2153   $refund->content(
2154     'action'         => 'credit',
2155     'customer_id'    => $self->custnum,
2156     'last_name'      => $paylast,
2157     'first_name'     => $payfirst,
2158     'name'           => $payname,
2159     'address'        => $address,
2160     'city'           => $self->city,
2161     'state'          => $self->state,
2162     'zip'            => $self->zip,
2163     'country'        => $self->country,
2164     %content, #after
2165   );
2166   $refund->submit();
2167
2168   return "$processor error: ". $refund->error_message
2169     unless $refund->is_success();
2170
2171   my %method2payby = (
2172     'CC'     => 'CARD',
2173     'ECHECK' => 'CHEK',
2174     'LEC'    => 'LECB',
2175   );
2176
2177   my $paybatch = "$processor:". $refund->authorization;
2178   $paybatch .= ':'. $refund->order_number
2179     if $refund->can('order_number') && $refund->order_number;
2180
2181   while ( $cust_pay && $cust_pay->unappled < $amount ) {
2182     my @cust_bill_pay = $cust_pay->cust_bill_pay;
2183     last unless @cust_bill_pay;
2184     my $cust_bill_pay = pop @cust_bill_pay;
2185     my $error = $cust_bill_pay->delete;
2186     last if $error;
2187   }
2188
2189   my $cust_refund = new FS::cust_refund ( {
2190     'custnum'  => $self->custnum,
2191     'paynum'   => $options{'paynum'},
2192     'refund'   => $amount,
2193     '_date'    => '',
2194     'payby'    => $method2payby{$method},
2195     'payinfo'  => $self->payinfo,
2196     'paybatch' => $paybatch,
2197     'reason'   => $options{'reason'} || 'card or ACH refund',
2198   } );
2199   my $error = $cust_refund->insert;
2200   if ( $error ) {
2201     $cust_refund->paynum(''); #try again with no specific paynum
2202     my $error2 = $cust_refund->insert;
2203     if ( $error2 ) {
2204       # gah, even with transactions.
2205       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
2206               "error inserting refund ($processor): $error2".
2207               " (previously tried insert with paynum #$options{'paynum'}" .
2208               ": $error )";
2209       warn $e;
2210       return $e;
2211     }
2212   }
2213
2214   ''; #no error
2215
2216 }
2217
2218 =item total_owed
2219
2220 Returns the total owed for this customer on all invoices
2221 (see L<FS::cust_bill/owed>).
2222
2223 =cut
2224
2225 sub total_owed {
2226   my $self = shift;
2227   $self->total_owed_date(2145859200); #12/31/2037
2228 }
2229
2230 =item total_owed_date TIME
2231
2232 Returns the total owed for this customer on all invoices with date earlier than
2233 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2234 see L<Time::Local> and L<Date::Parse> for conversion functions.
2235
2236 =cut
2237
2238 sub total_owed_date {
2239   my $self = shift;
2240   my $time = shift;
2241   my $total_bill = 0;
2242   foreach my $cust_bill (
2243     grep { $_->_date <= $time }
2244       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2245   ) {
2246     $total_bill += $cust_bill->owed;
2247   }
2248   sprintf( "%.2f", $total_bill );
2249 }
2250
2251 =item apply_credits OPTION => VALUE ...
2252
2253 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2254 to outstanding invoice balances in chronological order (or reverse
2255 chronological order if the I<order> option is set to B<newest>) and returns the
2256 value of any remaining unapplied credits available for refund (see
2257 L<FS::cust_refund>).
2258
2259 =cut
2260
2261 sub apply_credits {
2262   my $self = shift;
2263   my %opt = @_;
2264
2265   return 0 unless $self->total_credited;
2266
2267   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2268       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2269
2270   my @invoices = $self->open_cust_bill;
2271   @invoices = sort { $b->_date <=> $a->_date } @invoices
2272     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2273
2274   my $credit;
2275   foreach my $cust_bill ( @invoices ) {
2276     my $amount;
2277
2278     if ( !defined($credit) || $credit->credited == 0) {
2279       $credit = pop @credits or last;
2280     }
2281
2282     if ($cust_bill->owed >= $credit->credited) {
2283       $amount=$credit->credited;
2284     }else{
2285       $amount=$cust_bill->owed;
2286     }
2287
2288     my $cust_credit_bill = new FS::cust_credit_bill ( {
2289       'crednum' => $credit->crednum,
2290       'invnum'  => $cust_bill->invnum,
2291       'amount'  => $amount,
2292     } );
2293     my $error = $cust_credit_bill->insert;
2294     die $error if $error;
2295
2296     redo if ($cust_bill->owed > 0);
2297
2298   }
2299
2300   return $self->total_credited;
2301 }
2302
2303 =item apply_payments
2304
2305 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2306 to outstanding invoice balances in chronological order.
2307
2308  #and returns the value of any remaining unapplied payments.
2309
2310 =cut
2311
2312 sub apply_payments {
2313   my $self = shift;
2314
2315   #return 0 unless
2316
2317   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
2318       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
2319
2320   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
2321       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
2322
2323   my $payment;
2324
2325   foreach my $cust_bill ( @invoices ) {
2326     my $amount;
2327
2328     if ( !defined($payment) || $payment->unapplied == 0 ) {
2329       $payment = pop @payments or last;
2330     }
2331
2332     if ( $cust_bill->owed >= $payment->unapplied ) {
2333       $amount = $payment->unapplied;
2334     } else {
2335       $amount = $cust_bill->owed;
2336     }
2337
2338     my $cust_bill_pay = new FS::cust_bill_pay ( {
2339       'paynum' => $payment->paynum,
2340       'invnum' => $cust_bill->invnum,
2341       'amount' => $amount,
2342     } );
2343     my $error = $cust_bill_pay->insert;
2344     die $error if $error;
2345
2346     redo if ( $cust_bill->owed > 0);
2347
2348   }
2349
2350   return $self->total_unapplied_payments;
2351 }
2352
2353 =item total_credited
2354
2355 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2356 customer.  See L<FS::cust_credit/credited>.
2357
2358 =cut
2359
2360 sub total_credited {
2361   my $self = shift;
2362   my $total_credit = 0;
2363   foreach my $cust_credit ( qsearch('cust_credit', {
2364     'custnum' => $self->custnum,
2365   } ) ) {
2366     $total_credit += $cust_credit->credited;
2367   }
2368   sprintf( "%.2f", $total_credit );
2369 }
2370
2371 =item total_unapplied_payments
2372
2373 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2374 See L<FS::cust_pay/unapplied>.
2375
2376 =cut
2377
2378 sub total_unapplied_payments {
2379   my $self = shift;
2380   my $total_unapplied = 0;
2381   foreach my $cust_pay ( qsearch('cust_pay', {
2382     'custnum' => $self->custnum,
2383   } ) ) {
2384     $total_unapplied += $cust_pay->unapplied;
2385   }
2386   sprintf( "%.2f", $total_unapplied );
2387 }
2388
2389 =item balance
2390
2391 Returns the balance for this customer (total_owed minus total_credited
2392 minus total_unapplied_payments).
2393
2394 =cut
2395
2396 sub balance {
2397   my $self = shift;
2398   sprintf( "%.2f",
2399     $self->total_owed - $self->total_credited - $self->total_unapplied_payments
2400   );
2401 }
2402
2403 =item balance_date TIME
2404
2405 Returns the balance for this customer, only considering invoices with date
2406 earlier than TIME (total_owed_date minus total_credited minus
2407 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2408 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2409 functions.
2410
2411 =cut
2412
2413 sub balance_date {
2414   my $self = shift;
2415   my $time = shift;
2416   sprintf( "%.2f",
2417     $self->total_owed_date($time)
2418       - $self->total_credited
2419       - $self->total_unapplied_payments
2420   );
2421 }
2422
2423 =item paydate_monthyear
2424
2425 Returns a two-element list consisting of the month and year of this customer's
2426 paydate (credit card expiration date for CARD customers)
2427
2428 =cut
2429
2430 sub paydate_monthyear {
2431   my $self = shift;
2432   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2433     ( $2, $1 );
2434   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2435     ( $1, $3 );
2436   } else {
2437     ('', '');
2438   }
2439 }
2440
2441 =item payinfo_masked
2442
2443 Returns a "masked" payinfo field with all but the last four characters replaced
2444 by 'x'es.  Useful for displaying credit cards.
2445
2446 =cut
2447
2448 sub payinfo_masked {
2449   my $self = shift;
2450   my $payinfo = $self->payinfo;
2451   'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
2452 }
2453
2454 =item invoicing_list [ ARRAYREF ]
2455
2456 If an arguement is given, sets these email addresses as invoice recipients
2457 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2458 (except as warnings), so use check_invoicing_list first.
2459
2460 Returns a list of email addresses (with svcnum entries expanded).
2461
2462 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2463 check it without disturbing anything by passing nothing.
2464
2465 This interface may change in the future.
2466
2467 =cut
2468
2469 sub invoicing_list {
2470   my( $self, $arrayref ) = @_;
2471   if ( $arrayref ) {
2472     my @cust_main_invoice;
2473     if ( $self->custnum ) {
2474       @cust_main_invoice =
2475         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2476     } else {
2477       @cust_main_invoice = ();
2478     }
2479     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2480       #warn $cust_main_invoice->destnum;
2481       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2482         #warn $cust_main_invoice->destnum;
2483         my $error = $cust_main_invoice->delete;
2484         warn $error if $error;
2485       }
2486     }
2487     if ( $self->custnum ) {
2488       @cust_main_invoice =
2489         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2490     } else {
2491       @cust_main_invoice = ();
2492     }
2493     my %seen = map { $_->address => 1 } @cust_main_invoice;
2494     foreach my $address ( @{$arrayref} ) {
2495       next if exists $seen{$address} && $seen{$address};
2496       $seen{$address} = 1;
2497       my $cust_main_invoice = new FS::cust_main_invoice ( {
2498         'custnum' => $self->custnum,
2499         'dest'    => $address,
2500       } );
2501       my $error = $cust_main_invoice->insert;
2502       warn $error if $error;
2503     }
2504   }
2505   if ( $self->custnum ) {
2506     map { $_->address }
2507       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2508   } else {
2509     ();
2510   }
2511 }
2512
2513 =item check_invoicing_list ARRAYREF
2514
2515 Checks these arguements as valid input for the invoicing_list method.  If there
2516 is an error, returns the error, otherwise returns false.
2517
2518 =cut
2519
2520 sub check_invoicing_list {
2521   my( $self, $arrayref ) = @_;
2522   foreach my $address ( @{$arrayref} ) {
2523     my $cust_main_invoice = new FS::cust_main_invoice ( {
2524       'custnum' => $self->custnum,
2525       'dest'    => $address,
2526     } );
2527     my $error = $self->custnum
2528                 ? $cust_main_invoice->check
2529                 : $cust_main_invoice->checkdest
2530     ;
2531     return $error if $error;
2532   }
2533   '';
2534 }
2535
2536 =item set_default_invoicing_list
2537
2538 Sets the invoicing list to all accounts associated with this customer,
2539 overwriting any previous invoicing list.
2540
2541 =cut
2542
2543 sub set_default_invoicing_list {
2544   my $self = shift;
2545   $self->invoicing_list($self->all_emails);
2546 }
2547
2548 =item all_emails
2549
2550 Returns the email addresses of all accounts provisioned for this customer.
2551
2552 =cut
2553
2554 sub all_emails {
2555   my $self = shift;
2556   my %list;
2557   foreach my $cust_pkg ( $self->all_pkgs ) {
2558     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2559     my @svc_acct =
2560       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2561         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2562           @cust_svc;
2563     $list{$_}=1 foreach map { $_->email } @svc_acct;
2564   }
2565   keys %list;
2566 }
2567
2568 =item invoicing_list_addpost
2569
2570 Adds postal invoicing to this customer.  If this customer is already configured
2571 to receive postal invoices, does nothing.
2572
2573 =cut
2574
2575 sub invoicing_list_addpost {
2576   my $self = shift;
2577   return if grep { $_ eq 'POST' } $self->invoicing_list;
2578   my @invoicing_list = $self->invoicing_list;
2579   push @invoicing_list, 'POST';
2580   $self->invoicing_list(\@invoicing_list);
2581 }
2582
2583 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2584
2585 Returns an array of customers referred by this customer (referral_custnum set
2586 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2587 customers referred by customers referred by this customer and so on, inclusive.
2588 The default behavior is DEPTH 1 (no recursion).
2589
2590 =cut
2591
2592 sub referral_cust_main {
2593   my $self = shift;
2594   my $depth = @_ ? shift : 1;
2595   my $exclude = @_ ? shift : {};
2596
2597   my @cust_main =
2598     map { $exclude->{$_->custnum}++; $_; }
2599       grep { ! $exclude->{ $_->custnum } }
2600         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2601
2602   if ( $depth > 1 ) {
2603     push @cust_main,
2604       map { $_->referral_cust_main($depth-1, $exclude) }
2605         @cust_main;
2606   }
2607
2608   @cust_main;
2609 }
2610
2611 =item referral_cust_main_ncancelled
2612
2613 Same as referral_cust_main, except only returns customers with uncancelled
2614 packages.
2615
2616 =cut
2617
2618 sub referral_cust_main_ncancelled {
2619   my $self = shift;
2620   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2621 }
2622
2623 =item referral_cust_pkg [ DEPTH ]
2624
2625 Like referral_cust_main, except returns a flat list of all unsuspended (and
2626 uncancelled) packages for each customer.  The number of items in this list may
2627 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2628
2629 =cut
2630
2631 sub referral_cust_pkg {
2632   my $self = shift;
2633   my $depth = @_ ? shift : 1;
2634
2635   map { $_->unsuspended_pkgs }
2636     grep { $_->unsuspended_pkgs }
2637       $self->referral_cust_main($depth);
2638 }
2639
2640 =item credit AMOUNT, REASON
2641
2642 Applies a credit to this customer.  If there is an error, returns the error,
2643 otherwise returns false.
2644
2645 =cut
2646
2647 sub credit {
2648   my( $self, $amount, $reason ) = @_;
2649   my $cust_credit = new FS::cust_credit {
2650     'custnum' => $self->custnum,
2651     'amount'  => $amount,
2652     'reason'  => $reason,
2653   };
2654   $cust_credit->insert;
2655 }
2656
2657 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
2658
2659 Creates a one-time charge for this customer.  If there is an error, returns
2660 the error, otherwise returns false.
2661
2662 =cut
2663
2664 sub charge {
2665   my ( $self, $amount ) = ( shift, shift );
2666   my $pkg      = @_ ? shift : 'One-time charge';
2667   my $comment  = @_ ? shift : '$'. sprintf("%.2f",$amount);
2668   my $taxclass = @_ ? shift : '';
2669
2670   local $SIG{HUP} = 'IGNORE';
2671   local $SIG{INT} = 'IGNORE';
2672   local $SIG{QUIT} = 'IGNORE';
2673   local $SIG{TERM} = 'IGNORE';
2674   local $SIG{TSTP} = 'IGNORE';
2675   local $SIG{PIPE} = 'IGNORE';
2676
2677   my $oldAutoCommit = $FS::UID::AutoCommit;
2678   local $FS::UID::AutoCommit = 0;
2679   my $dbh = dbh;
2680
2681   my $part_pkg = new FS::part_pkg ( {
2682     'pkg'      => $pkg,
2683     'comment'  => $comment,
2684     #'setup'    => $amount,
2685     #'recur'    => '0',
2686     'plan'     => 'flat',
2687     'plandata' => "setup_fee=$amount",
2688     'freq'     => 0,
2689     'disabled' => 'Y',
2690     'taxclass' => $taxclass,
2691   } );
2692
2693   my $error = $part_pkg->insert;
2694   if ( $error ) {
2695     $dbh->rollback if $oldAutoCommit;
2696     return $error;
2697   }
2698
2699   my $pkgpart = $part_pkg->pkgpart;
2700   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
2701   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
2702     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
2703     $error = $type_pkgs->insert;
2704     if ( $error ) {
2705       $dbh->rollback if $oldAutoCommit;
2706       return $error;
2707     }
2708   }
2709
2710   my $cust_pkg = new FS::cust_pkg ( {
2711     'custnum' => $self->custnum,
2712     'pkgpart' => $pkgpart,
2713   } );
2714
2715   $error = $cust_pkg->insert;
2716   if ( $error ) {
2717     $dbh->rollback if $oldAutoCommit;
2718     return $error;
2719   }
2720
2721   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2722   '';
2723
2724 }
2725
2726 =item cust_bill
2727
2728 Returns all the invoices (see L<FS::cust_bill>) for this customer.
2729
2730 =cut
2731
2732 sub cust_bill {
2733   my $self = shift;
2734   sort { $a->_date <=> $b->_date }
2735     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2736 }
2737
2738 =item open_cust_bill
2739
2740 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
2741 customer.
2742
2743 =cut
2744
2745 sub open_cust_bill {
2746   my $self = shift;
2747   grep { $_->owed > 0 } $self->cust_bill;
2748 }
2749
2750 =item cust_credit
2751
2752 Returns all the credits (see L<FS::cust_credit>) for this customer.
2753
2754 =cut
2755
2756 sub cust_credit {
2757   my $self = shift;
2758   sort { $a->_date <=> $b->_date }
2759     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
2760 }
2761
2762 =item cust_pay
2763
2764 Returns all the payments (see L<FS::cust_pay>) for this customer.
2765
2766 =cut
2767
2768 sub cust_pay {
2769   my $self = shift;
2770   sort { $a->_date <=> $b->_date }
2771     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
2772 }
2773
2774 =item cust_pay_void
2775
2776 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
2777
2778 =cut
2779
2780 sub cust_pay_void {
2781   my $self = shift;
2782   sort { $a->_date <=> $b->_date }
2783     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
2784 }
2785
2786
2787 =item cust_refund
2788
2789 Returns all the refunds (see L<FS::cust_refund>) for this customer.
2790
2791 =cut
2792
2793 sub cust_refund {
2794   my $self = shift;
2795   sort { $a->_date <=> $b->_date }
2796     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
2797 }
2798
2799 =item select_for_update
2800
2801 Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
2802 a mutex.
2803
2804 =cut
2805
2806 sub select_for_update {
2807   my $self = shift;
2808   qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
2809 }
2810
2811 =item name
2812
2813 Returns a name string for this customer, either "Company (Last, First)" or
2814 "Last, First".
2815
2816 =cut
2817
2818 sub name {
2819   my $self = shift;
2820   my $name = $self->get('last'). ', '. $self->first;
2821   $name = $self->company. " ($name)" if $self->company;
2822   $name;
2823 }
2824
2825 =item status
2826
2827 Returns a status string for this customer, currently:
2828
2829 =over 4
2830
2831 =item prospect - No packages have ever been ordered
2832
2833 =item active - One or more recurring packages is active
2834
2835 =item suspended - All non-cancelled recurring packages are suspended
2836
2837 =item cancelled - All recurring packages are cancelled
2838
2839 =back
2840
2841 =cut
2842
2843 sub status {
2844   my $self = shift;
2845   for my $status (qw( prospect active suspended cancelled )) {
2846     my $method = $status.'_sql';
2847     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
2848     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
2849     $sth->execute( ($self->custnum) x $numnum ) or die $sth->errstr;
2850     return $status if $sth->fetchrow_arrayref->[0];
2851   }
2852 }
2853
2854 =item statuscolor
2855
2856 Returns a hex triplet color string for this customer's status.
2857
2858 =cut
2859
2860 my %statuscolor = (
2861   'prospect'  => '000000',
2862   'active'    => '00CC00',
2863   'suspended' => 'FF9900',
2864   'cancelled' => 'FF0000',
2865 );
2866 sub statuscolor {
2867   my $self = shift;
2868   $statuscolor{$self->status};
2869 }
2870
2871 =back
2872
2873 =head1 CLASS METHODS
2874
2875 =over 4
2876
2877 =item prospect_sql
2878
2879 Returns an SQL expression identifying prospective cust_main records (customers
2880 with no packages ever ordered)
2881
2882 =cut
2883
2884 sub prospect_sql { "
2885   0 = ( SELECT COUNT(*) FROM cust_pkg
2886           WHERE cust_pkg.custnum = cust_main.custnum
2887       )
2888 "; }
2889
2890 =item active_sql
2891
2892 Returns an SQL expression identifying active cust_main records.
2893
2894 =cut
2895
2896 sub active_sql { "
2897   0 < ( SELECT COUNT(*) FROM cust_pkg
2898           WHERE cust_pkg.custnum = cust_main.custnum
2899             AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2900             AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
2901       )
2902 "; }
2903
2904 =item susp_sql
2905 =item suspended_sql
2906
2907 Returns an SQL expression identifying suspended cust_main records.
2908
2909 =cut
2910
2911 sub suspended_sql { susp_sql(@_); }
2912 sub susp_sql { "
2913     0 < ( SELECT COUNT(*) FROM cust_pkg
2914             WHERE cust_pkg.custnum = cust_main.custnum
2915               AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2916         )
2917     AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2918                 WHERE cust_pkg.custnum = cust_main.custnum
2919                   AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2920                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2921             )
2922 "; }
2923
2924 =item cancel_sql
2925 =item cancelled_sql
2926
2927 Returns an SQL expression identifying cancelled cust_main records.
2928
2929 =cut
2930
2931 sub cancelled_sql { cancel_sql(@_); }
2932 sub cancel_sql { "
2933   0 < ( SELECT COUNT(*) FROM cust_pkg
2934           WHERE cust_pkg.custnum = cust_main.custnum
2935       )
2936   AND 0 = ( SELECT COUNT(*) FROM cust_pkg
2937               WHERE cust_pkg.custnum = cust_main.custnum
2938                 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2939           )
2940 "; }
2941
2942 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
2943
2944 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
2945 records.  Currently, only I<last> or I<company> may be specified (the
2946 appropriate ship_ field is also searched if applicable).
2947
2948 Additional options are the same as FS::Record::qsearch
2949
2950 =cut
2951
2952 sub fuzzy_search {
2953   my( $self, $fuzzy, $hash, @opt) = @_;
2954   #$self
2955   $hash ||= {};
2956   my @cust_main = ();
2957
2958   check_and_rebuild_fuzzyfiles();
2959   foreach my $field ( keys %$fuzzy ) {
2960     my $sub = \&{"all_$field"};
2961     my %match = ();
2962     $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
2963
2964     foreach ( keys %match ) {
2965       push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
2966       push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt)
2967         if defined dbdef->table('cust_main')->column('ship_last');
2968     }
2969   }
2970
2971   my %saw = ();
2972   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
2973
2974   @cust_main;
2975
2976 }
2977
2978 =back
2979
2980 =head1 SUBROUTINES
2981
2982 =over 4
2983
2984 =item smart_search OPTION => VALUE ...
2985
2986 Accepts the following options: I<search>, the string to search for.  The string
2987 will be searched for as a customer number, last name or company name, first
2988 searching for an exact match then fuzzy and substring matches.
2989
2990 Any additional options treated as an additional qualifier on the search
2991 (i.e. I<agentnum>).
2992
2993 Returns a (possibly empty) array of FS::cust_main objects.
2994
2995 =cut
2996
2997 sub smart_search {
2998   my %options = @_;
2999   my $search = delete $options{'search'};
3000   my @cust_main = ();
3001
3002   if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search
3003
3004     push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } );
3005
3006   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search
3007
3008     my $value = lc($1);
3009     my $q_value = dbh->quote($value);
3010
3011     #exact
3012     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
3013     $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value";
3014     $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value"
3015       if defined dbdef->table('cust_main')->column('ship_last');
3016     $sql .= ' )';
3017
3018     push @cust_main, qsearch( 'cust_main', \%options, '', $sql );
3019
3020     unless ( @cust_main ) {  #no exact match, trying substring/fuzzy
3021
3022       #still some false laziness w/ search/cust_main.cgi
3023
3024       #substring
3025       push @cust_main, qsearch( 'cust_main',
3026                                 { 'last'     => { 'op'    => 'ILIKE',
3027                                                   'value' => "%$q_value%" },
3028                                   %options,
3029                                 }
3030                               );
3031       push @cust_main, qsearch( 'cust_main',
3032                                 { 'ship_last' => { 'op'    => 'ILIKE',
3033                                                    'value' => "%$q_value%" },
3034                                   %options,
3035
3036                                 }
3037                               )
3038         if defined dbdef->table('cust_main')->column('ship_last');
3039
3040       push @cust_main, qsearch( 'cust_main',
3041                                 { 'company'  => { 'op'    => 'ILIKE',
3042                                                   'value' => "%$q_value%" },
3043                                   %options,
3044                                 }
3045                               );
3046       push @cust_main, qsearch( 'cust_main',
3047                                 { 'ship_company' => { 'op' => 'ILIKE',
3048                                                    'value' => "%$q_value%" },
3049                                   %options,
3050                                 }
3051                               )
3052         if defined dbdef->table('cust_main')->column('ship_last');
3053
3054       #fuzzy
3055       push @cust_main, FS::cust_main->fuzzy_search(
3056         { 'last'     => $value },
3057         \%options,
3058       );
3059       push @cust_main, FS::cust_main->fuzzy_search(
3060         { 'company'  => $value },
3061         \%options,
3062       );
3063
3064     }
3065
3066   }
3067
3068   @cust_main;
3069
3070 }
3071
3072 =item check_and_rebuild_fuzzyfiles
3073
3074 =cut
3075
3076 sub check_and_rebuild_fuzzyfiles {
3077   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3078   -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
3079     or &rebuild_fuzzyfiles;
3080 }
3081
3082 =item rebuild_fuzzyfiles
3083
3084 =cut
3085
3086 sub rebuild_fuzzyfiles {
3087
3088   use Fcntl qw(:flock);
3089
3090   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3091
3092   #last
3093
3094   open(LASTLOCK,">>$dir/cust_main.last")
3095     or die "can't open $dir/cust_main.last: $!";
3096   flock(LASTLOCK,LOCK_EX)
3097     or die "can't lock $dir/cust_main.last: $!";
3098
3099   my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
3100   push @all_last,
3101                  grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
3102     if defined dbdef->table('cust_main')->column('ship_last');
3103
3104   open (LASTCACHE,">$dir/cust_main.last.tmp")
3105     or die "can't open $dir/cust_main.last.tmp: $!";
3106   print LASTCACHE join("\n", @all_last), "\n";
3107   close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
3108
3109   rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
3110   close LASTLOCK;
3111
3112   #company
3113
3114   open(COMPANYLOCK,">>$dir/cust_main.company")
3115     or die "can't open $dir/cust_main.company: $!";
3116   flock(COMPANYLOCK,LOCK_EX)
3117     or die "can't lock $dir/cust_main.company: $!";
3118
3119   my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
3120   push @all_company,
3121        grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
3122     if defined dbdef->table('cust_main')->column('ship_last');
3123
3124   open (COMPANYCACHE,">$dir/cust_main.company.tmp")
3125     or die "can't open $dir/cust_main.company.tmp: $!";
3126   print COMPANYCACHE join("\n", @all_company), "\n";
3127   close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
3128
3129   rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
3130   close COMPANYLOCK;
3131
3132 }
3133
3134 =item all_last
3135
3136 =cut
3137
3138 sub all_last {
3139   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3140   open(LASTCACHE,"<$dir/cust_main.last")
3141     or die "can't open $dir/cust_main.last: $!";
3142   my @array = map { chomp; $_; } <LASTCACHE>;
3143   close LASTCACHE;
3144   \@array;
3145 }
3146
3147 =item all_company
3148
3149 =cut
3150
3151 sub all_company {
3152   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3153   open(COMPANYCACHE,"<$dir/cust_main.company")
3154     or die "can't open $dir/cust_main.last: $!";
3155   my @array = map { chomp; $_; } <COMPANYCACHE>;
3156   close COMPANYCACHE;
3157   \@array;
3158 }
3159
3160 =item append_fuzzyfiles LASTNAME COMPANY
3161
3162 =cut
3163
3164 sub append_fuzzyfiles {
3165   my( $last, $company ) = @_;
3166
3167   &check_and_rebuild_fuzzyfiles;
3168
3169   use Fcntl qw(:flock);
3170
3171   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
3172
3173   if ( $last ) {
3174
3175     open(LAST,">>$dir/cust_main.last")
3176       or die "can't open $dir/cust_main.last: $!";
3177     flock(LAST,LOCK_EX)
3178       or die "can't lock $dir/cust_main.last: $!";
3179
3180     print LAST "$last\n";
3181
3182     flock(LAST,LOCK_UN)
3183       or die "can't unlock $dir/cust_main.last: $!";
3184     close LAST;
3185   }
3186
3187   if ( $company ) {
3188
3189     open(COMPANY,">>$dir/cust_main.company")
3190       or die "can't open $dir/cust_main.company: $!";
3191     flock(COMPANY,LOCK_EX)
3192       or die "can't lock $dir/cust_main.company: $!";
3193
3194     print COMPANY "$company\n";
3195
3196     flock(COMPANY,LOCK_UN)
3197       or die "can't unlock $dir/cust_main.company: $!";
3198
3199     close COMPANY;
3200   }
3201
3202   1;
3203 }
3204
3205 =item batch_import
3206
3207 =cut
3208
3209 sub batch_import {
3210   my $param = shift;
3211   #warn join('-',keys %$param);
3212   my $fh = $param->{filehandle};
3213   my $agentnum = $param->{agentnum};
3214   my $refnum = $param->{refnum};
3215   my $pkgpart = $param->{pkgpart};
3216   my @fields = @{$param->{fields}};
3217
3218   eval "use Date::Parse;";
3219   die $@ if $@;
3220   eval "use Text::CSV_XS;";
3221   die $@ if $@;
3222
3223   my $csv = new Text::CSV_XS;
3224   #warn $csv;
3225   #warn $fh;
3226
3227   my $imported = 0;
3228   #my $columns;
3229
3230   local $SIG{HUP} = 'IGNORE';
3231   local $SIG{INT} = 'IGNORE';
3232   local $SIG{QUIT} = 'IGNORE';
3233   local $SIG{TERM} = 'IGNORE';
3234   local $SIG{TSTP} = 'IGNORE';
3235   local $SIG{PIPE} = 'IGNORE';
3236
3237   my $oldAutoCommit = $FS::UID::AutoCommit;
3238   local $FS::UID::AutoCommit = 0;
3239   my $dbh = dbh;
3240
3241   #while ( $columns = $csv->getline($fh) ) {
3242   my $line;
3243   while ( defined($line=<$fh>) ) {
3244
3245     $csv->parse($line) or do {
3246       $dbh->rollback if $oldAutoCommit;
3247       return "can't parse: ". $csv->error_input();
3248     };
3249
3250     my @columns = $csv->fields();
3251     #warn join('-',@columns);
3252
3253     my %cust_main = (
3254       agentnum => $agentnum,
3255       refnum   => $refnum,
3256       country  => $conf->config('countrydefault') || 'US',
3257       payby    => 'BILL', #default
3258       paydate  => '12/2037', #default
3259     );
3260     my $billtime = time;
3261     my %cust_pkg = ( pkgpart => $pkgpart );
3262     foreach my $field ( @fields ) {
3263       if ( $field =~ /^cust_pkg\.(setup|bill|susp|expire|cancel)$/ ) {
3264         #$cust_pkg{$1} = str2time( shift @$columns );
3265         if ( $1 eq 'setup' ) {
3266           $billtime = str2time(shift @columns);
3267         } else {
3268           $cust_pkg{$1} = str2time( shift @columns );
3269         }
3270       } else {
3271         #$cust_main{$field} = shift @$columns;
3272         $cust_main{$field} = shift @columns;
3273       }
3274     }
3275
3276     my $cust_pkg = new FS::cust_pkg ( \%cust_pkg ) if $pkgpart;
3277     my $cust_main = new FS::cust_main ( \%cust_main );
3278     use Tie::RefHash;
3279     tie my %hash, 'Tie::RefHash'; #this part is important
3280     $hash{$cust_pkg} = [] if $pkgpart;
3281     my $error = $cust_main->insert( \%hash );
3282
3283     if ( $error ) {
3284       $dbh->rollback if $oldAutoCommit;
3285       return "can't insert customer for $line: $error";
3286     }
3287
3288     #false laziness w/bill.cgi
3289     $error = $cust_main->bill( 'time' => $billtime );
3290     if ( $error ) {
3291       $dbh->rollback if $oldAutoCommit;
3292       return "can't bill customer for $line: $error";
3293     }
3294
3295     $cust_main->apply_payments;
3296     $cust_main->apply_credits;
3297
3298     $error = $cust_main->collect();
3299     if ( $error ) {
3300       $dbh->rollback if $oldAutoCommit;
3301       return "can't collect customer for $line: $error";
3302     }
3303
3304     $imported++;
3305   }
3306
3307   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3308
3309   return "Empty file!" unless $imported;
3310
3311   ''; #no error
3312
3313 }
3314
3315 =item batch_charge
3316
3317 =cut
3318
3319 sub batch_charge {
3320   my $param = shift;
3321   #warn join('-',keys %$param);
3322   my $fh = $param->{filehandle};
3323   my @fields = @{$param->{fields}};
3324
3325   eval "use Date::Parse;";
3326   die $@ if $@;
3327   eval "use Text::CSV_XS;";
3328   die $@ if $@;
3329
3330   my $csv = new Text::CSV_XS;
3331   #warn $csv;
3332   #warn $fh;
3333
3334   my $imported = 0;
3335   #my $columns;
3336
3337   local $SIG{HUP} = 'IGNORE';
3338   local $SIG{INT} = 'IGNORE';
3339   local $SIG{QUIT} = 'IGNORE';
3340   local $SIG{TERM} = 'IGNORE';
3341   local $SIG{TSTP} = 'IGNORE';
3342   local $SIG{PIPE} = 'IGNORE';
3343
3344   my $oldAutoCommit = $FS::UID::AutoCommit;
3345   local $FS::UID::AutoCommit = 0;
3346   my $dbh = dbh;
3347
3348   #while ( $columns = $csv->getline($fh) ) {
3349   my $line;
3350   while ( defined($line=<$fh>) ) {
3351
3352     $csv->parse($line) or do {
3353       $dbh->rollback if $oldAutoCommit;
3354       return "can't parse: ". $csv->error_input();
3355     };
3356
3357     my @columns = $csv->fields();
3358     #warn join('-',@columns);
3359
3360     my %row = ();
3361     foreach my $field ( @fields ) {
3362       $row{$field} = shift @columns;
3363     }
3364
3365     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
3366     unless ( $cust_main ) {
3367       $dbh->rollback if $oldAutoCommit;
3368       return "unknown custnum $row{'custnum'}";
3369     }
3370
3371     if ( $row{'amount'} > 0 ) {
3372       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
3373       if ( $error ) {
3374         $dbh->rollback if $oldAutoCommit;
3375         return $error;
3376       }
3377       $imported++;
3378     } elsif ( $row{'amount'} < 0 ) {
3379       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
3380                                       $row{'pkg'}                         );
3381       if ( $error ) {
3382         $dbh->rollback if $oldAutoCommit;
3383         return $error;
3384       }
3385       $imported++;
3386     } else {
3387       #hmm?
3388     }
3389
3390   }
3391
3392   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3393
3394   return "Empty file!" unless $imported;
3395
3396   ''; #no error
3397
3398 }
3399
3400 =back
3401
3402 =head1 BUGS
3403
3404 The delete method.
3405
3406 The delete method should possibly take an FS::cust_main object reference
3407 instead of a scalar customer number.
3408
3409 Bill and collect options should probably be passed as references instead of a
3410 list.
3411
3412 There should probably be a configuration file with a list of allowed credit
3413 card types.
3414
3415 No multiple currency support (probably a larger project than just this module).
3416
3417 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
3418
3419 =head1 SEE ALSO
3420
3421 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
3422 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
3423 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
3424
3425 =cut
3426
3427 1;
3428