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