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