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