FS/FS/cust_pay.pm

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