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