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