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