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