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