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 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
 949
 950 =item refund_to_unapply
 951
 952 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
 953 (all currently applied refunds that aren't closed.)
 954 Returns empty list if payment itself is closed.
 955
 956 =cut
 957
 958 sub refund_to_unapply {
 959   my $self = shift;
 960   return () if $self->closed;
 961   qsearch({
 962     'table'   => 'cust_pay_refund',
 963     'hashref' => { 'paynum' => $self->paynum },
 964     'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
 965     'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
 966   });
 967 }
 968
 969 =item unapply_refund
 970
 971 Deletes all objects returned by L</refund_to_unapply>.
 972
 973 =cut
 974
 975 sub unapply_refund {
 976   my $self = shift;
 977
 978   local $SIG{HUP} = 'IGNORE';
 979   local $SIG{INT} = 'IGNORE';
 980   local $SIG{QUIT} = 'IGNORE';
 981   local $SIG{TERM} = 'IGNORE';
 982   local $SIG{TSTP} = 'IGNORE';
 983   local $SIG{PIPE} = 'IGNORE';
 984
 985   my $oldAutoCommit = $FS::UID::AutoCommit;
 986   local $FS::UID::AutoCommit = 0;
 987
 988   foreach my $cust_pay_refund ($self->refund_to_unapply) {
 989     my $error = $cust_pay_refund->delete;
 990     if ($error) {
 991       dbh->rollback if $oldAutoCommit;
 992       return $error;
 993     }
 994   }
 995
 996   dbh->commit or die dbh->errstr if $oldAutoCommit;
 997   return '';
 998 }
 999
1000 =back
1001
1002 =head1 CLASS METHODS
1003
1004 =over 4
1005
1006 =item batch_insert CUST_PAY_OBJECT, ...
1007
1008 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
1009 objects.  Returns a list, each element representing the status of inserting the
1010 corresponding payment - empty.  If there is an error inserting any payment, the
1011 entire transaction is rolled back, i.e. all payments are inserted or none are.
1012
1013 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1014 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
1015 those objects will be inserted with the paynum of the payment, and for
1016 each one, an error message or an empty string will be inserted into the
1017 list of errors.
1018
1019 For example:
1020
1021   my @errors = FS::cust_pay->batch_insert(@cust_pay);
1022   my $num_errors = scalar(grep $_, @errors);
1023   if ( $num_errors == 0 ) {
1024     #success; all payments were inserted
1025   } else {
1026     #failure; no payments were inserted.
1027   }
1028
1029 =cut
1030
1031 sub batch_insert {
1032   my $self = shift; #class method
1033
1034   local $SIG{HUP} = 'IGNORE';
1035   local $SIG{INT} = 'IGNORE';
1036   local $SIG{QUIT} = 'IGNORE';
1037   local $SIG{TERM} = 'IGNORE';
1038   local $SIG{TSTP} = 'IGNORE';
1039   local $SIG{PIPE} = 'IGNORE';
1040
1041   my $oldAutoCommit = $FS::UID::AutoCommit;
1042   local $FS::UID::AutoCommit = 0;
1043   my $dbh = dbh;
1044
1045   my $num_errors = 0;
1046
1047   my @errors;
1048   foreach my $cust_pay (@_) {
1049     my $error = $cust_pay->insert( 'manual' => 1 );
1050     push @errors, $error;
1051     $num_errors++ if $error;
1052
1053     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1054
1055       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1056         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1057           push @errors, '';
1058         }
1059         else {
1060           $cust_bill_pay->set('paynum', $cust_pay->paynum);
1061           my $apply_error = $cust_bill_pay->insert;
1062           push @errors, $apply_error || '';
1063           $num_errors++ if $apply_error;
1064         }
1065       }
1066
1067     } elsif ( !$error ) { #normal case: apply payments as usual
1068       $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1069     }
1070
1071   }
1072
1073   if ( $num_errors ) {
1074     $dbh->rollback if $oldAutoCommit;
1075   } else {
1076     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1077   }
1078
1079   @errors;
1080
1081 }
1082
1083 =item unapplied_sql
1084
1085 Returns an SQL fragment to retreive the unapplied amount.
1086
1087 =cut
1088
1089 sub unapplied_sql {
1090   my ($class, $start, $end) = @_;
1091   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
1092   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
1093   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1094   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
1095
1096   "paid
1097         - COALESCE(
1098                     ( SELECT SUM(amount) FROM cust_bill_pay
1099                         WHERE cust_pay.paynum = cust_bill_pay.paynum
1100                         $bill_start $bill_end )
1101                     ,0
1102                   )
1103         - COALESCE(
1104                     ( SELECT SUM(amount) FROM cust_pay_refund
1105                         WHERE cust_pay.paynum = cust_pay_refund.paynum
1106                         $refund_start $refund_end )
1107                     ,0
1108                   )
1109   ";
1110
1111 }
1112
1113 # _upgrade_data
1114 #
1115 # Used by FS::Upgrade to migrate to a new database.
1116
1117 use FS::h_cust_pay;
1118
1119 sub _upgrade_data {  #class method
1120   my ($class, %opt) = @_;
1121
1122   warn "$me upgrading $class\n" if $DEBUG;
1123
1124   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1125
1126   ##
1127   # otaker/ivan upgrade
1128   ##
1129
1130   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1131
1132     #not the most efficient, but hey, it only has to run once
1133
1134     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1135                 "  AND usernum IS NULL ".
1136                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
1137                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
1138
1139     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1140
1141     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1142     $sth->execute or die $sth->errstr;
1143     my $total = $sth->fetchrow_arrayref->[0];
1144     #warn "$total cust_pay records to update\n"
1145     #  if $DEBUG;
1146     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1147
1148     my $count = 0;
1149     my $lastprog = 0;
1150
1151     my @cust_pay = qsearch( {
1152         'table'     => 'cust_pay',
1153         'hashref'   => {},
1154         'extra_sql' => $where,
1155         'order_by'  => 'ORDER BY paynum',
1156     } );
1157
1158     foreach my $cust_pay (@cust_pay) {
1159
1160       my $h_cust_pay = $cust_pay->h_search('insert');
1161       if ( $h_cust_pay ) {
1162         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1163         #$cust_pay->otaker($h_cust_pay->history_user);
1164         $cust_pay->set('otaker', $h_cust_pay->history_user);
1165       } else {
1166         $cust_pay->set('otaker', 'legacy');
1167       }
1168
1169       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1170       my $error = $cust_pay->replace;
1171
1172       if ( $error ) {
1173         warn " *** WARNING: Error updating order taker for payment paynum ".
1174              $cust_pay->paynun. ": $error\n";
1175         next;
1176       }
1177
1178       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1179
1180       $count++;
1181       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1182         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1183         $lastprog = time;
1184       }
1185
1186     }
1187
1188     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1189   }
1190
1191   ###
1192   # payinfo N/A upgrade
1193   ###
1194
1195   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1196
1197     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1198
1199     my @na_cust_pay = qsearch( {
1200       'table'     => 'cust_pay',
1201       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1202       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1203     } );
1204
1205     foreach my $na ( @na_cust_pay ) {
1206
1207       next unless $na->payinfo eq 'N/A';
1208
1209       my $cust_pay_pending =
1210         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1211       unless ( $cust_pay_pending ) {
1212         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1213              $na->paynum. " (no cust_pay_pending)\n";
1214         next;
1215       }
1216       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1217       my $error = $na->replace;
1218       if ( $error ) {
1219         warn " *** WARNING: Error updating payinfo for payment paynum ".
1220              $na->paynun. ": $error\n";
1221         next;
1222       }
1223
1224     }
1225
1226     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1227   }
1228
1229   ###
1230   # otaker->usernum upgrade
1231   ###
1232
1233   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1234   $class->_upgrade_otaker(%opt);
1235   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1236
1237   # if we do this anywhere else, it should become an FS::Upgrade method
1238   my $num_to_upgrade = $class->count('paybatch is not null');
1239   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1240   if ( $num_to_upgrade > 0 ) {
1241     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1242     if ( $opt{queue} ) {
1243       if ( $num_jobs > 0 ) {
1244         warn "Upgrade already queued.\n";
1245       } else {
1246         warn "Scheduling upgrade.\n";
1247         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1248         $job->insert;
1249       }
1250     } else {
1251       process_upgrade_paybatch();
1252     }
1253   }
1254 }
1255
1256 sub process_upgrade_paybatch {
1257   my $dbh = dbh;
1258   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1259   local $FS::UID::AutoCommit = 1;
1260
1261   ###
1262   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1263   ###
1264   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1265   my $search = FS::Cursor->new( {
1266     'table'     => 'cust_pay',
1267     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1268   } );
1269   while (my $cust_pay = $search->fetch) {
1270     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1271     $cust_pay->set('paybatch' => '');
1272     my $error = $cust_pay->replace;
1273     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1274     if $error;
1275   }
1276
1277   ###
1278   # migrate gateway info from the misused 'paybatch' field
1279   ###
1280
1281   # not only cust_pay, but also voided and refunded payments
1282   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1283     local $FS::Record::nowarn_classload=1;
1284     # really inefficient, but again, only has to run once
1285     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1286       my $and_batchnum_is_null =
1287         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1288       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1289       my $search = FS::Cursor->new({
1290         table     => $table,
1291         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1292                      "AND (paybatch IS NOT NULL ".
1293                      "OR (paybatch IS NULL AND auth IS NULL
1294                      $and_batchnum_is_null ) )
1295                      ORDER BY $pkey DESC"
1296       });
1297       while ( my $object = $search->fetch ) {
1298         if ( $object->paybatch eq '' ) {
1299           # repair for a previous upgrade that didn't save 'auth'
1300           my $pkey = $object->primary_key;
1301           # find the last history record that had a paybatch value
1302           my $h = qsearchs({
1303               table   => "h_$table",
1304               hashref => {
1305                 $pkey     => $object->$pkey,
1306                 paybatch  => { op=>'!=', value=>''},
1307                 history_action => 'replace_old',
1308               },
1309               order_by => 'ORDER BY history_date DESC LIMIT 1',
1310           });
1311           if (!$h) {
1312             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1313             next;
1314           }
1315           # if the paybatch didn't have an auth string, then it's fine
1316           $h->paybatch =~ /:(\w+):/ or next;
1317           # set paybatch to what it was in that record
1318           $object->set('paybatch', $h->paybatch)
1319           # and then upgrade it like the old records
1320         }
1321
1322         my $parsed = $object->_parse_paybatch;
1323         if (keys %$parsed) {
1324           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1325           $object->set('auth' => $parsed->{authorization});
1326           $object->set('paybatch', '');
1327           my $error = $object->replace;
1328           warn "error parsing CARD/CHEK paybatch fields on $object #".
1329             $object->get($object->primary_key).":\n  $error\n"
1330             if $error;
1331         }
1332       } #$object
1333     } #$table
1334     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1335   }
1336 }
1337
1338 =back
1339
1340 =head1 SUBROUTINES
1341
1342 =over 4
1343
1344 =item process_batch_import
1345
1346 =cut
1347
1348 sub process_batch_import {
1349   my $job = shift;
1350
1351   my $hashcb = sub {
1352     my %hash = @_;
1353     my $custnum = $hash{'custnum'};
1354     my $agentnum = $hash{'agentnum'};
1355     my $agent_custid = $hash{'agent_custid'};
1356     #standardize date
1357     $hash{'_date'} = parse_datetime($hash{'_date'})
1358       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1359     #remove custnum_prefix
1360     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1361     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1362     if (
1363       $custnum_prefix
1364       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1365       && length($1) == $custnum_length
1366     ) {
1367       $custnum = $2;
1368     }
1369     # check agentnum against custnum and
1370     # translate agent_custid into regular custnum
1371     if ($custnum && $agent_custid) {
1372       die "can't specify both custnum and agent_custid\n";
1373     } elsif ($agentnum || $agent_custid) {
1374       # here is the agent virtualization
1375       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1376       my %search;
1377       $search{'agentnum'} = $agentnum
1378         if $agentnum;
1379       $search{'agent_custid'} = $agent_custid
1380         if $agent_custid;
1381       $search{'custnum'} = $custnum
1382         if $custnum;
1383       my $cust_main = qsearchs({
1384         'table'     => 'cust_main',
1385         'hashref'   => \%search,
1386         'extra_sql' => $extra_sql,
1387       });
1388       die "can't find customer with" .
1389         ($agentnum ? " agentnum $agentnum" : '') .
1390         ($custnum  ? " custnum $custnum" : '') .
1391         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1392         unless $cust_main;
1393       die "mismatched customer number\n"
1394         if $custnum && ($custnum ne $cust_main->custnum);
1395       $custnum = $cust_main->custnum;
1396     }
1397     $hash{'custnum'} = $custnum;
1398     delete($hash{'agent_custid'});
1399     return %hash;
1400   };
1401
1402   my $opt = {
1403     'table'        => 'cust_pay',
1404     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1405                         #agent_custid isn't a cust_pay field, see hash callback
1406     'formats'      => { 'simple' =>
1407                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1408     'format_types' => { 'simple' => '' }, #force infer from file extension
1409     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1410     'format_hash_callbacks' => { 'simple' => $hashcb },
1411     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1412     'postinsert_callback'   => sub {
1413       my $cust_pay = shift;
1414       my $cust_main = $cust_pay->cust_main
1415                         or return "can't find customer to which payments apply";
1416       my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1417       return $error
1418                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1419                : '';
1420     },
1421   };
1422
1423   FS::Record::process_batch_import( $job, $opt, @_ );
1424
1425 }
1426
1427 =item batch_import HASHREF
1428
1429 Inserts new payments.
1430
1431 =cut
1432
1433 sub batch_import {
1434   my $param = shift;
1435
1436   my $fh       = $param->{filehandle};
1437   my $format   = $param->{'format'};
1438
1439   my $agentnum = $param->{agentnum};
1440   my $_date    = $param->{_date};
1441   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1442   my $paybatch = $param->{'paybatch'};
1443
1444   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1445   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1446
1447   # here is the agent virtualization
1448   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1449
1450   my @fields;
1451   my $payby;
1452   if ( $format eq 'simple' ) {
1453     @fields = qw( custnum agent_custid paid payinfo invnum );
1454     $payby = 'BILL';
1455   } elsif ( $format eq 'extended' ) {
1456     die "unimplemented\n";
1457     @fields = qw( );
1458     $payby = 'BILL';
1459   } else {
1460     die "unknown format $format";
1461   }
1462
1463   eval "use Text::CSV_XS;";
1464   die $@ if $@;
1465
1466   my $csv = new Text::CSV_XS;
1467
1468   my $imported = 0;
1469
1470   local $SIG{HUP} = 'IGNORE';
1471   local $SIG{INT} = 'IGNORE';
1472   local $SIG{QUIT} = 'IGNORE';
1473   local $SIG{TERM} = 'IGNORE';
1474   local $SIG{TSTP} = 'IGNORE';
1475   local $SIG{PIPE} = 'IGNORE';
1476
1477   my $oldAutoCommit = $FS::UID::AutoCommit;
1478   local $FS::UID::AutoCommit = 0;
1479   my $dbh = dbh;
1480
1481   my $line;
1482   while ( defined($line=<$fh>) ) {
1483
1484     $csv->parse($line) or do {
1485       $dbh->rollback if $oldAutoCommit;
1486       return "can't parse: ". $csv->error_input();
1487     };
1488
1489     my @columns = $csv->fields();
1490
1491     my %cust_pay = (
1492       payby    => $payby,
1493       paybatch => $paybatch,
1494     );
1495     $cust_pay{_date} = $_date if $_date;
1496
1497     my $cust_main;
1498     foreach my $field ( @fields ) {
1499
1500       if ( $field eq 'agent_custid'
1501         && $agentnum
1502         && $columns[0] =~ /\S+/ )
1503       {
1504
1505         my $agent_custid = $columns[0];
1506         my %hash = ( 'agent_custid' => $agent_custid,
1507                      'agentnum'     => $agentnum,
1508                    );
1509
1510         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1511           $dbh->rollback if $oldAutoCommit;
1512           return "can't specify custnum with agent_custid $agent_custid";
1513         }
1514
1515         $cust_main = qsearchs({
1516                                 'table'     => 'cust_main',
1517                                 'hashref'   => \%hash,
1518                                 'extra_sql' => $extra_sql,
1519                              });
1520
1521         unless ( $cust_main ) {
1522           $dbh->rollback if $oldAutoCommit;
1523           return "can't find customer with agent_custid $agent_custid";
1524         }
1525
1526         $field = 'custnum';
1527         $columns[0] = $cust_main->custnum;
1528       }
1529
1530       $cust_pay{$field} = shift @columns;
1531     }
1532
1533     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1534                          && length($1) == $custnum_length ) {
1535       $cust_pay{custnum} = $2;
1536     }
1537
1538     my $custnum = $cust_pay{custnum};
1539
1540     my $cust_pay = new FS::cust_pay( \%cust_pay );
1541     my $error = $cust_pay->insert;
1542
1543     if ( ! $error && $cust_pay->custnum != $custnum ) {
1544       #invnum was defined, and ->insert set custnum to the customer for that
1545       #invoice, but it wasn't the one the import specified.
1546       $dbh->rollback if $oldAutoCommit;
1547       $error = "specified invoice #". $cust_pay{invnum}.
1548                " is for custnum ". $cust_pay->custnum.
1549                ", not specified custnum $custnum";
1550     }
1551
1552     if ( $error ) {
1553       $dbh->rollback if $oldAutoCommit;
1554       return "can't insert payment for $line: $error";
1555     }
1556
1557     if ( $format eq 'simple' ) {
1558       # include agentnum for less surprise?
1559       $cust_main = qsearchs({
1560                              'table'     => 'cust_main',
1561                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1562                              'extra_sql' => $extra_sql,
1563                            })
1564         unless $cust_main;
1565
1566       unless ( $cust_main ) {
1567         $dbh->rollback if $oldAutoCommit;
1568         return "can't find customer to which payments apply at line: $line";
1569       }
1570
1571       $error = $cust_main->apply_payments_and_credits;
1572       if ( $error ) {
1573         $dbh->rollback if $oldAutoCommit;
1574         return "can't apply payments to customer for $line: $error";
1575       }
1576
1577     }
1578
1579     $imported++;
1580   }
1581
1582   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1583
1584   return "Empty file!" unless $imported;
1585
1586   ''; #no error
1587
1588 }
1589
1590 =back
1591
1592 =head1 BUGS
1593
1594 Delete and replace methods.
1595
1596 =head1 SEE ALSO
1597
1598 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1599 schema.html from the base documentation.
1600
1601 =cut
1602
1603 1;
1604