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