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     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 666     if ( $msgnum ) {
 667
 668       my %substitutions = ();
 669       $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 670
 671       my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
 672       unless ($msg_template) {
 673         warn "send_receipt could not load msg_template";
 674         return;
 675       }
 676
 677       my $cust_msg = $msg_template->prepare(
 678           'cust_main'     => $cust_main,
 679           'object'        => $self,
 680           'from_config'   => 'payment_receipt_from',
 681           'substitutions' => \%substitutions,
 682           'msgtype'       => 'receipt',
 683       );
 684       $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
 685       if ($error) {
 686         warn "send_receipt: $error";
 687         return;
 688       }
 689
 690       my $queue = new FS::queue {
 691         'job'     => 'FS::cust_msg::process_send',
 692         'paynum'  => $self->paynum,
 693         'custnum' => $cust_main->custnum,
 694       };
 695       $error = $queue->insert( $cust_msg->custmsgnum );
 696
 697     } else {
 698
 699       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 700
 701     }
 702
 703   #not manual and no noemail flag (here or on the customer)
 704   } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
 705
 706     # check to see if they want to send specific message template as receipt for auto payments
 707     my $msgnum = $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum);
 708     if ( $msgnum ) {
 709
 710       my %substitutions = ();
 711       $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
 712
 713       my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
 714       unless ($msg_template) {
 715         warn "send_receipt could not load msg_template";
 716         return;
 717       }
 718
 719       my $cust_msg = $msg_template->prepare(
 720           'cust_main'     => $cust_main,
 721           'object'        => $self,
 722           'from_config'   => 'payment_receipt_from',
 723           'substitutions' => \%substitutions,
 724           'msgtype'       => 'receipt',
 725       );
 726       $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
 727       if ($error) {
 728         warn "send_receipt: $error";
 729         return;
 730       }
 731
 732       my $queue = new FS::queue {
 733         'job'     => 'FS::cust_msg::process_send',
 734         'paynum'  => $self->paynum,
 735         'custnum' => $cust_main->custnum,
 736       };
 737       $error = $queue->insert( $cust_msg->custmsgnum );
 738
 739     }
 740     else {
 741       my $queue = new FS::queue {
 742         'job'     => 'FS::cust_bill::queueable_email',
 743         'paynum'  => $self->paynum,
 744         'custnum' => $cust_main->custnum,
 745       };
 746
 747       my %opt = (
 748         'invnum'      => $cust_bill->invnum,
 749         'no_coupon'   => 1,
 750       );
 751
 752       if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
 753         $opt{'mode'} = $mode;
 754       } else {
 755         # backward compatibility, no good fix for this yet as some people may
 756         # still have "invoice_latex_statement" and such options
 757         $opt{'template'} = 'statement';
 758         $opt{'notice_name'} = 'Statement';
 759       }
 760
 761       $error = $queue->insert(%opt);
 762     }
 763
 764
 765
 766   }
 767
 768   warn "send_receipt: $error\n" if $error;
 769 }
 770
 771 =item cust_bill_pay
 772
 773 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 774 payment.
 775
 776 =cut
 777
 778 sub cust_bill_pay {
 779   my $self = shift;
 780   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 781   sort {    $a->_date  <=> $b->_date
 782          || $a->invnum <=> $b->invnum }
 783     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 784   ;
 785 }
 786
 787 =item cust_pay_refund
 788
 789 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 790 payment.
 791
 792 =cut
 793
 794 sub cust_pay_refund {
 795   my $self = shift;
 796   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 797   sort { $a->_date <=> $b->_date }
 798     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 799   ;
 800 }
 801
 802
 803 =item unapplied
 804
 805 Returns the amount of this payment that is still unapplied; which is
 806 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 807 applications (see L<FS::cust_pay_refund>).
 808
 809 =cut
 810
 811 sub unapplied {
 812   my $self = shift;
 813   my $amount = $self->paid;
 814   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 815   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 816   sprintf("%.2f", $amount );
 817 }
 818
 819 =item unrefunded
 820
 821 Returns the amount of this payment that has not been refuned; which is
 822 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 823
 824 =cut
 825
 826 sub unrefunded {
 827   my $self = shift;
 828   my $amount = $self->paid;
 829   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 830   sprintf("%.2f", $amount );
 831 }
 832
 833 =item amount
 834
 835 Returns the "paid" field.
 836
 837 =cut
 838
 839 sub amount {
 840   my $self = shift;
 841   $self->paid();
 842 }
 843
 844 =item delete_cust_bill_pay OPTIONS
 845
 846 Deletes all associated cust_bill_pay records.
 847
 848 If option 'unapplied' is a specified, only deletes until
 849 this object's 'unapplied' value is >= the specified amount.
 850 (Deletes in order returned by L</cust_bill_pay>.)
 851
 852 =cut
 853
 854 sub delete_cust_bill_pay {
 855   my $self = shift;
 856   my %opt = @_;
 857
 858   local $SIG{HUP} = 'IGNORE';
 859   local $SIG{INT} = 'IGNORE';
 860   local $SIG{QUIT} = 'IGNORE';
 861   local $SIG{TERM} = 'IGNORE';
 862   local $SIG{TSTP} = 'IGNORE';
 863   local $SIG{PIPE} = 'IGNORE';
 864
 865   my $oldAutoCommit = $FS::UID::AutoCommit;
 866   local $FS::UID::AutoCommit = 0;
 867   my $dbh = dbh;
 868
 869   my $unapplied = $self->unapplied; #only need to look it up once
 870
 871   my $error = '';
 872
 873   # Maybe we should reverse the order these get deleted in?
 874   # ie delete newest first?
 875   # keeping consistent with how bop refunds work, for now...
 876   foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
 877     last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
 878     $unapplied += $cust_bill_pay->amount;
 879     $error = $cust_bill_pay->delete;
 880     last if $error;
 881   }
 882
 883   if ($error) {
 884     $dbh->rollback if $oldAutoCommit;
 885     return $error;
 886   }
 887
 888   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 889   return '';
 890 }
 891
 892 =item refund HASHREF
 893
 894 Accepts input for creating a new FS::cust_refund object.
 895 Unapplies payment from invoices up to the amount of the refund,
 896 creates the refund and applies payment to refund.  Allows entire
 897 process to be handled in one transaction.
 898
 899 Causes a fatal error if called on CARD or CHEK payments.
 900
 901 =cut
 902
 903 sub refund {
 904   my $self = shift;
 905   my $hash = shift;
 906   die "Cannot call cust_pay->refund on " . $self->payby
 907     if grep { $_ eq $self->payby } qw(CARD CHEK);
 908
 909   local $SIG{HUP} = 'IGNORE';
 910   local $SIG{INT} = 'IGNORE';
 911   local $SIG{QUIT} = 'IGNORE';
 912   local $SIG{TERM} = 'IGNORE';
 913   local $SIG{TSTP} = 'IGNORE';
 914   local $SIG{PIPE} = 'IGNORE';
 915
 916   my $oldAutoCommit = $FS::UID::AutoCommit;
 917   local $FS::UID::AutoCommit = 0;
 918   my $dbh = dbh;
 919
 920   my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
 921
 922   if ($error) {
 923     $dbh->rollback if $oldAutoCommit;
 924     return $error;
 925   }
 926
 927   $hash->{'paynum'} = $self->paynum;
 928   my $new = new FS::cust_refund ( $hash );
 929   $error = $new->insert;
 930
 931   if ($error) {
 932     $dbh->rollback if $oldAutoCommit;
 933     return $error;
 934   }
 935
 936   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 937   return '';
 938 }
 939
 940 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
 941
 942 =item refund_to_unapply
 943
 944 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
 945 (all currently applied refunds that aren't closed.)
 946 Returns empty list if payment itself is closed.
 947
 948 =cut
 949
 950 sub refund_to_unapply {
 951   my $self = shift;
 952   return () if $self->closed;
 953   qsearch({
 954     'table'   => 'cust_pay_refund',
 955     'hashref' => { 'paynum' => $self->paynum },
 956     'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
 957     'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
 958   });
 959 }
 960
 961 =item unapply_refund
 962
 963 Deletes all objects returned by L</refund_to_unapply>.
 964
 965 =cut
 966
 967 sub unapply_refund {
 968   my $self = shift;
 969
 970   local $SIG{HUP} = 'IGNORE';
 971   local $SIG{INT} = 'IGNORE';
 972   local $SIG{QUIT} = 'IGNORE';
 973   local $SIG{TERM} = 'IGNORE';
 974   local $SIG{TSTP} = 'IGNORE';
 975   local $SIG{PIPE} = 'IGNORE';
 976
 977   my $oldAutoCommit = $FS::UID::AutoCommit;
 978   local $FS::UID::AutoCommit = 0;
 979
 980   foreach my $cust_pay_refund ($self->refund_to_unapply) {
 981     my $error = $cust_pay_refund->delete;
 982     if ($error) {
 983       dbh->rollback if $oldAutoCommit;
 984       return $error;
 985     }
 986   }
 987
 988   dbh->commit or die dbh->errstr if $oldAutoCommit;
 989   return '';
 990 }
 991
 992 =back
 993
 994 =head1 CLASS METHODS
 995
 996 =over 4
 997
 998 =item batch_insert CUST_PAY_OBJECT, ...
 999
1000 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
1001 objects.  Returns a list, each element representing the status of inserting the
1002 corresponding payment - empty.  If there is an error inserting any payment, the
1003 entire transaction is rolled back, i.e. all payments are inserted or none are.
1004
1005 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1006 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
1007 those objects will be inserted with the paynum of the payment, and for
1008 each one, an error message or an empty string will be inserted into the
1009 list of errors.
1010
1011 For example:
1012
1013   my @errors = FS::cust_pay->batch_insert(@cust_pay);
1014   my $num_errors = scalar(grep $_, @errors);
1015   if ( $num_errors == 0 ) {
1016     #success; all payments were inserted
1017   } else {
1018     #failure; no payments were inserted.
1019   }
1020
1021 =cut
1022
1023 sub batch_insert {
1024   my $self = shift; #class method
1025
1026   local $SIG{HUP} = 'IGNORE';
1027   local $SIG{INT} = 'IGNORE';
1028   local $SIG{QUIT} = 'IGNORE';
1029   local $SIG{TERM} = 'IGNORE';
1030   local $SIG{TSTP} = 'IGNORE';
1031   local $SIG{PIPE} = 'IGNORE';
1032
1033   my $oldAutoCommit = $FS::UID::AutoCommit;
1034   local $FS::UID::AutoCommit = 0;
1035   my $dbh = dbh;
1036
1037   my $num_errors = 0;
1038
1039   my @errors;
1040   foreach my $cust_pay (@_) {
1041     my $error = $cust_pay->insert( 'manual' => 1 );
1042     push @errors, $error;
1043     $num_errors++ if $error;
1044
1045     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1046
1047       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1048         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1049           push @errors, '';
1050         }
1051         else {
1052           $cust_bill_pay->set('paynum', $cust_pay->paynum);
1053           my $apply_error = $cust_bill_pay->insert;
1054           push @errors, $apply_error || '';
1055           $num_errors++ if $apply_error;
1056         }
1057       }
1058
1059     } elsif ( !$error ) { #normal case: apply payments as usual
1060       $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1061     }
1062
1063   }
1064
1065   if ( $num_errors ) {
1066     $dbh->rollback if $oldAutoCommit;
1067   } else {
1068     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1069   }
1070
1071   @errors;
1072
1073 }
1074
1075 =item unapplied_sql
1076
1077 Returns an SQL fragment to retreive the unapplied amount.
1078
1079 =cut
1080
1081 sub unapplied_sql {
1082   my ($class, $start, $end) = @_;
1083   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
1084   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
1085   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1086   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
1087
1088   "paid
1089         - COALESCE(
1090                     ( SELECT SUM(amount) FROM cust_bill_pay
1091                         WHERE cust_pay.paynum = cust_bill_pay.paynum
1092                         $bill_start $bill_end )
1093                     ,0
1094                   )
1095         - COALESCE(
1096                     ( SELECT SUM(amount) FROM cust_pay_refund
1097                         WHERE cust_pay.paynum = cust_pay_refund.paynum
1098                         $refund_start $refund_end )
1099                     ,0
1100                   )
1101   ";
1102
1103 }
1104
1105 sub API_getinfo {
1106  my $self = shift;
1107  my @fields = grep { $_ ne 'payinfo' } $self->fields;
1108  +{ ( map { $_=>$self->$_ } @fields ),
1109   };
1110 }
1111
1112 =item SSAPI_getinfo
1113
1114 =cut
1115
1116 sub SSAPI_getinfo {
1117   #my( $self, %opt ) = @_;
1118   my $self = shift;
1119
1120   +{ 'paynum'       => $self->paynum,
1121      '_date'        => $self->_date,
1122      'date'         => time2str("%b %o, %Y", $self->_date),
1123      'date_short'   => time2str("%m-%d-%Y",  $self->_date),
1124      'paid'         => sprintf('%.2f', $self->paid),
1125      'payby'        => $self->payby,
1126      'paycardtype'  => $self->paycardtype,
1127      'paymask'      => $self->paymask,
1128      'processor'    => $self->processor,
1129      'auth'         => $self->auth,
1130      'order_number' => $self->order_number,
1131   };
1132
1133 }
1134
1135
1136 # _upgrade_data
1137 #
1138 # Used by FS::Upgrade to migrate to a new database.
1139
1140 use FS::h_cust_pay;
1141
1142 sub _upgrade_data {  #class method
1143   my ($class, %opt) = @_;
1144
1145   warn "$me upgrading $class\n" if $DEBUG;
1146
1147   $class->_upgrade_reasonnum(%opt);
1148
1149   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1150
1151   ##
1152   # otaker/ivan upgrade
1153   ##
1154
1155   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1156
1157     #not the most efficient, but hey, it only has to run once
1158
1159     my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1160                     AND usernum IS NULL
1161                     AND EXISTS ( SELECT 1 FROM cust_main
1162                                    WHERE cust_main.custnum = cust_pay.custnum )
1163                 ";
1164
1165     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1166
1167     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1168     $sth->execute or die $sth->errstr;
1169     my $total = $sth->fetchrow_arrayref->[0];
1170     #warn "$total cust_pay records to update\n"
1171     #  if $DEBUG;
1172     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1173
1174     my $count = 0;
1175     my $lastprog = 0;
1176
1177     my @cust_pay = qsearch( {
1178         'table'     => 'cust_pay',
1179         'hashref'   => {},
1180         'extra_sql' => $where,
1181         'order_by'  => 'ORDER BY paynum',
1182     } );
1183
1184     foreach my $cust_pay (@cust_pay) {
1185
1186       my $h_cust_pay = $cust_pay->h_search('insert');
1187       if ( $h_cust_pay ) {
1188         next if $cust_pay->otaker eq $h_cust_pay->history_user;
1189         #$cust_pay->otaker($h_cust_pay->history_user);
1190         $cust_pay->set('otaker', $h_cust_pay->history_user);
1191       } else {
1192         $cust_pay->set('otaker', 'legacy');
1193       }
1194
1195       my $error = $cust_pay->replace;
1196
1197       if ( $error ) {
1198         warn " *** WARNING: Error updating order taker for payment paynum ".
1199              $cust_pay->paynun. ": $error\n";
1200         next;
1201       }
1202
1203       $count++;
1204       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1205         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1206         $lastprog = time;
1207       }
1208
1209     }
1210
1211     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1212   }
1213
1214   ###
1215   # payinfo N/A upgrade
1216   ###
1217
1218   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1219
1220     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1221
1222     my @na_cust_pay = qsearch( {
1223       'table'     => 'cust_pay',
1224       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1225       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1226     } );
1227
1228     foreach my $na ( @na_cust_pay ) {
1229
1230       next unless $na->payinfo eq 'N/A';
1231
1232       my $cust_pay_pending =
1233         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1234       unless ( $cust_pay_pending ) {
1235         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1236              $na->paynum. " (no cust_pay_pending)\n";
1237         next;
1238       }
1239       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1240       my $error = $na->replace;
1241       if ( $error ) {
1242         warn " *** WARNING: Error updating payinfo for payment paynum ".
1243              $na->paynun. ": $error\n";
1244         next;
1245       }
1246
1247     }
1248
1249     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1250   }
1251
1252   ###
1253   # otaker->usernum upgrade
1254   ###
1255
1256   $class->_upgrade_otaker(%opt);
1257
1258   # if we do this anywhere else, it should become an FS::Upgrade method
1259   my $num_to_upgrade = $class->count('paybatch is not null');
1260   my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1261   if ( $num_to_upgrade > 0 ) {
1262     warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1263     if ( $opt{queue} ) {
1264       if ( $num_jobs > 0 ) {
1265         warn "Upgrade already queued.\n";
1266       } else {
1267         warn "Scheduling upgrade.\n";
1268         my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1269         $job->insert;
1270       }
1271     } else {
1272       process_upgrade_paybatch();
1273     }
1274   }
1275
1276   ###
1277   # set paycardtype
1278   ###
1279   $class->upgrade_set_cardtype;
1280
1281   # for batch payments, make sure paymask is set
1282   do {
1283     local $FS::payinfo_Mixin::allow_closed_replace = 1;
1284     local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1285
1286     my $cursor = FS::Cursor->new({
1287       table => 'cust_pay',
1288       extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1289                     AND payby IN(\'CARD\', \'CHEK\')
1290                     AND batchnum IS NOT NULL',
1291     });
1292
1293     # records from cursors for some reason don't decrypt payinfo, so
1294     # call replace_old to fetch the record "normally"
1295     while (my $cust_pay = $cursor->fetch) {
1296       $cust_pay = $cust_pay->replace_old;
1297       $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1298       my $error = $cust_pay->replace;
1299       if ($error) {
1300         die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1301           ")\n"
1302       }
1303     }
1304   };
1305 }
1306
1307 sub process_upgrade_paybatch {
1308   my $dbh = dbh;
1309   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1310   local $FS::UID::AutoCommit = 1;
1311
1312   ###
1313   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1314   ###
1315   my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1316   my $search = FS::Cursor->new( {
1317     'table'     => 'cust_pay',
1318     'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1319   } );
1320   while (my $cust_pay = $search->fetch) {
1321     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1322     $cust_pay->set('paybatch' => '');
1323     my $error = $cust_pay->replace;
1324     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1325     if $error;
1326   }
1327
1328   ###
1329   # migrate gateway info from the misused 'paybatch' field
1330   ###
1331
1332   # not only cust_pay, but also voided and refunded payments
1333   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1334     local $FS::Record::nowarn_classload=1;
1335     # really inefficient, but again, only has to run once
1336     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1337       my $and_batchnum_is_null =
1338         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1339       my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1340       my $search = FS::Cursor->new({
1341         table     => $table,
1342         extra_sql => "WHERE payby IN('CARD','CHEK') ".
1343                      "AND (paybatch IS NOT NULL ".
1344                      "OR (paybatch IS NULL AND auth IS NULL
1345                      $and_batchnum_is_null ) )
1346                      ORDER BY $pkey DESC"
1347       });
1348       while ( my $object = $search->fetch ) {
1349         if ( $object->paybatch eq '' ) {
1350           # repair for a previous upgrade that didn't save 'auth'
1351           my $pkey = $object->primary_key;
1352           # find the last history record that had a paybatch value
1353           my $h = qsearchs({
1354               table   => "h_$table",
1355               hashref => {
1356                 $pkey     => $object->$pkey,
1357                 paybatch  => { op=>'!=', value=>''},
1358                 history_action => 'replace_old',
1359               },
1360               order_by => 'ORDER BY history_date DESC LIMIT 1',
1361           });
1362           if (!$h) {
1363             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1364             next;
1365           }
1366           # if the paybatch didn't have an auth string, then it's fine
1367           $h->paybatch =~ /:(\w+):/ or next;
1368           # set paybatch to what it was in that record
1369           $object->set('paybatch', $h->paybatch)
1370           # and then upgrade it like the old records
1371         }
1372
1373         my $parsed = $object->_parse_paybatch;
1374         if (keys %$parsed) {
1375           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1376           $object->set('auth' => $parsed->{authorization});
1377           $object->set('paybatch', '');
1378           my $error = $object->replace;
1379           warn "error parsing CARD/CHEK paybatch fields on $object #".
1380             $object->get($object->primary_key).":\n  $error\n"
1381             if $error;
1382         }
1383       } #$object
1384     } #$table
1385     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1386   }
1387 }
1388
1389 =back
1390
1391 =head1 SUBROUTINES
1392
1393 =over 4
1394
1395 =item process_batch_import
1396
1397 =cut
1398
1399 sub process_batch_import {
1400   my $job = shift;
1401
1402   my $hashcb = sub {
1403     my %hash = @_;
1404     my $custnum = $hash{'custnum'};
1405     my $agentnum = $hash{'agentnum'};
1406     my $agent_custid = $hash{'agent_custid'};
1407     #standardize date
1408     $hash{'_date'} = parse_datetime($hash{'_date'})
1409       if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1410     #remove custnum_prefix
1411     my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1412     my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1413     if (
1414       $custnum_prefix
1415       && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1416       && length($1) == $custnum_length
1417     ) {
1418       $custnum = $2;
1419     }
1420     # check agentnum against custnum and
1421     # translate agent_custid into regular custnum
1422     if ($custnum && $agent_custid) {
1423       die "can't specify both custnum and agent_custid\n";
1424     } elsif ($agentnum || $agent_custid) {
1425       # here is the agent virtualization
1426       my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1427       my %search;
1428       $search{'agentnum'} = $agentnum
1429         if $agentnum;
1430       $search{'agent_custid'} = $agent_custid
1431         if $agent_custid;
1432       $search{'custnum'} = $custnum
1433         if $custnum;
1434       my $cust_main = qsearchs({
1435         'table'     => 'cust_main',
1436         'hashref'   => \%search,
1437         'extra_sql' => $extra_sql,
1438       });
1439       die "can't find customer with" .
1440         ($agentnum ? " agentnum $agentnum" : '') .
1441         ($custnum  ? " custnum $custnum" : '') .
1442         ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1443         unless $cust_main;
1444       die "mismatched customer number\n"
1445         if $custnum && ($custnum ne $cust_main->custnum);
1446       $custnum = $cust_main->custnum;
1447     }
1448     $hash{'custnum'} = $custnum;
1449     delete($hash{'agent_custid'});
1450     return %hash;
1451   };
1452
1453   my $opt = {
1454     'table'        => 'cust_pay',
1455     'params'       => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1456                         #agent_custid isn't a cust_pay field, see hash callback
1457     'formats'      => { 'simple' =>
1458                           [ qw(custnum agent_custid paid payinfo invnum) ] },
1459     'format_types' => { 'simple' => '' }, #force infer from file extension
1460     'default_csv'  => 1, #if not .xls, will read as csv, regardless of extension
1461     'format_hash_callbacks' => { 'simple' => $hashcb },
1462     'insert_args_callback'  => sub { ( 'manual'=>1 ); },
1463     'postinsert_callback'   => sub {
1464       my $cust_pay = shift;
1465       my $cust_main = $cust_pay->cust_main
1466                         or return "can't find customer to which payments apply";
1467       my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1468       return $error
1469                ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1470                : '';
1471     },
1472   };
1473
1474   FS::Record::process_batch_import( $job, $opt, @_ );
1475
1476 }
1477
1478 =item batch_import HASHREF
1479
1480 Inserts new payments.
1481
1482 =cut
1483
1484 sub batch_import {
1485   my $param = shift;
1486
1487   my $fh       = $param->{filehandle};
1488   my $format   = $param->{'format'};
1489
1490   my $agentnum = $param->{agentnum};
1491   my $_date    = $param->{_date};
1492   $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1493   my $paybatch = $param->{'paybatch'};
1494
1495   my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1496   my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1497
1498   # here is the agent virtualization
1499   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1500
1501   my @fields;
1502   my $payby;
1503   if ( $format eq 'simple' ) {
1504     @fields = qw( custnum agent_custid paid payinfo invnum );
1505     $payby = 'BILL';
1506   } elsif ( $format eq 'extended' ) {
1507     die "unimplemented\n";
1508     @fields = qw( );
1509     $payby = 'BILL';
1510   } else {
1511     die "unknown format $format";
1512   }
1513
1514   eval "use Text::CSV_XS;";
1515   die $@ if $@;
1516
1517   my $csv = new Text::CSV_XS;
1518
1519   my $imported = 0;
1520
1521   local $SIG{HUP} = 'IGNORE';
1522   local $SIG{INT} = 'IGNORE';
1523   local $SIG{QUIT} = 'IGNORE';
1524   local $SIG{TERM} = 'IGNORE';
1525   local $SIG{TSTP} = 'IGNORE';
1526   local $SIG{PIPE} = 'IGNORE';
1527
1528   my $oldAutoCommit = $FS::UID::AutoCommit;
1529   local $FS::UID::AutoCommit = 0;
1530   my $dbh = dbh;
1531
1532   my $line;
1533   while ( defined($line=<$fh>) ) {
1534
1535     $csv->parse($line) or do {
1536       $dbh->rollback if $oldAutoCommit;
1537       return "can't parse: ". $csv->error_input();
1538     };
1539
1540     my @columns = $csv->fields();
1541
1542     my %cust_pay = (
1543       payby    => $payby,
1544       paybatch => $paybatch,
1545     );
1546     $cust_pay{_date} = $_date if $_date;
1547
1548     my $cust_main;
1549     foreach my $field ( @fields ) {
1550
1551       if ( $field eq 'agent_custid'
1552         && $agentnum
1553         && $columns[0] =~ /\S+/ )
1554       {
1555
1556         my $agent_custid = $columns[0];
1557         my %hash = ( 'agent_custid' => $agent_custid,
1558                      'agentnum'     => $agentnum,
1559                    );
1560
1561         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1562           $dbh->rollback if $oldAutoCommit;
1563           return "can't specify custnum with agent_custid $agent_custid";
1564         }
1565
1566         $cust_main = qsearchs({
1567                                 'table'     => 'cust_main',
1568                                 'hashref'   => \%hash,
1569                                 'extra_sql' => $extra_sql,
1570                              });
1571
1572         unless ( $cust_main ) {
1573           $dbh->rollback if $oldAutoCommit;
1574           return "can't find customer with agent_custid $agent_custid";
1575         }
1576
1577         $field = 'custnum';
1578         $columns[0] = $cust_main->custnum;
1579       }
1580
1581       $cust_pay{$field} = shift @columns;
1582     }
1583
1584     if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1585                          && length($1) == $custnum_length ) {
1586       $cust_pay{custnum} = $2;
1587     }
1588
1589     my $custnum = $cust_pay{custnum};
1590
1591     my $cust_pay = new FS::cust_pay( \%cust_pay );
1592     my $error = $cust_pay->insert;
1593
1594     if ( ! $error && $cust_pay->custnum != $custnum ) {
1595       #invnum was defined, and ->insert set custnum to the customer for that
1596       #invoice, but it wasn't the one the import specified.
1597       $dbh->rollback if $oldAutoCommit;
1598       $error = "specified invoice #". $cust_pay{invnum}.
1599                " is for custnum ". $cust_pay->custnum.
1600                ", not specified custnum $custnum";
1601     }
1602
1603     if ( $error ) {
1604       $dbh->rollback if $oldAutoCommit;
1605       return "can't insert payment for $line: $error";
1606     }
1607
1608     if ( $format eq 'simple' ) {
1609       # include agentnum for less surprise?
1610       $cust_main = qsearchs({
1611                              'table'     => 'cust_main',
1612                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1613                              'extra_sql' => $extra_sql,
1614                            })
1615         unless $cust_main;
1616
1617       unless ( $cust_main ) {
1618         $dbh->rollback if $oldAutoCommit;
1619         return "can't find customer to which payments apply at line: $line";
1620       }
1621
1622       $error = $cust_main->apply_payments_and_credits;
1623       if ( $error ) {
1624         $dbh->rollback if $oldAutoCommit;
1625         return "can't apply payments to customer for $line: $error";
1626       }
1627
1628     }
1629
1630     $imported++;
1631   }
1632
1633   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1634
1635   return "Empty file!" unless $imported;
1636
1637   ''; #no error
1638
1639 }
1640
1641 =back
1642
1643 =head1 BUGS
1644
1645 Delete and replace methods.
1646
1647 =head1 SEE ALSO
1648
1649 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1650 schema.html from the base documentation.
1651
1652 =cut
1653
1654 1;
1655