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