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