FS/FS/cust_pay.pm

   1 package FS::cust_pay;
   2
   3 use strict;
   4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
   5              FS::reason_Mixin FS::Record);
   6 use vars qw( $DEBUG $me $conf @encrypted_fields
   7              $unsuspendauto $ignore_noapply
   8            );
   9 use Date::Format;
  10 use Business::CreditCard;
  11 use Text::Template;
  12 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
  13 use FS::Record qw( dbh qsearch qsearchs );
  14 use FS::UID qw( driver_name );
  15 use FS::CurrentUser;
  16 use FS::payby;
  17 use FS::cust_main_Mixin;
  18 use FS::payinfo_transaction_Mixin;
  19 use FS::cust_bill;
  20 use FS::cust_bill_pay;
  21 use FS::cust_pay_refund;
  22 use FS::cust_main;
  23 use FS::cust_pkg;
  24 use FS::cust_pay_void;
  25 use FS::upgrade_journal;
  26 use FS::Cursor;
  27 use FS::reason;
  28 use FS::reason_type;
  29
  30 $DEBUG = 0;
  31
  32 $me = '[FS::cust_pay]';
  33
  34 $ignore_noapply = 0;
  35
  36 #ask FS::UID to run this stuff for us later
  37 FS::UID->install_callback( sub {
  38   $conf = new FS::Conf;
  39   $unsuspendauto = $conf->exists('unsuspendauto');
  40 } );
  41
  42 @encrypted_fields = ('payinfo');
  43 sub nohistory_fields { ('payinfo'); }
  44
  45 =head1 NAME
  46
  47 FS::cust_pay - Object methods for cust_pay objects
  48
  49 =head1 SYNOPSIS
  50
  51   use FS::cust_pay;
  52
  53   $record = new FS::cust_pay \%hash;
  54   $record = new FS::cust_pay { 'column' => 'value' };
  55
  56   $error = $record->insert;
  57
  58   $error = $new_record->replace($old_record);
  59
  60   $error = $record->delete;
  61
  62   $error = $record->check;
  63
  64 =head1 DESCRIPTION
  65
  66 An FS::cust_pay object represents a payment; the transfer of money from a
  67 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  68 currently supported:
  69
  70 =over 4
  71
  72 =item paynum
  73
  74 primary key (assigned automatically for new payments)
  75
  76 =item custnum
  77
  78 customer (see L<FS::cust_main>)
  79
  80 =item _date
  81
  82 specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  83 L<Time::Local> and L<Date::Parse> for conversion functions.
  84
  85 =item paid
  86
  87 Amount of this payment
  88
  89 =item usernum
  90
  91 order taker (see L<FS::access_user>)
  92
  93 =item payby
  94
  95 Payment Type (See L<FS::payinfo_Mixin> for valid values)
  96
  97 =item payinfo
  98
  99 Payment Information (See L<FS::payinfo_Mixin> for data format)
 100
 101 =item paymask
 102
 103 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 104
 105 =item paybatch
 106
 107 obsolete text field for tracking card processing or other batch grouping
 108
 109 =item payunique
 110
 111 Optional unique identifer to prevent duplicate transactions.
 112
 113 =item closed
 114
 115 books closed flag, empty or `Y'
 116
 117 =item pkgnum
 118
 119 Desired pkgnum when using experimental package balances.
 120
 121 =item no_auto_apply
 122
 123 Flag to only allow manual application of payment, empty or 'Y'
 124
 125 =item bank
 126
 127 The bank where the payment was deposited.
 128
 129 =item depositor
 130
 131 The name of the depositor.
 132
 133 =item account
 134
 135 The deposit account number.
 136
 137 =item teller
 138
 139 The teller number.
 140
 141 =item batchnum
 142
 143 The number of the batch this payment came from (see L<FS::pay_batch>),
 144 or null if it was processed through a realtime gateway or entered manually.
 145
 146 =item gatewaynum
 147
 148 The number of the realtime or batch gateway L<FS::payment_gateway>) this
 149 payment was processed through.  Null if it was entered manually or processed
 150 by the "system default" gateway, which doesn't have a number.
 151
 152 =item processor
 153
 154 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
 155 or ::OnlineThirdPartyPayment subclass) used for this payment.  Slightly
 156 redundant with C<gatewaynum>.
 157
 158 =item auth
 159
 160 The authorization number returned by the credit card network.
 161
 162 =item order_number
 163
 164 The transaction ID returned by the gateway, if any.  This is usually what
 165 you would use to initiate a void or refund of the payment.
 166
 167 =back
 168
 169 =head1 METHODS
 170
 171 =over 4
 172
 173 =item new HASHREF
 174
 175 Creates a new payment.  To add the payment to the databse, see L<"insert">.
 176
 177 =cut
 178
 179 sub table { 'cust_pay'; }
 180 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
 181 sub cust_unlinked_msg {
 182   my $self = shift;
 183   "WARNING: can't find cust_main.custnum ". $self->custnum.
 184   ' (cust_pay.paynum '. $self->paynum. ')';
 185 }
 186
 187 =item insert [ OPTION => VALUE ... ]
 188
 189 Adds this payment to the database.
 190
 191 For backwards-compatibility and convenience, if the additional field invnum
 192 is defined, an FS::cust_bill_pay record for the full amount of the payment
 193 will be created.  In this case, custnum is optional.
 194
 195 If the additional field discount_term is defined then a prepayment discount
 196 is taken for that length of time.  It is an error for the customer to owe
 197 after this payment is made.
 198
 199 A hash of optional arguments may be passed.  The following arguments are
 200 supported:
 201
 202 =over 4
 203
 204 =item manual
 205
 206 If true, a payment receipt is sent instead of a statement when
 207 'payment_receipt_email' configuration option is set.
 208
 209 About the "manual" flag: Normally, if the 'payment_receipt' config option
 210 is set, and the customer has an invoice email address, inserting a payment
 211 causes a I<statement> to be emailed to the customer.  If the payment is
 212 considered "manual" (or if the customer has no invoices), then it will
 213 instead send a I<payment receipt>.  "manual" should be true whenever a
 214 payment is created directly from the web interface, from a user-initiated
 215 realtime payment, or from a third-party payment via self-service.  It should
 216 be I<false> when creating a payment from a billing event or from a batch.
 217
 218 =item noemail
 219
 220 Don't send an email receipt.  (Note: does not currently work when
 221 payment_receipt-trigger is set to something other than default / cust_bill)
 222
 223 =back
 224
 225 =cut
 226
 227 sub insert {
 228   my($self, %options) = @_;
 229
 230   local $SIG{HUP} = 'IGNORE';
 231   local $SIG{INT} = 'IGNORE';
 232   local $SIG{QUIT} = 'IGNORE';
 233   local $SIG{TERM} = 'IGNORE';
 234   local $SIG{TSTP} = 'IGNORE';
 235   local $SIG{PIPE} = 'IGNORE';
 236
 237   my $oldAutoCommit = $FS::UID::AutoCommit;
 238   local $FS::UID::AutoCommit = 0;
 239   my $dbh = dbh;
 240
 241   my $cust_bill;
 242   if ( $self->invnum ) {
 243     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 244       or do {
 245         $dbh->rollback if $oldAutoCommit;
 246         return "Unknown cust_bill.invnum: ". $self->invnum;
 247       };
 248     if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
 249       $dbh->rollback if $oldAutoCommit;
 250       return "Invoice custnum ".$cust_bill->custnum
 251         ." does not match specified custnum ".$self->custnum
 252         ." for invoice ".$self->invnum;
 253     }
 254     $self->custnum($cust_bill->custnum );
 255   }
 256
 257   my $error = $self->check;
 258   return $error if $error;
 259
 260   my $cust_main = $self->cust_main;
 261   my $old_balance = $cust_main->balance;
 262
 263   $error = $self->SUPER::insert;
 264   if ( $error ) {
 265     $dbh->rollback if $oldAutoCommit;
 266     return "error inserting cust_pay: $error";
 267   }
 268
 269   if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
 270     if ( my $months = $self->discount_term ) {
 271       # XXX this should be moved out somewhere, but discount_term_values
 272       # doesn't fit right
 273       my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
 274       return "can't accept prepayment for an unbilled customer" if !$cust_bill;
 275
 276       # %billing_pkgs contains this customer's active monthly packages.
 277       # Recurring fees for those packages will be credited and then rebilled
 278       # for the full discount term.  Other packages on the last invoice
 279       # (canceled, non-monthly recurring, or one-time charges) will be
 280       # left as they are.
 281       my %billing_pkgs = map { $_->pkgnum => $_ }
 282                          grep { $_->part_pkg->freq eq '1' }
 283                          $cust_main->billing_pkgs;
 284       my $credit = 0; # sum of recurring charges from that invoice
 285       my $last_bill_date = 0; # the real bill date
 286       foreach my $item ( $cust_bill->cust_bill_pkg ) {
 287         next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
 288         $credit += $item->recur;
 289         $last_bill_date = $item->cust_pkg->last_bill
 290           if defined($item->cust_pkg)
 291             and $item->cust_pkg->last_bill > $last_bill_date
 292       }
 293
 294       my $cust_credit = new FS::cust_credit {
 295         'custnum' => $self->custnum,
 296         'amount'  => sprintf('%.2f', $credit),
 297         'reason'  => 'customer chose to prepay for discount',
 298       };
 299       $error = $cust_credit->insert('reason_type' => $credit_type);
 300       if ( $error ) {
 301         $dbh->rollback if $oldAutoCommit;
 302         return "error inserting prepayment credit: $error";
 303       }
 304       # don't apply it yet
 305
 306       # bill for the entire term
 307       $_->bill($_->last_bill) foreach (values %billing_pkgs);
 308       $error = $cust_main->bill(
 309         # no recurring_only, we want unbilled packages with start dates to
 310         # get billed
 311         'no_usage_reset' => 1,
 312         'time'           => $last_bill_date, # not $cust_bill->_date
 313         'pkg_list'       => [ values %billing_pkgs ],
 314         'freq_override'  => $months,
 315       );
 316       if ( $error ) {
 317         $dbh->rollback if $oldAutoCommit;
 318         return "error inserting cust_pay: $error";
 319       }
 320       $error = $cust_main->apply_payments_and_credits;
 321       if ( $error ) {
 322         $dbh->rollback if $oldAutoCommit;
 323         return "error inserting cust_pay: $error";
 324       }
 325       my $new_balance = $cust_main->balance;
 326       if ($new_balance > 0) {
 327         $dbh->rollback if $oldAutoCommit;
 328         return "balance after prepay discount attempt: $new_balance";
 329       }
 330       # user friendly: override the "apply only to this invoice" mode
 331       $self->invnum('');
 332
 333     }
 334
 335   }
 336
 337   if ( $self->invnum ) {
 338     my $cust_bill_pay = new FS::cust_bill_pay {
 339       'invnum' => $self->invnum,
 340       'paynum' => $self->paynum,
 341       'amount' => $self->paid,
 342       '_date'  => $self->_date,
 343     };
 344     $error = $cust_bill_pay->insert(%options);
 345     if ( $error ) {
 346       if ( $ignore_noapply ) {
 347         warn "warning: error inserting cust_bill_pay: $error ".
 348              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
 349       } else {
 350         $dbh->rollback if $oldAutoCommit;
 351         return "error inserting cust_bill_pay: $error";
 352       }
 353     }
 354   }
 355
 356   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 357
 358   #false laziness w/ cust_credit::insert
 359   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 360     my @errors = $cust_main->unsuspend;
 361     #return
 362     # side-fx with nested transactions?  upstack rolls back?
 363     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 364          join(' / ', @errors)
 365       if @errors;
 366   }
 367   #eslaf
 368
 369   #bill setup fees for voip_cdr bill_every_call packages
 370   #some false laziness w/search in freeside-cdrd
 371   my $addl_from =
 372     'LEFT JOIN part_pkg USING ( pkgpart ) '.
 373     "LEFT JOIN part_pkg_option
 374        ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
 375             AND part_pkg_option.optionname = 'bill_every_call' )";
 376
 377   my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
 378                   " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
 379
 380   my @cust_pkg = qsearch({
 381     'table'     => 'cust_pkg',
 382     'addl_from' => $addl_from,
 383     'hashref'   => { 'custnum' => $self->custnum,
 384                      'susp'    => '',
 385                      'cancel'  => '',
 386                    },
 387     'extra_sql' => $extra_sql,
 388   });
 389
 390   if ( @cust_pkg ) {
 391     warn "voip_cdr bill_every_call packages found; billing customer\n";
 392     my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
 393     if ( $bill_error ) {
 394       warn "WARNING: Error billing customer: $bill_error\n";
 395     }
 396   }
 397   #end of billing setup fees for voip_cdr bill_every_call packages
 398
 399   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 400
 401   #payment receipt
 402   my $trigger = $conf->config('payment_receipt-trigger',
 403                               $self->cust_main->agentnum) || 'cust_pay';
 404   if ( $trigger eq 'cust_pay' ) {
 405     my $error = $self->send_receipt(
 406       'manual'    => $options{'manual'},
 407       'noemail'   => $options{'noemail'},
 408       'cust_bill' => $cust_bill,
 409       'cust_main' => $cust_main,
 410     );
 411     warn "can't send payment receipt/statement: $error" if $error;
 412   }
 413
 414   #run payment events immediately
 415   my $due_cust_event = $self->cust_main->due_cust_event(
 416     'eventtable'  => 'cust_pay',
 417     'objects'     => [ $self ],
 418   );
 419   if ( !ref($due_cust_event) ) {
 420     warn "Error searching for cust_pay billing events: $due_cust_event\n";
 421   } else {
 422     foreach my $cust_event (@$due_cust_event) {
 423       next unless $cust_event->test_conditions;
 424       if ( my $error = $cust_event->do_event() ) {
 425         warn "Error running cust_pay billing event: $error\n";
 426       }
 427     }
 428   }
 429
 430   '';
 431
 432 }
 433
 434 =item void [ REASON ]
 435
 436 Voids this payment: deletes the payment and all associated applications and
 437 adds a record of the voided payment to the FS::cust_pay_void table.
 438
 439 =cut
 440
 441 sub void {
 442   my $self = shift;
 443   my $reason = shift;
 444
 445   unless (ref($reason) || !$reason) {
 446     $reason = FS::reason->new_or_existing(
 447       'class'  => 'X',
 448       'type'   => 'Void payment',
 449       'reason' => $reason
 450     );
 451   }
 452
 453   local $SIG{HUP} = 'IGNORE';
 454   local $SIG{INT} = 'IGNORE';
 455   local $SIG{QUIT} = 'IGNORE';
 456   local $SIG{TERM} = 'IGNORE';
 457   local $SIG{TSTP} = 'IGNORE';
 458   local $SIG{PIPE} = 'IGNORE';
 459
 460   my $oldAutoCommit = $FS::UID::AutoCommit;
 461   local $FS::UID::AutoCommit = 0;
 462   my $dbh = dbh;
 463
 464   my $cust_pay_void = new FS::cust_pay_void ( {
 465     map { $_ => $self->get($_) } $self->fields
 466   } );
 467   $cust_pay_void->reasonnum($reason->reasonnum) if $reason;
 468   my $error = $cust_pay_void->insert;
 469
 470   my $cust_pay_pending =
 471     qsearchs('cust_pay_pending', { paynum => $self->paynum });
 472   if ( $cust_pay_pending ) {
 473     $cust_pay_pending->set('void_paynum', $self->paynum);
 474     $cust_pay_pending->set('paynum', '');
 475     $error ||= $cust_pay_pending->replace;
 476   }
 477
 478   $error ||= $self->delete;
 479
 480   if ( $error ) {
 481     $dbh->rollback if $oldAutoCommit;
 482     return $error;
 483   }
 484
 485   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 486
 487   '';
 488
 489 }
 490
 491 =item delete
 492
 493 Unless the closed flag is set, deletes this payment and all associated
 494 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 495 cases, you want to use the void method instead to leave a record of the
 496 deleted payment.
 497
 498 =cut
 499
 500 # very similar to FS::cust_credit::delete
 501 sub delete {
 502   my $self = shift;
 503   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 504
 505   local $SIG{HUP} = 'IGNORE';
 506   local $SIG{INT} = 'IGNORE';
 507   local $SIG{QUIT} = 'IGNORE';
 508   local $SIG{TERM} = 'IGNORE';
 509   local $SIG{TSTP} = 'IGNORE';
 510   local $SIG{PIPE} = 'IGNORE';
 511
 512   my $oldAutoCommit = $FS::UID::AutoCommit;
 513   local $FS::UID::AutoCommit = 0;
 514   my $dbh = dbh;
 515
 516   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 517     my $error = $app->delete;
 518     if ( $error ) {
 519       $dbh->rollback if $oldAutoCommit;
 520       return $error;
 521     }
 522   }
 523
 524   my $error = $self->SUPER::delete(@_);
 525   if ( $error ) {
 526     $dbh->rollback if $oldAutoCommit;
 527     return $error;
 528   }
 529
 530   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 531
 532   '';
 533
 534 }
 535
 536 =item replace [ OLD_RECORD ]
 537
 538 You can, but probably shouldn't modify payments...
 539
 540 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
 541 supplied, replaces this record.  If there is an error, returns the error,
 542 otherwise returns false.
 543
 544 =cut
 545
 546 sub replace {
 547   my $self = shift;
 548   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 549   $self->SUPER::replace(@_);
 550 }
 551
 552 =item check
 553
 554 Checks all fields to make sure this is a valid payment.  If there is an error,
 555 returns the error, otherwise returns false.  Called by the insert method.
 556
 557 =cut
 558
 559 sub check {
 560   my $self = shift;
 561
 562   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 563
 564   my $error =
 565     $self->ut_numbern('paynum')
 566     || $self->ut_numbern('custnum')
 567     || $self->ut_numbern('_date')
 568     || $self->ut_money('paid')
 569     || $self->ut_alphan('otaker')
 570     || $self->ut_textn('paybatch')
 571     || $self->ut_textn('payunique')
 572     || $self->ut_enum('closed', [ '', 'Y' ])
 573     || $self->ut_flag('no_auto_apply')
 574     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
 575     || $self->ut_textn('bank')
 576     || $self->ut_alphan('depositor')
 577     || $self->ut_numbern('account')
 578     || $self->ut_numbern('teller')
 579     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
 580     || $self->payinfo_check()
 581   ;
 582   return $error if $error;
 583
 584   return "paid must be > 0 " if $self->paid <= 0;
 585
 586   return "unknown cust_main.custnum: ". $self->custnum
 587     unless $self->invnum
 588            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 589
 590   $self->_date(time) unless $self->_date;
 591
 592   return "invalid discount_term"
 593    if ($self->discount_term && $self->discount_term < 2);
 594
 595   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
 596     foreach (qw(bank depositor account teller)) {
 597       return "$_ required" if $self->get($_) eq '';
 598     }
 599   }
 600
 601 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 602 #  # UNIQUE index should catch this too, without race conditions, but this
 603 #  # should give a better error message the other 99.9% of the time...
 604 #  if ( length($self->payunique)
 605 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 606 #    #well, it *could* be a better error message
 607 #    return "duplicate transaction".
 608 #           " - a payment with unique identifer ". $self->payunique.
 609 #           " already exists";
 610 #  }
 611
 612   $self->SUPER::check;
 613 }
 614
 615 =item send_receipt HASHREF | OPTION => VALUE ...
 616
 617 Sends a payment receipt for this payment..
 618
 619 Available options:
 620
 621 =over 4
 622
 623 =item manual
 624
 625 Flag indicating the payment is being made manually.
 626
 627 =item cust_bill
 628
 629 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
 630 will be assumed.
 631
 632 =item cust_main
 633
 634 Customer (FS::cust_main) object (for efficiency).
 635
 636 =item noemail
 637
 638 Don't send an email receipt.
 639
 640 =cut
 641
 642 =back
 643
 644 =cut
 645
 646 sub send_receipt {
 647   my $self = shift;
 648   my $opt = ref($_[0]) ? shift : { @_ };
 649
 650   my $cust_bill = $opt->{'cust_bill'};
 651   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
 652
 653   my $conf = new FS::Conf;
 654
 655   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
 656
 657   my @invoicing_list = $cust_main->invoicing_list_emailonly;
 658   return '' unless @invoicing_list;
 659
 660   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 661
 662   my $error = '';
 663
 664   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
 665        #|| ! $conf->exists('invoice_html_statement')
 666        || ! $cust_bill
 667      )
 668   {
 669     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 670     if ( $msgnum ) {
 671
 672       my %substitutions = ();
 673       $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 674
 675       my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
 676       unless ($msg_template) {
 677         warn "send_receipt could not load msg_template";
 678         return;
 679       }
 680
 681       my $cust_msg = $msg_template->prepare(
 682           'cust_main'     => $cust_main,
 683           'object'        => $self,
 684           'from_config'   => 'payment_receipt_from',
 685           'substitutions' => \%substitutions,
 686           'msgtype'       => 'receipt',
 687       );
 688       $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
 689       if ($error) {
 690         warn "send_receipt: $error";
 691         return;
 692       }
 693
 694       my $queue = new FS::queue {
 695         'job'     => 'FS::cust_msg::process_send',
 696         'paynum'  => $self->paynum,
 697         'custnum' => $cust_main->custnum,
 698       };
 699       $error = $queue->insert( $cust_msg->custmsgnum );
 700
 701     } else {
 702
 703       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 704
 705     }
 706
 707   #not manual and no noemail flag (here or on the customer)
 708   } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
 709
 710     my $queue = new FS::queue {
 711        'job'     => 'FS::cust_bill::queueable_email',
 712        'paynum'  => $self->paynum,
 713        'custnum' => $cust_main->custnum,
 714     };
 715
 716     my %opt = (
 717       'invnum'      => $cust_bill->invnum,
 718       'no_coupon'   => 1,
 719     );
 720
 721     if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
 722       $opt{'mode'} = $mode;
 723     } else {
 724       # backward compatibility, no good fix for this yet as some people may
 725       # still have "invoice_latex_statement" and such options
 726       $opt{'template'} = 'statement';
 727       $opt{'notice_name'} = 'Statement';
 728     }
 729
 730     $error = $queue->insert(%opt);
 731
 732   }
 733
 734   warn "send_receipt: $error\n" if $error;
 735 }
 736
 737 =item cust_bill_pay
 738
 739 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 740 payment.
 741
 742 =cut
 743
 744 sub cust_bill_pay {
 745   my $self = shift;
 746   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 747   sort {    $a->_date  <=> $b->_date
 748          || $a->invnum <=> $b->invnum }
 749     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 750   ;
 751 }
 752
 753 =item cust_pay_refund
 754
 755 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 756 payment.
 757
 758 =cut
 759
 760 sub cust_pay_refund {
 761   my $self = shift;
 762   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 763   sort { $a->_date <=> $b->_date }
 764     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 765   ;
 766 }
 767
 768
 769 =item unapplied
 770
 771 Returns the amount of this payment that is still unapplied; which is
 772 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 773 applications (see L<FS::cust_pay_refund>).
 774
 775 =cut
 776
 777 sub unapplied {
 778   my $self = shift;
 779   my $amount = $self->paid;
 780   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 781   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 782   sprintf("%.2f", $amount );
 783 }
 784
 785 =item unrefunded
 786
 787 Returns the amount of this payment that has not been refuned; which is
 788 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 789
 790 =cut
 791
 792 sub unrefunded {
 793   my $self = shift;
 794   my $amount = $self->paid;
 795   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 796   sprintf("%.2f", $amount );
 797 }
 798
 799 =item amount
 800
 801 Returns the "paid" field.
 802
 803 =cut
 804
 805 sub amount {
 806   my $self = shift;
 807   $self->paid();
 808 }
 809
 810 =item delete_cust_bill_pay OPTIONS
 811
 812 Deletes all associated cust_bill_pay records.
 813
 814 If option 'unapplied' is a specified, only deletes until
 815 this object's 'unapplied' value is >= the specified amount.
 816 (Deletes in order returned by L</cust_bill_pay>.)
 817
 818 =cut
 819
 820 sub delete_cust_bill_pay {
 821   my $self = shift;
 822   my %opt = @_;
 823
 824   local $SIG{HUP} = 'IGNORE';
 825   local $SIG{INT} = 'IGNORE';
 826   local $SIG{QUIT} = 'IGNORE';
 827   local $SIG{TERM} = 'IGNORE';
 828   local $SIG{TSTP} = 'IGNORE';
 829   local $SIG{PIPE} = 'IGNORE';
 830
 831   my $oldAutoCommit = $FS::UID::AutoCommit;
 832   local $FS::UID::AutoCommit = 0;
 833   my $dbh = dbh;
 834
 835   my $unapplied = $self->unapplied; #only need to look it up once
 836
 837   my $error = '';
 838
 839   # Maybe we should reverse the order these get deleted in?
 840   # ie delete newest first?
 841   # keeping consistent with how bop refunds work, for now...
 842   foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
 843     last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
 844     $unapplied += $cust_bill_pay->amount;
 845     $error = $cust_bill_pay->delete;
 846     last if $error;
 847   }
 848
 849   if ($error) {
 850     $dbh->rollback if $oldAutoCommit;
 851     return $error;
 852   }
 853
 854   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 855   return '';
 856 }
 857
 858 =item refund HASHREF
 859
 860 Accepts input for creating a new FS::cust_refund object.
 861 Unapplies payment from invoices up to the amount of the refund,
 862 creates the refund and applies payment to refund.  Allows entire
 863 process to be handled in one transaction.
 864
 865 Causes a fatal error if called on CARD or CHEK payments.
 866
 867 =cut
 868
 869 sub refund {
 870   my $self = shift;
 871   my $hash = shift;
 872   die "Cannot call cust_pay->refund on " . $self->payby
 873     if grep { $_ eq $self->payby } qw(CARD CHEK);
 874
 875   local $SIG{HUP} = 'IGNORE';
 876   local $SIG{INT} = 'IGNORE';
 877   local $SIG{QUIT} = 'IGNORE';
 878   local $SIG{TERM} = 'IGNORE';
 879   local $SIG{TSTP} = 'IGNORE';
 880   local $SIG{PIPE} = 'IGNORE';
 881
 882   my $oldAutoCommit = $FS::UID::AutoCommit;
 883   local $FS::UID::AutoCommit = 0;
 884   my $dbh = dbh;
 885
 886   my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
 887
 888   if ($error) {
 889     $dbh->rollback if $oldAutoCommit;
 890     return $error;
 891   }
 892
 893   $hash->{'paynum'} = $self->paynum;
 894   my $new = new FS::cust_refund ( $hash );
 895   $error = $new->insert;
 896
 897   if ($error) {
 898     $dbh->rollback if $oldAutoCommit;
 899     return $error;
 900   }
 901
 902   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 903   return '';
 904 }
 905
 906 =back
 907
 908 =head1 CLASS METHODS
 909
 910 =over 4
 911
 912 =item batch_insert CUST_PAY_OBJECT, ...
 913
 914 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 915 objects.  Returns a list, each element representing the status of inserting the
 916 corresponding payment - empty.  If there is an error inserting any payment, the
 917 entire transaction is rolled back, i.e. all payments are inserted or none are.
 918
 919 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 920 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 921 those objects will be inserted with the paynum of the payment, and for
 922 each one, an error message or an empty string will be inserted into the
 923 list of errors.
 924
 925 For example:
 926
 927   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 928   my $num_errors = scalar(grep $_, @errors);
 929   if ( $num_errors == 0 ) {
 930     #success; all payments were inserted
 931   } else {
 932     #failure; no payments were inserted.
 933   }
 934
 935 =cut
 936
 937 sub batch_insert {
 938   my $self = shift; #class method
 939
 940   local $SIG{HUP} = 'IGNORE';
 941   local $SIG{INT} = 'IGNORE';
 942   local $SIG{QUIT} = 'IGNORE';
 943   local $SIG{TERM} = 'IGNORE';
 944   local $SIG{TSTP} = 'IGNORE';
 945   local $SIG{PIPE} = 'IGNORE';
 946
 947   my $oldAutoCommit = $FS::UID::AutoCommit;
 948   local $FS::UID::AutoCommit = 0;
 949   my $dbh = dbh;
 950
 951   my $num_errors = 0;
 952
 953   my @errors;
 954   foreach my $cust_pay (@_) {
 955     my $error = $cust_pay->insert( 'manual' => 1 );
 956     push @errors, $error;
 957     $num_errors++ if $error;
 958
 959     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 960
 961       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 962         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 963           push @errors, '';
 964         }
 965         else {
 966           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 967           my $apply_error = $cust_bill_pay->insert;
 968           push @errors, $apply_error || '';
 969           $num_errors++ if $apply_error;
 970         }
 971       }
 972
 973     } elsif ( !$error ) { #normal case: apply payments as usual
 974       $cust_pay->cust_main->apply_payments( 'manual'=>1 );
 975     }
 976
 977   }
 978
 979   if ( $num_errors ) {
 980     $dbh->rollback if $oldAutoCommit;
 981   } else {
 982     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 983   }
 984
 985   @errors;
 986
 987 }
 988
 989 =item unapplied_sql
 990
 991 Returns an SQL fragment to retreive the unapplied amount.
 992
 993 =cut
 994
 995 sub unapplied_sql {
 996   my ($class, $start, $end) = @_;
 997   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 998   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 999   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1000   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
1001
1002   "paid
1003         - COALESCE(
1004                     ( SELECT SUM(amount) FROM cust_bill_pay
1005                         WHERE cust_pay.paynum = cust_bill_pay.paynum
1006                         $bill_start $bill_end )
1007                     ,0
1008                   )
1009         - COALESCE(
1010                     ( SELECT SUM(amount) FROM cust_pay_refund
1011                         WHERE cust_pay.paynum = cust_pay_refund.paynum
1012                         $refund_start $refund_end )
1013                     ,0
1014                   )
1015   ";
1016
1017 }
1018
1019 sub API_getinfo {
1020  my $self = shift;
1021  my @fields = grep { $_ ne 'payinfo' } $self->fields;
1022  +{ ( map { $_=>$self->$_ } @fields ),
1023   };
1024 }
1025
1026 # _upgrade_data
1027 #
1028 # Used by FS::Upgrade to migrate to a new database.
1029
1030 use FS::h_cust_pay;
1031
1032 sub _upgrade_data {  #class method
1033   my ($class, %opt) = @_;
1034
1035   warn "$me upgrading $class\n" if $DEBUG;
1036
1037   $class->_upgrade_reasonnum(%opt);
1038
1039   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1040
1041   ##
1042   # otaker/ivan upgrade
1043   ##
1044
1045   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1046
1047     #not the most efficient, but hey, it only has to run once
1048
1049     my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1050                     AND usernum IS NULL
1051                     AND EXISTS ( SELECT 1 FROM cust_main
1052                                    WHERE cust_main.custnum = cust_pay.custnum )
1053                 ";
1054
1055     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1056
1057     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1058     $sth->execute or die $sth->errstr;
1059     my $total = $sth->fetchrow_arrayref->[0];
1060     #warn "$total cust_pay records to update\n"
1061     #  if $DEBUG;
1062     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1063
1064     my $count = 0;
1065     my $lastprog = 0;
1066
1067     my @cust_pay = qsearch( {
1068         'table'     => 'cust_pay',
1069         'hashref'   => {},
1070         'extra_sql' => $where,
1071         'order_by'  => 'ORDER BY paynum',
1072     } );
1073
1074     foreach my $cust_pay (@cust_pay) {
1075
1076       my $h_cust_pay = $cust_pay->h_search('insert');
1077       if ( $h_cust_pay ) {
1078         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1079         #$cust_pay->otaker($h_cust_pay->history_user);
1080         $cust_pay->set('otaker', $h_cust_pay->history_user);
1081       } else {
1082         $cust_pay->set('otaker', 'legacy');
1083       }
1084
1085       my $error = $cust_pay->replace;
1086
1087       if ( $error ) {
1088         warn " *** WARNING: Error updating order taker for payment paynum ".
1089              $cust_pay->paynun. ": $error\n";
1090         next;
1091       }
1092
1093       $count++;
1094       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1095         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1096         $lastprog = time;
1097       }
1098
1099     }
1100
1101     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1102   }
1103
1104   ###
1105   # payinfo N/A upgrade
1106   ###
1107
1108   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1109
1110     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1111
1112     my @na_cust_pay = qsearch( {
1113       'table'     => 'cust_pay',
1114       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1115       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1116     } );
1117
1118     foreach my $na ( @na_cust_pay ) {
1119
1120       next unless $na->payinfo eq 'N/A';
1121
1122       my $cust_pay_pending =
1123         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1124       unless ( $cust_pay_pending ) {
1125         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1126              $na->paynum. " (no cust_pay_pending)\n";
1127         next;
1128       }
1129       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1130       my $error = $na->replace;
1131       if ( $error ) {
1132         warn " *** WARNING: Error updating payinfo for payment paynum ".
1133              $na->paynun. ": $error\n";
1134         next;
1135       }
1136
1137     }
1138
1139     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1140   }
1141
1142   ###
1143   # otaker->usernum upgrade
1144   ###
1145
1146   $class->_upgrade_otaker(%opt);
1147
1148   # if we do this anywhere else, it should become an FS::Upgrade method
1149   my $num_to_upgrade = $class->count('paybatch is not null');
1150   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1151   if ( $num_to_upgrade > 0 ) {
1152     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1153     if ( $opt{queue} ) {
1154       if ( $num_jobs > 0 ) {
1155         warn "Upgrade already queued.\n";
1156       } else {
1157         warn "Scheduling upgrade.\n";
1158         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1159         $job->insert;
1160       }
1161     } else {
1162       process_upgrade_paybatch();
1163     }
1164   }
1165 }
1166
1167 sub process_upgrade_paybatch {
1168   my $dbh = dbh;
1169   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1170   local $FS::UID::AutoCommit = 1;
1171
1172   ###
1173   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1174   ###
1175   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1176   my $search = FS::Cursor->new( {
1177     'table'     => 'cust_pay',
1178     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1179   } );
1180   while (my $cust_pay = $search->fetch) {
1181     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1182     $cust_pay->set('paybatch' => '');
1183     my $error = $cust_pay->replace;
1184     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1185     if $error;
1186   }
1187
1188   ###
1189   # migrate gateway info from the misused 'paybatch' field
1190   ###
1191
1192   # not only cust_pay, but also voided and refunded payments
1193   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1194     local $FS::Record::nowarn_classload=1;
1195     # really inefficient, but again, only has to run once
1196     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1197       my $and_batchnum_is_null =
1198         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1199       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1200       my $search = FS::Cursor->new({
1201         table     => $table,
1202         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1203                      "AND (paybatch IS NOT NULL ".
1204                      "OR (paybatch IS NULL AND auth IS NULL
1205                      $and_batchnum_is_null ) )
1206                      ORDER BY $pkey DESC"
1207       });
1208       while ( my $object = $search->fetch ) {
1209         if ( $object->paybatch eq '' ) {
1210           # repair for a previous upgrade that didn't save 'auth'
1211           my $pkey = $object->primary_key;
1212           # find the last history record that had a paybatch value
1213           my $h = qsearchs({
1214               table   => "h_$table",
1215               hashref => {
1216                 $pkey     => $object->$pkey,
1217                 paybatch  => { op=>'!=', value=>''},
1218                 history_action => 'replace_old',
1219               },
1220               order_by => 'ORDER BY history_date DESC LIMIT 1',
1221           });
1222           if (!$h) {
1223             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1224             next;
1225           }
1226           # if the paybatch didn't have an auth string, then it's fine
1227           $h->paybatch =~ /:(\w+):/ or next;
1228           # set paybatch to what it was in that record
1229           $object->set('paybatch', $h->paybatch)
1230           # and then upgrade it like the old records
1231         }
1232
1233         my $parsed = $object->_parse_paybatch;
1234         if (keys %$parsed) {
1235           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1236           $object->set('auth' => $parsed->{authorization});
1237           $object->set('paybatch', '');
1238           my $error = $object->replace;
1239           warn "error parsing CARD/CHEK paybatch fields on $object #".
1240             $object->get($object->primary_key).":\n  $error\n"
1241             if $error;
1242         }
1243       } #$object
1244     } #$table
1245     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1246   }
1247 }
1248
1249 =back
1250
1251 =head1 SUBROUTINES
1252
1253 =over 4
1254
1255 =item process_batch_import
1256
1257 =cut
1258
1259 sub process_batch_import {
1260   my $job = shift;
1261
1262   my $hashcb = sub {
1263     my %hash = @_;
1264     my $custnum = $hash{'custnum'};
1265     my $agentnum = $hash{'agentnum'};
1266     my $agent_custid = $hash{'agent_custid'};
1267     #standardize date
1268     $hash{'_date'} = parse_datetime($hash{'_date'})
1269       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1270     #remove custnum_prefix
1271     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1272     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1273     if (
1274       $custnum_prefix
1275       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1276       && length($1) == $custnum_length
1277     ) {
1278       $custnum = $2;
1279     }
1280     # check agentnum against custnum and
1281     # translate agent_custid into regular custnum
1282     if ($custnum && $agent_custid) {
1283       die "can't specify both custnum and agent_custid\n";
1284     } elsif ($agentnum || $agent_custid) {
1285       # here is the agent virtualization
1286       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1287       my %search;
1288       $search{'agentnum'} = $agentnum
1289         if $agentnum;
1290       $search{'agent_custid'} = $agent_custid
1291         if $agent_custid;
1292       $search{'custnum'} = $custnum
1293         if $custnum;
1294       my $cust_main = qsearchs({
1295         'table'     => 'cust_main',
1296         'hashref'   => \%search,
1297         'extra_sql' => $extra_sql,
1298       });
1299       die "can't find customer with" .
1300         ($agentnum ? " agentnum $agentnum" : '') .
1301         ($custnum  ? " custnum $custnum" : '') .
1302         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1303         unless $cust_main;
1304       die "mismatched customer number\n"
1305         if $custnum && ($custnum ne $cust_main->custnum);
1306       $custnum = $cust_main->custnum;
1307     }
1308     $hash{'custnum'} = $custnum;
1309     delete($hash{'agent_custid'});
1310     return %hash;
1311   };
1312
1313   my $opt = {
1314     'table'        => 'cust_pay',
1315     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1316                         #agent_custid isn't a cust_pay field, see hash callback
1317     'formats'      => { 'simple' =>
1318                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1319     'format_types' => { 'simple' => '' }, #force infer from file extension
1320     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1321     'format_hash_callbacks' => { 'simple' => $hashcb },
1322     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1323     'postinsert_callback'   => sub {
1324       my $cust_pay = shift;
1325       my $cust_main = $cust_pay->cust_main
1326                         or return "can't find customer to which payments apply";
1327       my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1328       return $error
1329                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1330                : '';
1331     },
1332   };
1333
1334   FS::Record::process_batch_import( $job, $opt, @_ );
1335
1336 }
1337
1338 =item batch_import HASHREF
1339
1340 Inserts new payments.
1341
1342 =cut
1343
1344 sub batch_import {
1345   my $param = shift;
1346
1347   my $fh       = $param->{filehandle};
1348   my $format   = $param->{'format'};
1349
1350   my $agentnum = $param->{agentnum};
1351   my $_date    = $param->{_date};
1352   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1353   my $paybatch = $param->{'paybatch'};
1354
1355   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1356   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1357
1358   # here is the agent virtualization
1359   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1360
1361   my @fields;
1362   my $payby;
1363   if ( $format eq 'simple' ) {
1364     @fields = qw( custnum agent_custid paid payinfo invnum );
1365     $payby = 'BILL';
1366   } elsif ( $format eq 'extended' ) {
1367     die "unimplemented\n";
1368     @fields = qw( );
1369     $payby = 'BILL';
1370   } else {
1371     die "unknown format $format";
1372   }
1373
1374   eval "use Text::CSV_XS;";
1375   die $@ if $@;
1376
1377   my $csv = new Text::CSV_XS;
1378
1379   my $imported = 0;
1380
1381   local $SIG{HUP} = 'IGNORE';
1382   local $SIG{INT} = 'IGNORE';
1383   local $SIG{QUIT} = 'IGNORE';
1384   local $SIG{TERM} = 'IGNORE';
1385   local $SIG{TSTP} = 'IGNORE';
1386   local $SIG{PIPE} = 'IGNORE';
1387
1388   my $oldAutoCommit = $FS::UID::AutoCommit;
1389   local $FS::UID::AutoCommit = 0;
1390   my $dbh = dbh;
1391
1392   my $line;
1393   while ( defined($line=<$fh>) ) {
1394
1395     $csv->parse($line) or do {
1396       $dbh->rollback if $oldAutoCommit;
1397       return "can't parse: ". $csv->error_input();
1398     };
1399
1400     my @columns = $csv->fields();
1401
1402     my %cust_pay = (
1403       payby    => $payby,
1404       paybatch => $paybatch,
1405     );
1406     $cust_pay{_date} = $_date if $_date;
1407
1408     my $cust_main;
1409     foreach my $field ( @fields ) {
1410
1411       if ( $field eq 'agent_custid'
1412         && $agentnum
1413         && $columns[0] =~ /\S+/ )
1414       {
1415
1416         my $agent_custid = $columns[0];
1417         my %hash = ( 'agent_custid' => $agent_custid,
1418                      'agentnum'     => $agentnum,
1419                    );
1420
1421         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1422           $dbh->rollback if $oldAutoCommit;
1423           return "can't specify custnum with agent_custid $agent_custid";
1424         }
1425
1426         $cust_main = qsearchs({
1427                                 'table'     => 'cust_main',
1428                                 'hashref'   => \%hash,
1429                                 'extra_sql' => $extra_sql,
1430                              });
1431
1432         unless ( $cust_main ) {
1433           $dbh->rollback if $oldAutoCommit;
1434           return "can't find customer with agent_custid $agent_custid";
1435         }
1436
1437         $field = 'custnum';
1438         $columns[0] = $cust_main->custnum;
1439       }
1440
1441       $cust_pay{$field} = shift @columns;
1442     }
1443
1444     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1445                          && length($1) == $custnum_length ) {
1446       $cust_pay{custnum} = $2;
1447     }
1448
1449     my $custnum = $cust_pay{custnum};
1450
1451     my $cust_pay = new FS::cust_pay( \%cust_pay );
1452     my $error = $cust_pay->insert;
1453
1454     if ( ! $error && $cust_pay->custnum != $custnum ) {
1455       #invnum was defined, and ->insert set custnum to the customer for that
1456       #invoice, but it wasn't the one the import specified.
1457       $dbh->rollback if $oldAutoCommit;
1458       $error = "specified invoice #". $cust_pay{invnum}.
1459                " is for custnum ". $cust_pay->custnum.
1460                ", not specified custnum $custnum";
1461     }
1462
1463     if ( $error ) {
1464       $dbh->rollback if $oldAutoCommit;
1465       return "can't insert payment for $line: $error";
1466     }
1467
1468     if ( $format eq 'simple' ) {
1469       # include agentnum for less surprise?
1470       $cust_main = qsearchs({
1471                              'table'     => 'cust_main',
1472                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1473                              'extra_sql' => $extra_sql,
1474                            })
1475         unless $cust_main;
1476
1477       unless ( $cust_main ) {
1478         $dbh->rollback if $oldAutoCommit;
1479         return "can't find customer to which payments apply at line: $line";
1480       }
1481
1482       $error = $cust_main->apply_payments_and_credits;
1483       if ( $error ) {
1484         $dbh->rollback if $oldAutoCommit;
1485         return "can't apply payments to customer for $line: $error";
1486       }
1487
1488     }
1489
1490     $imported++;
1491   }
1492
1493   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1494
1495   return "Empty file!" unless $imported;
1496
1497   ''; #no error
1498
1499 }
1500
1501 =back
1502
1503 =head1 BUGS
1504
1505 Delete and replace methods.
1506
1507 =head1 SEE ALSO
1508
1509 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1510 schema.html from the base documentation.
1511
1512 =cut
1513
1514 1;
1515