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