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