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 $queue = new FS::queue {
 676         'job'     => 'FS::Misc::process_send_email',
 677         'paynum'  => $self->paynum,
 678         'custnum' => $cust_main->custnum,
 679       };
 680       $error = $queue->insert(
 681         FS::msg_template->by_key($msgnum)->prepare(
 682           'cust_main'     => $cust_main,
 683           'object'        => $self,
 684           'from_config'   => 'payment_receipt_from',
 685           'substitutions' => \%substitutions,
 686         ),
 687         'msgtype' => 'receipt', # override msg_template's default
 688       );
 689
 690     } elsif ( $conf->exists('payment_receipt_email') ) {
 691
 692       my $receipt_template = new Text::Template (
 693         TYPE   => 'ARRAY',
 694         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 695       ) or do {
 696         warn "can't create payment receipt template: $Text::Template::ERROR";
 697         return '';
 698       };
 699
 700       my $payby = $self->payby;
 701       my $payinfo = $self->payinfo;
 702       $payby =~ s/^BILL$/Check/ if $payinfo;
 703       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 704         $payinfo = $self->paymask
 705       } else {
 706         $payinfo = $self->decrypt($payinfo);
 707       }
 708       $payby =~ s/^CHEK$/Electronic check/;
 709
 710       my %fill_in = (
 711         'date'         => time2str("%a %B %o, %Y", $self->_date),
 712         'name'         => $cust_main->name,
 713         'paynum'       => $self->paynum,
 714         'paid'         => sprintf("%.2f", $self->paid),
 715         'payby'        => ucfirst(lc($payby)),
 716         'payinfo'      => $payinfo,
 717         'balance'      => $cust_main->balance,
 718         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 719       );
 720
 721       $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 722
 723       if ( $opt->{'cust_pkg'} ) {
 724         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 725         #setup date, other things?
 726       }
 727
 728       my $queue = new FS::queue {
 729         'job'     => 'FS::Misc::process_send_generated_email',
 730         'paynum'  => $self->paynum,
 731         'custnum' => $cust_main->custnum,
 732         'msgtype' => 'receipt',
 733       };
 734       $error = $queue->insert(
 735         'from'    => $conf->invoice_from_full( $cust_main->agentnum ),
 736                                    #invoice_from??? well as good as any
 737         'to'      => \@invoicing_list,
 738         'subject' => 'Payment receipt',
 739         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 740       );
 741
 742     } else {
 743
 744       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 745
 746     }
 747
 748   #not manual and no noemail flag (here or on the customer)
 749   } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
 750
 751     my $queue = new FS::queue {
 752        'job'     => 'FS::cust_bill::queueable_email',
 753        'paynum'  => $self->paynum,
 754        'custnum' => $cust_main->custnum,
 755     };
 756
 757     my %opt = (
 758       'invnum'      => $cust_bill->invnum,
 759       'no_coupon'   => 1,
 760     );
 761
 762     if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
 763       $opt{'mode'} = $mode;
 764     } else {
 765       # backward compatibility, no good fix for this yet as some people may
 766       # still have "invoice_latex_statement" and such options
 767       $opt{'template'} = 'statement';
 768       $opt{'notice_name'} = 'Statement';
 769     }
 770
 771     $error = $queue->insert(%opt);
 772
 773   }
 774
 775   warn "send_receipt: $error\n" if $error;
 776 }
 777
 778 =item cust_bill_pay
 779
 780 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 781 payment.
 782
 783 =cut
 784
 785 sub cust_bill_pay {
 786   my $self = shift;
 787   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 788   sort {    $a->_date  <=> $b->_date
 789          || $a->invnum <=> $b->invnum }
 790     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 791   ;
 792 }
 793
 794 =item cust_pay_refund
 795
 796 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 797 payment.
 798
 799 =cut
 800
 801 sub cust_pay_refund {
 802   my $self = shift;
 803   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 804   sort { $a->_date <=> $b->_date }
 805     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 806   ;
 807 }
 808
 809
 810 =item unapplied
 811
 812 Returns the amount of this payment that is still unapplied; which is
 813 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 814 applications (see L<FS::cust_pay_refund>).
 815
 816 =cut
 817
 818 sub unapplied {
 819   my $self = shift;
 820   my $amount = $self->paid;
 821   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 822   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 823   sprintf("%.2f", $amount );
 824 }
 825
 826 =item unrefunded
 827
 828 Returns the amount of this payment that has not been refuned; which is
 829 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 830
 831 =cut
 832
 833 sub unrefunded {
 834   my $self = shift;
 835   my $amount = $self->paid;
 836   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 837   sprintf("%.2f", $amount );
 838 }
 839
 840 =item amount
 841
 842 Returns the "paid" field.
 843
 844 =cut
 845
 846 sub amount {
 847   my $self = shift;
 848   $self->paid();
 849 }
 850
 851 =item delete_cust_bill_pay OPTIONS
 852
 853 Deletes all associated cust_bill_pay records.
 854
 855 If option 'unapplied' is a specified, only deletes until
 856 this object's 'unapplied' value is >= the specified amount.
 857 (Deletes in order returned by L</cust_bill_pay>.)
 858
 859 =cut
 860
 861 sub delete_cust_bill_pay {
 862   my $self = shift;
 863   my %opt = @_;
 864
 865   local $SIG{HUP} = 'IGNORE';
 866   local $SIG{INT} = 'IGNORE';
 867   local $SIG{QUIT} = 'IGNORE';
 868   local $SIG{TERM} = 'IGNORE';
 869   local $SIG{TSTP} = 'IGNORE';
 870   local $SIG{PIPE} = 'IGNORE';
 871
 872   my $oldAutoCommit = $FS::UID::AutoCommit;
 873   local $FS::UID::AutoCommit = 0;
 874   my $dbh = dbh;
 875
 876   my $unapplied = $self->unapplied; #only need to look it up once
 877
 878   my $error = '';
 879
 880   # Maybe we should reverse the order these get deleted in?
 881   # ie delete newest first?
 882   # keeping consistent with how bop refunds work, for now...
 883   foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
 884     last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
 885     $unapplied += $cust_bill_pay->amount;
 886     $error = $cust_bill_pay->delete;
 887     last if $error;
 888   }
 889
 890   if ($error) {
 891     $dbh->rollback if $oldAutoCommit;
 892     return $error;
 893   }
 894
 895   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 896   return '';
 897 }
 898
 899 =item refund HASHREF
 900
 901 Accepts input for creating a new FS::cust_refund object.
 902 Unapplies payment from invoices up to the amount of the refund,
 903 creates the refund and applies payment to refund.  Allows entire
 904 process to be handled in one transaction.
 905
 906 Causes a fatal error if called on CARD or CHEK payments.
 907
 908 =cut
 909
 910 sub refund {
 911   my $self = shift;
 912   my $hash = shift;
 913   die "Cannot call cust_pay->refund on " . $self->payby
 914     if grep { $_ eq $self->payby } qw(CARD CHEK);
 915
 916   local $SIG{HUP} = 'IGNORE';
 917   local $SIG{INT} = 'IGNORE';
 918   local $SIG{QUIT} = 'IGNORE';
 919   local $SIG{TERM} = 'IGNORE';
 920   local $SIG{TSTP} = 'IGNORE';
 921   local $SIG{PIPE} = 'IGNORE';
 922
 923   my $oldAutoCommit = $FS::UID::AutoCommit;
 924   local $FS::UID::AutoCommit = 0;
 925   my $dbh = dbh;
 926
 927   my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
 928
 929   if ($error) {
 930     $dbh->rollback if $oldAutoCommit;
 931     return $error;
 932   }
 933
 934   $hash->{'paynum'} = $self->paynum;
 935   my $new = new FS::cust_refund ( $hash );
 936   $error = $new->insert;
 937
 938   if ($error) {
 939     $dbh->rollback if $oldAutoCommit;
 940     return $error;
 941   }
 942
 943   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 944   return '';
 945 }
 946
 947 =back
 948
 949 =head1 CLASS METHODS
 950
 951 =over 4
 952
 953 =item batch_insert CUST_PAY_OBJECT, ...
 954
 955 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 956 objects.  Returns a list, each element representing the status of inserting the
 957 corresponding payment - empty.  If there is an error inserting any payment, the
 958 entire transaction is rolled back, i.e. all payments are inserted or none are.
 959
 960 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 961 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 962 those objects will be inserted with the paynum of the payment, and for
 963 each one, an error message or an empty string will be inserted into the
 964 list of errors.
 965
 966 For example:
 967
 968   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 969   my $num_errors = scalar(grep $_, @errors);
 970   if ( $num_errors == 0 ) {
 971     #success; all payments were inserted
 972   } else {
 973     #failure; no payments were inserted.
 974   }
 975
 976 =cut
 977
 978 sub batch_insert {
 979   my $self = shift; #class method
 980
 981   local $SIG{HUP} = 'IGNORE';
 982   local $SIG{INT} = 'IGNORE';
 983   local $SIG{QUIT} = 'IGNORE';
 984   local $SIG{TERM} = 'IGNORE';
 985   local $SIG{TSTP} = 'IGNORE';
 986   local $SIG{PIPE} = 'IGNORE';
 987
 988   my $oldAutoCommit = $FS::UID::AutoCommit;
 989   local $FS::UID::AutoCommit = 0;
 990   my $dbh = dbh;
 991
 992   my $num_errors = 0;
 993
 994   my @errors;
 995   foreach my $cust_pay (@_) {
 996     my $error = $cust_pay->insert( 'manual' => 1 );
 997     push @errors, $error;
 998     $num_errors++ if $error;
 999
1000     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1001
1002       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1003         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1004           push @errors, '';
1005         }
1006         else {
1007           $cust_bill_pay->set('paynum', $cust_pay->paynum);
1008           my $apply_error = $cust_bill_pay->insert;
1009           push @errors, $apply_error || '';
1010           $num_errors++ if $apply_error;
1011         }
1012       }
1013
1014     } elsif ( !$error ) { #normal case: apply payments as usual
1015       $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1016     }
1017
1018   }
1019
1020   if ( $num_errors ) {
1021     $dbh->rollback if $oldAutoCommit;
1022   } else {
1023     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1024   }
1025
1026   @errors;
1027
1028 }
1029
1030 =item unapplied_sql
1031
1032 Returns an SQL fragment to retreive the unapplied amount.
1033
1034 =cut
1035
1036 sub unapplied_sql {
1037   my ($class, $start, $end) = @_;
1038   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
1039   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
1040   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1041   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
1042
1043   "paid
1044         - COALESCE(
1045                     ( SELECT SUM(amount) FROM cust_bill_pay
1046                         WHERE cust_pay.paynum = cust_bill_pay.paynum
1047                         $bill_start $bill_end )
1048                     ,0
1049                   )
1050         - COALESCE(
1051                     ( SELECT SUM(amount) FROM cust_pay_refund
1052                         WHERE cust_pay.paynum = cust_pay_refund.paynum
1053                         $refund_start $refund_end )
1054                     ,0
1055                   )
1056   ";
1057
1058 }
1059
1060 sub API_getinfo {
1061  my $self = shift;
1062  my @fields = grep { $_ ne 'payinfo' } $self->fields;
1063  +{ ( map { $_=>$self->$_ } @fields ),
1064   };
1065 }
1066
1067 # _upgrade_data
1068 #
1069 # Used by FS::Upgrade to migrate to a new database.
1070
1071 use FS::h_cust_pay;
1072
1073 sub _upgrade_data {  #class method
1074   my ($class, %opt) = @_;
1075
1076   warn "$me upgrading $class\n" if $DEBUG;
1077
1078   $class->_upgrade_reasonnum(%opt);
1079
1080   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1081
1082   ##
1083   # otaker/ivan upgrade
1084   ##
1085
1086   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1087
1088     #not the most efficient, but hey, it only has to run once
1089
1090     my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1091                     AND usernum IS NULL
1092                     AND EXISTS ( SELECT 1 FROM cust_main
1093                                    WHERE cust_main.custnum = cust_pay.custnum )
1094                 ";
1095
1096     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1097
1098     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1099     $sth->execute or die $sth->errstr;
1100     my $total = $sth->fetchrow_arrayref->[0];
1101     #warn "$total cust_pay records to update\n"
1102     #  if $DEBUG;
1103     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1104
1105     my $count = 0;
1106     my $lastprog = 0;
1107
1108     my @cust_pay = qsearch( {
1109         'table'     => 'cust_pay',
1110         'hashref'   => {},
1111         'extra_sql' => $where,
1112         'order_by'  => 'ORDER BY paynum',
1113     } );
1114
1115     foreach my $cust_pay (@cust_pay) {
1116
1117       my $h_cust_pay = $cust_pay->h_search('insert');
1118       if ( $h_cust_pay ) {
1119         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1120         #$cust_pay->otaker($h_cust_pay->history_user);
1121         $cust_pay->set('otaker', $h_cust_pay->history_user);
1122       } else {
1123         $cust_pay->set('otaker', 'legacy');
1124       }
1125
1126       my $error = $cust_pay->replace;
1127
1128       if ( $error ) {
1129         warn " *** WARNING: Error updating order taker for payment paynum ".
1130              $cust_pay->paynun. ": $error\n";
1131         next;
1132       }
1133
1134       $count++;
1135       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1136         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1137         $lastprog = time;
1138       }
1139
1140     }
1141
1142     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1143   }
1144
1145   ###
1146   # payinfo N/A upgrade
1147   ###
1148
1149   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1150
1151     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1152
1153     my @na_cust_pay = qsearch( {
1154       'table'     => 'cust_pay',
1155       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1156       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1157     } );
1158
1159     foreach my $na ( @na_cust_pay ) {
1160
1161       next unless $na->payinfo eq 'N/A';
1162
1163       my $cust_pay_pending =
1164         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1165       unless ( $cust_pay_pending ) {
1166         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1167              $na->paynum. " (no cust_pay_pending)\n";
1168         next;
1169       }
1170       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1171       my $error = $na->replace;
1172       if ( $error ) {
1173         warn " *** WARNING: Error updating payinfo for payment paynum ".
1174              $na->paynun. ": $error\n";
1175         next;
1176       }
1177
1178     }
1179
1180     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1181   }
1182
1183   ###
1184   # otaker->usernum upgrade
1185   ###
1186
1187   $class->_upgrade_otaker(%opt);
1188
1189   # if we do this anywhere else, it should become an FS::Upgrade method
1190   my $num_to_upgrade = $class->count('paybatch is not null');
1191   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1192   if ( $num_to_upgrade > 0 ) {
1193     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1194     if ( $opt{queue} ) {
1195       if ( $num_jobs > 0 ) {
1196         warn "Upgrade already queued.\n";
1197       } else {
1198         warn "Scheduling upgrade.\n";
1199         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1200         $job->insert;
1201       }
1202     } else {
1203       process_upgrade_paybatch();
1204     }
1205   }
1206 }
1207
1208 sub process_upgrade_paybatch {
1209   my $dbh = dbh;
1210   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1211   local $FS::UID::AutoCommit = 1;
1212
1213   ###
1214   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1215   ###
1216   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1217   my $search = FS::Cursor->new( {
1218     'table'     => 'cust_pay',
1219     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1220   } );
1221   while (my $cust_pay = $search->fetch) {
1222     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1223     $cust_pay->set('paybatch' => '');
1224     my $error = $cust_pay->replace;
1225     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1226     if $error;
1227   }
1228
1229   ###
1230   # migrate gateway info from the misused 'paybatch' field
1231   ###
1232
1233   # not only cust_pay, but also voided and refunded payments
1234   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1235     local $FS::Record::nowarn_classload=1;
1236     # really inefficient, but again, only has to run once
1237     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1238       my $and_batchnum_is_null =
1239         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1240       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1241       my $search = FS::Cursor->new({
1242         table     => $table,
1243         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1244                      "AND (paybatch IS NOT NULL ".
1245                      "OR (paybatch IS NULL AND auth IS NULL
1246                      $and_batchnum_is_null ) )
1247                      ORDER BY $pkey DESC"
1248       });
1249       while ( my $object = $search->fetch ) {
1250         if ( $object->paybatch eq '' ) {
1251           # repair for a previous upgrade that didn't save 'auth'
1252           my $pkey = $object->primary_key;
1253           # find the last history record that had a paybatch value
1254           my $h = qsearchs({
1255               table   => "h_$table",
1256               hashref => {
1257                 $pkey     => $object->$pkey,
1258                 paybatch  => { op=>'!=', value=>''},
1259                 history_action => 'replace_old',
1260               },
1261               order_by => 'ORDER BY history_date DESC LIMIT 1',
1262           });
1263           if (!$h) {
1264             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1265             next;
1266           }
1267           # if the paybatch didn't have an auth string, then it's fine
1268           $h->paybatch =~ /:(\w+):/ or next;
1269           # set paybatch to what it was in that record
1270           $object->set('paybatch', $h->paybatch)
1271           # and then upgrade it like the old records
1272         }
1273
1274         my $parsed = $object->_parse_paybatch;
1275         if (keys %$parsed) {
1276           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1277           $object->set('auth' => $parsed->{authorization});
1278           $object->set('paybatch', '');
1279           my $error = $object->replace;
1280           warn "error parsing CARD/CHEK paybatch fields on $object #".
1281             $object->get($object->primary_key).":\n  $error\n"
1282             if $error;
1283         }
1284       } #$object
1285     } #$table
1286     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1287   }
1288 }
1289
1290 =back
1291
1292 =head1 SUBROUTINES
1293
1294 =over 4
1295
1296 =item process_batch_import
1297
1298 =cut
1299
1300 sub process_batch_import {
1301   my $job = shift;
1302
1303   my $hashcb = sub {
1304     my %hash = @_;
1305     my $custnum = $hash{'custnum'};
1306     my $agentnum = $hash{'agentnum'};
1307     my $agent_custid = $hash{'agent_custid'};
1308     #standardize date
1309     $hash{'_date'} = parse_datetime($hash{'_date'})
1310       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1311     #remove custnum_prefix
1312     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1313     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1314     if (
1315       $custnum_prefix
1316       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1317       && length($1) == $custnum_length
1318     ) {
1319       $custnum = $2;
1320     }
1321     # check agentnum against custnum and
1322     # translate agent_custid into regular custnum
1323     if ($custnum && $agent_custid) {
1324       die "can't specify both custnum and agent_custid\n";
1325     } elsif ($agentnum || $agent_custid) {
1326       # here is the agent virtualization
1327       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1328       my %search;
1329       $search{'agentnum'} = $agentnum
1330         if $agentnum;
1331       $search{'agent_custid'} = $agent_custid
1332         if $agent_custid;
1333       $search{'custnum'} = $custnum
1334         if $custnum;
1335       my $cust_main = qsearchs({
1336         'table'     => 'cust_main',
1337         'hashref'   => \%search,
1338         'extra_sql' => $extra_sql,
1339       });
1340       die "can't find customer with" .
1341         ($agentnum ? " agentnum $agentnum" : '') .
1342         ($custnum  ? " custnum $custnum" : '') .
1343         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1344         unless $cust_main;
1345       die "mismatched customer number\n"
1346         if $custnum && ($custnum ne $cust_main->custnum);
1347       $custnum = $cust_main->custnum;
1348     }
1349     $hash{'custnum'} = $custnum;
1350     delete($hash{'agent_custid'});
1351     return %hash;
1352   };
1353
1354   my $opt = {
1355     'table'        => 'cust_pay',
1356     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1357                         #agent_custid isn't a cust_pay field, see hash callback
1358     'formats'      => { 'simple' =>
1359                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1360     'format_types' => { 'simple' => '' }, #force infer from file extension
1361     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1362     'format_hash_callbacks' => { 'simple' => $hashcb },
1363     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1364     'postinsert_callback'   => sub {
1365       my $cust_pay = shift;
1366       my $cust_main = $cust_pay->cust_main
1367                         or return "can't find customer to which payments apply";
1368       my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1369       return $error
1370                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1371                : '';
1372     },
1373   };
1374
1375   FS::Record::process_batch_import( $job, $opt, @_ );
1376
1377 }
1378
1379 =item batch_import HASHREF
1380
1381 Inserts new payments.
1382
1383 =cut
1384
1385 sub batch_import {
1386   my $param = shift;
1387
1388   my $fh       = $param->{filehandle};
1389   my $format   = $param->{'format'};
1390
1391   my $agentnum = $param->{agentnum};
1392   my $_date    = $param->{_date};
1393   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1394   my $paybatch = $param->{'paybatch'};
1395
1396   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1397   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1398
1399   # here is the agent virtualization
1400   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1401
1402   my @fields;
1403   my $payby;
1404   if ( $format eq 'simple' ) {
1405     @fields = qw( custnum agent_custid paid payinfo invnum );
1406     $payby = 'BILL';
1407   } elsif ( $format eq 'extended' ) {
1408     die "unimplemented\n";
1409     @fields = qw( );
1410     $payby = 'BILL';
1411   } else {
1412     die "unknown format $format";
1413   }
1414
1415   eval "use Text::CSV_XS;";
1416   die $@ if $@;
1417
1418   my $csv = new Text::CSV_XS;
1419
1420   my $imported = 0;
1421
1422   local $SIG{HUP} = 'IGNORE';
1423   local $SIG{INT} = 'IGNORE';
1424   local $SIG{QUIT} = 'IGNORE';
1425   local $SIG{TERM} = 'IGNORE';
1426   local $SIG{TSTP} = 'IGNORE';
1427   local $SIG{PIPE} = 'IGNORE';
1428
1429   my $oldAutoCommit = $FS::UID::AutoCommit;
1430   local $FS::UID::AutoCommit = 0;
1431   my $dbh = dbh;
1432
1433   my $line;
1434   while ( defined($line=<$fh>) ) {
1435
1436     $csv->parse($line) or do {
1437       $dbh->rollback if $oldAutoCommit;
1438       return "can't parse: ". $csv->error_input();
1439     };
1440
1441     my @columns = $csv->fields();
1442
1443     my %cust_pay = (
1444       payby    => $payby,
1445       paybatch => $paybatch,
1446     );
1447     $cust_pay{_date} = $_date if $_date;
1448
1449     my $cust_main;
1450     foreach my $field ( @fields ) {
1451
1452       if ( $field eq 'agent_custid'
1453         && $agentnum
1454         && $columns[0] =~ /\S+/ )
1455       {
1456
1457         my $agent_custid = $columns[0];
1458         my %hash = ( 'agent_custid' => $agent_custid,
1459                      'agentnum'     => $agentnum,
1460                    );
1461
1462         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1463           $dbh->rollback if $oldAutoCommit;
1464           return "can't specify custnum with agent_custid $agent_custid";
1465         }
1466
1467         $cust_main = qsearchs({
1468                                 'table'     => 'cust_main',
1469                                 'hashref'   => \%hash,
1470                                 'extra_sql' => $extra_sql,
1471                              });
1472
1473         unless ( $cust_main ) {
1474           $dbh->rollback if $oldAutoCommit;
1475           return "can't find customer with agent_custid $agent_custid";
1476         }
1477
1478         $field = 'custnum';
1479         $columns[0] = $cust_main->custnum;
1480       }
1481
1482       $cust_pay{$field} = shift @columns;
1483     }
1484
1485     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1486                          && length($1) == $custnum_length ) {
1487       $cust_pay{custnum} = $2;
1488     }
1489
1490     my $custnum = $cust_pay{custnum};
1491
1492     my $cust_pay = new FS::cust_pay( \%cust_pay );
1493     my $error = $cust_pay->insert;
1494
1495     if ( ! $error && $cust_pay->custnum != $custnum ) {
1496       #invnum was defined, and ->insert set custnum to the customer for that
1497       #invoice, but it wasn't the one the import specified.
1498       $dbh->rollback if $oldAutoCommit;
1499       $error = "specified invoice #". $cust_pay{invnum}.
1500                " is for custnum ". $cust_pay->custnum.
1501                ", not specified custnum $custnum";
1502     }
1503
1504     if ( $error ) {
1505       $dbh->rollback if $oldAutoCommit;
1506       return "can't insert payment for $line: $error";
1507     }
1508
1509     if ( $format eq 'simple' ) {
1510       # include agentnum for less surprise?
1511       $cust_main = qsearchs({
1512                              'table'     => 'cust_main',
1513                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1514                              'extra_sql' => $extra_sql,
1515                            })
1516         unless $cust_main;
1517
1518       unless ( $cust_main ) {
1519         $dbh->rollback if $oldAutoCommit;
1520         return "can't find customer to which payments apply at line: $line";
1521       }
1522
1523       $error = $cust_main->apply_payments_and_credits;
1524       if ( $error ) {
1525         $dbh->rollback if $oldAutoCommit;
1526         return "can't apply payments to customer for $line: $error";
1527       }
1528
1529     }
1530
1531     $imported++;
1532   }
1533
1534   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1535
1536   return "Empty file!" unless $imported;
1537
1538   ''; #no error
1539
1540 }
1541
1542 =back
1543
1544 =head1 BUGS
1545
1546 Delete and replace methods.
1547
1548 =head1 SEE ALSO
1549
1550 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1551 schema.html from the base documentation.
1552
1553 =cut
1554
1555 1;
1556