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 # _upgrade_data
1075 #
1076 # Used by FS::Upgrade to migrate to a new database.
1077
1078 use FS::h_cust_pay;
1079
1080 sub _upgrade_data {  #class method
1081   my ($class, %opt) = @_;
1082
1083   warn "$me upgrading $class\n" if $DEBUG;
1084
1085   $class->_upgrade_reasonnum(%opt);
1086
1087   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1088
1089   ##
1090   # otaker/ivan upgrade
1091   ##
1092
1093   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1094
1095     #not the most efficient, but hey, it only has to run once
1096
1097     my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1098                     AND usernum IS NULL
1099                     AND EXISTS ( SELECT 1 FROM cust_main
1100                                    WHERE cust_main.custnum = cust_pay.custnum )
1101                 ";
1102
1103     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1104
1105     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1106     $sth->execute or die $sth->errstr;
1107     my $total = $sth->fetchrow_arrayref->[0];
1108     #warn "$total cust_pay records to update\n"
1109     #  if $DEBUG;
1110     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1111
1112     my $count = 0;
1113     my $lastprog = 0;
1114
1115     my @cust_pay = qsearch( {
1116         'table'     => 'cust_pay',
1117         'hashref'   => {},
1118         'extra_sql' => $where,
1119         'order_by'  => 'ORDER BY paynum',
1120     } );
1121
1122     foreach my $cust_pay (@cust_pay) {
1123
1124       my $h_cust_pay = $cust_pay->h_search('insert');
1125       if ( $h_cust_pay ) {
1126         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1127         #$cust_pay->otaker($h_cust_pay->history_user);
1128         $cust_pay->set('otaker', $h_cust_pay->history_user);
1129       } else {
1130         $cust_pay->set('otaker', 'legacy');
1131       }
1132
1133       my $error = $cust_pay->replace;
1134
1135       if ( $error ) {
1136         warn " *** WARNING: Error updating order taker for payment paynum ".
1137              $cust_pay->paynun. ": $error\n";
1138         next;
1139       }
1140
1141       $count++;
1142       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1143         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1144         $lastprog = time;
1145       }
1146
1147     }
1148
1149     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1150   }
1151
1152   ###
1153   # payinfo N/A upgrade
1154   ###
1155
1156   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1157
1158     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1159
1160     my @na_cust_pay = qsearch( {
1161       'table'     => 'cust_pay',
1162       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1163       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1164     } );
1165
1166     foreach my $na ( @na_cust_pay ) {
1167
1168       next unless $na->payinfo eq 'N/A';
1169
1170       my $cust_pay_pending =
1171         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1172       unless ( $cust_pay_pending ) {
1173         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1174              $na->paynum. " (no cust_pay_pending)\n";
1175         next;
1176       }
1177       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1178       my $error = $na->replace;
1179       if ( $error ) {
1180         warn " *** WARNING: Error updating payinfo for payment paynum ".
1181              $na->paynun. ": $error\n";
1182         next;
1183       }
1184
1185     }
1186
1187     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1188   }
1189
1190   ###
1191   # otaker->usernum upgrade
1192   ###
1193
1194   $class->_upgrade_otaker(%opt);
1195
1196   # if we do this anywhere else, it should become an FS::Upgrade method
1197   my $num_to_upgrade = $class->count('paybatch is not null');
1198   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1199   if ( $num_to_upgrade > 0 ) {
1200     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1201     if ( $opt{queue} ) {
1202       if ( $num_jobs > 0 ) {
1203         warn "Upgrade already queued.\n";
1204       } else {
1205         warn "Scheduling upgrade.\n";
1206         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1207         $job->insert;
1208       }
1209     } else {
1210       process_upgrade_paybatch();
1211     }
1212   }
1213
1214   ###
1215   # set paycardtype
1216   ###
1217   $class->upgrade_set_cardtype;
1218
1219 }
1220
1221 sub process_upgrade_paybatch {
1222   my $dbh = dbh;
1223   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1224   local $FS::UID::AutoCommit = 1;
1225
1226   ###
1227   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1228   ###
1229   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1230   my $search = FS::Cursor->new( {
1231     'table'     => 'cust_pay',
1232     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1233   } );
1234   while (my $cust_pay = $search->fetch) {
1235     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1236     $cust_pay->set('paybatch' => '');
1237     my $error = $cust_pay->replace;
1238     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1239     if $error;
1240   }
1241
1242   ###
1243   # migrate gateway info from the misused 'paybatch' field
1244   ###
1245
1246   # not only cust_pay, but also voided and refunded payments
1247   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1248     local $FS::Record::nowarn_classload=1;
1249     # really inefficient, but again, only has to run once
1250     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1251       my $and_batchnum_is_null =
1252         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1253       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1254       my $search = FS::Cursor->new({
1255         table     => $table,
1256         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1257                      "AND (paybatch IS NOT NULL ".
1258                      "OR (paybatch IS NULL AND auth IS NULL
1259                      $and_batchnum_is_null ) )
1260                      ORDER BY $pkey DESC"
1261       });
1262       while ( my $object = $search->fetch ) {
1263         if ( $object->paybatch eq '' ) {
1264           # repair for a previous upgrade that didn't save 'auth'
1265           my $pkey = $object->primary_key;
1266           # find the last history record that had a paybatch value
1267           my $h = qsearchs({
1268               table   => "h_$table",
1269               hashref => {
1270                 $pkey     => $object->$pkey,
1271                 paybatch  => { op=>'!=', value=>''},
1272                 history_action => 'replace_old',
1273               },
1274               order_by => 'ORDER BY history_date DESC LIMIT 1',
1275           });
1276           if (!$h) {
1277             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1278             next;
1279           }
1280           # if the paybatch didn't have an auth string, then it's fine
1281           $h->paybatch =~ /:(\w+):/ or next;
1282           # set paybatch to what it was in that record
1283           $object->set('paybatch', $h->paybatch)
1284           # and then upgrade it like the old records
1285         }
1286
1287         my $parsed = $object->_parse_paybatch;
1288         if (keys %$parsed) {
1289           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1290           $object->set('auth' => $parsed->{authorization});
1291           $object->set('paybatch', '');
1292           my $error = $object->replace;
1293           warn "error parsing CARD/CHEK paybatch fields on $object #".
1294             $object->get($object->primary_key).":\n  $error\n"
1295             if $error;
1296         }
1297       } #$object
1298     } #$table
1299     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1300   }
1301 }
1302
1303 =back
1304
1305 =head1 SUBROUTINES
1306
1307 =over 4
1308
1309 =item process_batch_import
1310
1311 =cut
1312
1313 sub process_batch_import {
1314   my $job = shift;
1315
1316   my $hashcb = sub {
1317     my %hash = @_;
1318     my $custnum = $hash{'custnum'};
1319     my $agentnum = $hash{'agentnum'};
1320     my $agent_custid = $hash{'agent_custid'};
1321     #standardize date
1322     $hash{'_date'} = parse_datetime($hash{'_date'})
1323       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1324     #remove custnum_prefix
1325     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1326     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1327     if (
1328       $custnum_prefix
1329       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1330       && length($1) == $custnum_length
1331     ) {
1332       $custnum = $2;
1333     }
1334     # check agentnum against custnum and
1335     # translate agent_custid into regular custnum
1336     if ($custnum && $agent_custid) {
1337       die "can't specify both custnum and agent_custid\n";
1338     } elsif ($agentnum || $agent_custid) {
1339       # here is the agent virtualization
1340       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1341       my %search;
1342       $search{'agentnum'} = $agentnum
1343         if $agentnum;
1344       $search{'agent_custid'} = $agent_custid
1345         if $agent_custid;
1346       $search{'custnum'} = $custnum
1347         if $custnum;
1348       my $cust_main = qsearchs({
1349         'table'     => 'cust_main',
1350         'hashref'   => \%search,
1351         'extra_sql' => $extra_sql,
1352       });
1353       die "can't find customer with" .
1354         ($agentnum ? " agentnum $agentnum" : '') .
1355         ($custnum  ? " custnum $custnum" : '') .
1356         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1357         unless $cust_main;
1358       die "mismatched customer number\n"
1359         if $custnum && ($custnum ne $cust_main->custnum);
1360       $custnum = $cust_main->custnum;
1361     }
1362     $hash{'custnum'} = $custnum;
1363     delete($hash{'agent_custid'});
1364     return %hash;
1365   };
1366
1367   my $opt = {
1368     'table'        => 'cust_pay',
1369     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1370                         #agent_custid isn't a cust_pay field, see hash callback
1371     'formats'      => { 'simple' =>
1372                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1373     'format_types' => { 'simple' => '' }, #force infer from file extension
1374     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1375     'format_hash_callbacks' => { 'simple' => $hashcb },
1376     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1377     'postinsert_callback'   => sub {
1378       my $cust_pay = shift;
1379       my $cust_main = $cust_pay->cust_main
1380                         or return "can't find customer to which payments apply";
1381       my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1382       return $error
1383                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1384                : '';
1385     },
1386   };
1387
1388   FS::Record::process_batch_import( $job, $opt, @_ );
1389
1390 }
1391
1392 =item batch_import HASHREF
1393
1394 Inserts new payments.
1395
1396 =cut
1397
1398 sub batch_import {
1399   my $param = shift;
1400
1401   my $fh       = $param->{filehandle};
1402   my $format   = $param->{'format'};
1403
1404   my $agentnum = $param->{agentnum};
1405   my $_date    = $param->{_date};
1406   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1407   my $paybatch = $param->{'paybatch'};
1408
1409   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1410   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1411
1412   # here is the agent virtualization
1413   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1414
1415   my @fields;
1416   my $payby;
1417   if ( $format eq 'simple' ) {
1418     @fields = qw( custnum agent_custid paid payinfo invnum );
1419     $payby = 'BILL';
1420   } elsif ( $format eq 'extended' ) {
1421     die "unimplemented\n";
1422     @fields = qw( );
1423     $payby = 'BILL';
1424   } else {
1425     die "unknown format $format";
1426   }
1427
1428   eval "use Text::CSV_XS;";
1429   die $@ if $@;
1430
1431   my $csv = new Text::CSV_XS;
1432
1433   my $imported = 0;
1434
1435   local $SIG{HUP} = 'IGNORE';
1436   local $SIG{INT} = 'IGNORE';
1437   local $SIG{QUIT} = 'IGNORE';
1438   local $SIG{TERM} = 'IGNORE';
1439   local $SIG{TSTP} = 'IGNORE';
1440   local $SIG{PIPE} = 'IGNORE';
1441
1442   my $oldAutoCommit = $FS::UID::AutoCommit;
1443   local $FS::UID::AutoCommit = 0;
1444   my $dbh = dbh;
1445
1446   my $line;
1447   while ( defined($line=<$fh>) ) {
1448
1449     $csv->parse($line) or do {
1450       $dbh->rollback if $oldAutoCommit;
1451       return "can't parse: ". $csv->error_input();
1452     };
1453
1454     my @columns = $csv->fields();
1455
1456     my %cust_pay = (
1457       payby    => $payby,
1458       paybatch => $paybatch,
1459     );
1460     $cust_pay{_date} = $_date if $_date;
1461
1462     my $cust_main;
1463     foreach my $field ( @fields ) {
1464
1465       if ( $field eq 'agent_custid'
1466         && $agentnum
1467         && $columns[0] =~ /\S+/ )
1468       {
1469
1470         my $agent_custid = $columns[0];
1471         my %hash = ( 'agent_custid' => $agent_custid,
1472                      'agentnum'     => $agentnum,
1473                    );
1474
1475         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1476           $dbh->rollback if $oldAutoCommit;
1477           return "can't specify custnum with agent_custid $agent_custid";
1478         }
1479
1480         $cust_main = qsearchs({
1481                                 'table'     => 'cust_main',
1482                                 'hashref'   => \%hash,
1483                                 'extra_sql' => $extra_sql,
1484                              });
1485
1486         unless ( $cust_main ) {
1487           $dbh->rollback if $oldAutoCommit;
1488           return "can't find customer with agent_custid $agent_custid";
1489         }
1490
1491         $field = 'custnum';
1492         $columns[0] = $cust_main->custnum;
1493       }
1494
1495       $cust_pay{$field} = shift @columns;
1496     }
1497
1498     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1499                          && length($1) == $custnum_length ) {
1500       $cust_pay{custnum} = $2;
1501     }
1502
1503     my $custnum = $cust_pay{custnum};
1504
1505     my $cust_pay = new FS::cust_pay( \%cust_pay );
1506     my $error = $cust_pay->insert;
1507
1508     if ( ! $error && $cust_pay->custnum != $custnum ) {
1509       #invnum was defined, and ->insert set custnum to the customer for that
1510       #invoice, but it wasn't the one the import specified.
1511       $dbh->rollback if $oldAutoCommit;
1512       $error = "specified invoice #". $cust_pay{invnum}.
1513                " is for custnum ". $cust_pay->custnum.
1514                ", not specified custnum $custnum";
1515     }
1516
1517     if ( $error ) {
1518       $dbh->rollback if $oldAutoCommit;
1519       return "can't insert payment for $line: $error";
1520     }
1521
1522     if ( $format eq 'simple' ) {
1523       # include agentnum for less surprise?
1524       $cust_main = qsearchs({
1525                              'table'     => 'cust_main',
1526                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1527                              'extra_sql' => $extra_sql,
1528                            })
1529         unless $cust_main;
1530
1531       unless ( $cust_main ) {
1532         $dbh->rollback if $oldAutoCommit;
1533         return "can't find customer to which payments apply at line: $line";
1534       }
1535
1536       $error = $cust_main->apply_payments_and_credits;
1537       if ( $error ) {
1538         $dbh->rollback if $oldAutoCommit;
1539         return "can't apply payments to customer for $line: $error";
1540       }
1541
1542     }
1543
1544     $imported++;
1545   }
1546
1547   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1548
1549   return "Empty file!" unless $imported;
1550
1551   ''; #no error
1552
1553 }
1554
1555 =back
1556
1557 =head1 BUGS
1558
1559 Delete and replace methods.
1560
1561 =head1 SEE ALSO
1562
1563 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1564 schema.html from the base documentation.
1565
1566 =cut
1567
1568 1;
1569