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