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