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              $unsuspendauto $ignore_noapply
   8            );
   9 use Date::Format;
  10 use Business::CreditCard;
  11 use Text::Template;
  12 use FS::Record qw( dbh qsearch qsearchs );
  13 use FS::CurrentUser;
  14 use FS::payby;
  15 use FS::cust_main_Mixin;
  16 use FS::payinfo_transaction_Mixin;
  17 use FS::cust_bill;
  18 use FS::cust_bill_pay;
  19 use FS::cust_pay_refund;
  20 use FS::cust_main;
  21 use FS::cust_pkg;
  22 use FS::cust_pay_void;
  23 use FS::upgrade_journal;
  24
  25 $DEBUG = 0;
  26
  27 $me = '[FS::cust_pay]';
  28
  29 $ignore_noapply = 0;
  30
  31 #ask FS::UID to run this stuff for us later
  32 FS::UID->install_callback( sub {
  33   $conf = new FS::Conf;
  34   $unsuspendauto = $conf->exists('unsuspendauto');
  35 } );
  36
  37 @encrypted_fields = ('payinfo');
  38
  39 =head1 NAME
  40
  41 FS::cust_pay - Object methods for cust_pay objects
  42
  43 =head1 SYNOPSIS
  44
  45   use FS::cust_pay;
  46
  47   $record = new FS::cust_pay \%hash;
  48   $record = new FS::cust_pay { 'column' => 'value' };
  49
  50   $error = $record->insert;
  51
  52   $error = $new_record->replace($old_record);
  53
  54   $error = $record->delete;
  55
  56   $error = $record->check;
  57
  58 =head1 DESCRIPTION
  59
  60 An FS::cust_pay object represents a payment; the transfer of money from a
  61 customer.  FS::cust_pay inherits from FS::Record.  The following fields are
  62 currently supported:
  63
  64 =over 4
  65
  66 =item paynum
  67
  68 primary key (assigned automatically for new payments)
  69
  70 =item custnum
  71
  72 customer (see L<FS::cust_main>)
  73
  74 =item _date
  75
  76 specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  77 L<Time::Local> and L<Date::Parse> for conversion functions.
  78
  79 =item paid
  80
  81 Amount of this payment
  82
  83 =item usernum
  84
  85 order taker (see L<FS::access_user>)
  86
  87 =item payby
  88
  89 Payment Type (See L<FS::payinfo_Mixin> for valid values)
  90
  91 =item payinfo
  92
  93 Payment Information (See L<FS::payinfo_Mixin> for data format)
  94
  95 =item paymask
  96
  97 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
  98
  99 =item paybatch
 100
 101 obsolete text field for tracking card processing or other batch grouping
 102
 103 =item payunique
 104
 105 Optional unique identifer to prevent duplicate transactions.
 106
 107 =item closed
 108
 109 books closed flag, empty or `Y'
 110
 111 =item pkgnum
 112
 113 Desired pkgnum when using experimental package balances.
 114
 115 =item bank
 116
 117 The bank where the payment was deposited.
 118
 119 =item depositor
 120
 121 The name of the depositor.
 122
 123 =item account
 124
 125 The deposit account number.
 126
 127 =item teller
 128
 129 The teller number.
 130
 131 =item batchnum
 132
 133 The number of the batch this payment came from (see L<FS::pay_batch>),
 134 or null if it was processed through a realtime gateway or entered manually.
 135
 136 =item gatewaynum
 137
 138 The number of the realtime or batch gateway L<FS::payment_gateway>) this
 139 payment was processed through.  Null if it was entered manually or processed
 140 by the "system default" gateway, which doesn't have a number.
 141
 142 =item processor
 143
 144 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
 145 or ::OnlineThirdPartyPayment subclass) used for this payment.  Slightly
 146 redundant with C<gatewaynum>.
 147
 148 =item auth
 149
 150 The authorization number returned by the credit card network.
 151
 152 =item order_number
 153
 154 The transaction ID returned by the gateway, if any.  This is usually what
 155 you would use to initiate a void or refund of the payment.
 156
 157 =back
 158
 159 =head1 METHODS
 160
 161 =over 4
 162
 163 =item new HASHREF
 164
 165 Creates a new payment.  To add the payment to the databse, see L<"insert">.
 166
 167 =cut
 168
 169 sub table { 'cust_pay'; }
 170 sub cust_linked { $_[0]->cust_main_custnum; }
 171 sub cust_unlinked_msg {
 172   my $self = shift;
 173   "WARNING: can't find cust_main.custnum ". $self->custnum.
 174   ' (cust_pay.paynum '. $self->paynum. ')';
 175 }
 176
 177 =item insert [ OPTION => VALUE ... ]
 178
 179 Adds this payment to the database.
 180
 181 For backwards-compatibility and convenience, if the additional field invnum
 182 is defined, an FS::cust_bill_pay record for the full amount of the payment
 183 will be created.  In this case, custnum is optional.
 184
 185 If the additional field discount_term is defined then a prepayment discount
 186 is taken for that length of time.  It is an error for the customer to owe
 187 after this payment is made.
 188
 189 A hash of optional arguments may be passed.  Currently "manual" is supported.
 190 If true, a payment receipt is sent instead of a statement when
 191 'payment_receipt_email' configuration option is set.
 192
 193 About the "manual" flag: Normally, if the 'payment_receipt' config option
 194 is set, and the customer has an invoice email address, inserting a payment
 195 causes a I<statement> to be emailed to the customer.  If the payment is
 196 considered "manual" (or if the customer has no invoices), then it will
 197 instead send a I<payment receipt>.  "manual" should be true whenever a
 198 payment is created directly from the web interface, from a user-initiated
 199 realtime payment, or from a third-party payment via self-service.  It should
 200 be I<false> when creating a payment from a billing event or from a batch.
 201
 202 =cut
 203
 204 sub insert {
 205   my($self, %options) = @_;
 206
 207   local $SIG{HUP} = 'IGNORE';
 208   local $SIG{INT} = 'IGNORE';
 209   local $SIG{QUIT} = 'IGNORE';
 210   local $SIG{TERM} = 'IGNORE';
 211   local $SIG{TSTP} = 'IGNORE';
 212   local $SIG{PIPE} = 'IGNORE';
 213
 214   my $oldAutoCommit = $FS::UID::AutoCommit;
 215   local $FS::UID::AutoCommit = 0;
 216   my $dbh = dbh;
 217
 218   my $cust_bill;
 219   if ( $self->invnum ) {
 220     $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 221       or do {
 222         $dbh->rollback if $oldAutoCommit;
 223         return "Unknown cust_bill.invnum: ". $self->invnum;
 224       };
 225     $self->custnum($cust_bill->custnum );
 226   }
 227
 228   my $error = $self->check;
 229   return $error if $error;
 230
 231   my $cust_main = $self->cust_main;
 232   my $old_balance = $cust_main->balance;
 233
 234   $error = $self->SUPER::insert;
 235   if ( $error ) {
 236     $dbh->rollback if $oldAutoCommit;
 237     return "error inserting cust_pay: $error";
 238   }
 239
 240   if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
 241     if ( my $months = $self->discount_term ) {
 242       # XXX this should be moved out somewhere, but discount_term_values
 243       # doesn't fit right
 244       my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
 245       return "can't accept prepayment for an unbilled customer" if !$cust_bill;
 246
 247       # %billing_pkgs contains this customer's active monthly packages.
 248       # Recurring fees for those packages will be credited and then rebilled
 249       # for the full discount term.  Other packages on the last invoice
 250       # (canceled, non-monthly recurring, or one-time charges) will be
 251       # left as they are.
 252       my %billing_pkgs = map { $_->pkgnum => $_ }
 253                          grep { $_->part_pkg->freq eq '1' }
 254                          $cust_main->billing_pkgs;
 255       my $credit = 0; # sum of recurring charges from that invoice
 256       my $last_bill_date = 0; # the real bill date
 257       foreach my $item ( $cust_bill->cust_bill_pkg ) {
 258         next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
 259         $credit += $item->recur;
 260         $last_bill_date = $item->cust_pkg->last_bill
 261           if defined($item->cust_pkg)
 262             and $item->cust_pkg->last_bill > $last_bill_date
 263       }
 264
 265       my $cust_credit = new FS::cust_credit {
 266         'custnum' => $self->custnum,
 267         'amount'  => sprintf('%.2f', $credit),
 268         'reason'  => 'customer chose to prepay for discount',
 269       };
 270       $error = $cust_credit->insert('reason_type' => $credit_type);
 271       if ( $error ) {
 272         $dbh->rollback if $oldAutoCommit;
 273         return "error inserting prepayment credit: $error";
 274       }
 275       # don't apply it yet
 276
 277       # bill for the entire term
 278       $_->bill($_->last_bill) foreach (values %billing_pkgs);
 279       $error = $cust_main->bill(
 280         # no recurring_only, we want unbilled packages with start dates to
 281         # get billed
 282         'no_usage_reset' => 1,
 283         'time'           => $last_bill_date, # not $cust_bill->_date
 284         'pkg_list'       => [ values %billing_pkgs ],
 285         'freq_override'  => $months,
 286       );
 287       if ( $error ) {
 288         $dbh->rollback if $oldAutoCommit;
 289         return "error inserting cust_pay: $error";
 290       }
 291       $error = $cust_main->apply_payments_and_credits;
 292       if ( $error ) {
 293         $dbh->rollback if $oldAutoCommit;
 294         return "error inserting cust_pay: $error";
 295       }
 296       my $new_balance = $cust_main->balance;
 297       if ($new_balance > 0) {
 298         $dbh->rollback if $oldAutoCommit;
 299         return "balance after prepay discount attempt: $new_balance";
 300       }
 301       # user friendly: override the "apply only to this invoice" mode
 302       $self->invnum('');
 303
 304     }
 305
 306   }
 307
 308   if ( $self->invnum ) {
 309     my $cust_bill_pay = new FS::cust_bill_pay {
 310       'invnum' => $self->invnum,
 311       'paynum' => $self->paynum,
 312       'amount' => $self->paid,
 313       '_date'  => $self->_date,
 314     };
 315     $error = $cust_bill_pay->insert(%options);
 316     if ( $error ) {
 317       if ( $ignore_noapply ) {
 318         warn "warning: error inserting cust_bill_pay: $error ".
 319              "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
 320       } else {
 321         $dbh->rollback if $oldAutoCommit;
 322         return "error inserting cust_bill_pay: $error";
 323       }
 324     }
 325   }
 326
 327   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 328
 329   #false laziness w/ cust_credit::insert
 330   if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
 331     my @errors = $cust_main->unsuspend;
 332     #return
 333     # side-fx with nested transactions?  upstack rolls back?
 334     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 335          join(' / ', @errors)
 336       if @errors;
 337   }
 338   #eslaf
 339
 340   #bill setup fees for voip_cdr bill_every_call packages
 341   #some false laziness w/search in freeside-cdrd
 342   my $addl_from =
 343     'LEFT JOIN part_pkg USING ( pkgpart ) '.
 344     "LEFT JOIN part_pkg_option
 345        ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
 346             AND part_pkg_option.optionname = 'bill_every_call' )";
 347
 348   my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
 349                   " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
 350
 351   my @cust_pkg = qsearch({
 352     'table'     => 'cust_pkg',
 353     'addl_from' => $addl_from,
 354     'hashref'   => { 'custnum' => $self->custnum,
 355                      'susp'    => '',
 356                      'cancel'  => '',
 357                    },
 358     'extra_sql' => $extra_sql,
 359   });
 360
 361   if ( @cust_pkg ) {
 362     warn "voip_cdr bill_every_call packages found; billing customer\n";
 363     my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
 364     if ( $bill_error ) {
 365       warn "WARNING: Error billing customer: $bill_error\n";
 366     }
 367   }
 368   #end of billing setup fees for voip_cdr bill_every_call packages
 369
 370   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 371
 372   #payment receipt
 373   my $trigger = $conf->config('payment_receipt-trigger',
 374                               $self->cust_main->agentnum) || 'cust_pay';
 375   if ( $trigger eq 'cust_pay' ) {
 376     my $error = $self->send_receipt(
 377       'manual'    => $options{'manual'},
 378       'cust_bill' => $cust_bill,
 379       'cust_main' => $cust_main,
 380     );
 381     warn "can't send payment receipt/statement: $error" if $error;
 382   }
 383
 384   '';
 385
 386 }
 387
 388 =item void [ REASON ]
 389
 390 Voids this payment: deletes the payment and all associated applications and
 391 adds a record of the voided payment to the FS::cust_pay_void table.
 392
 393 =cut
 394
 395 sub void {
 396   my $self = shift;
 397
 398   local $SIG{HUP} = 'IGNORE';
 399   local $SIG{INT} = 'IGNORE';
 400   local $SIG{QUIT} = 'IGNORE';
 401   local $SIG{TERM} = 'IGNORE';
 402   local $SIG{TSTP} = 'IGNORE';
 403   local $SIG{PIPE} = 'IGNORE';
 404
 405   my $oldAutoCommit = $FS::UID::AutoCommit;
 406   local $FS::UID::AutoCommit = 0;
 407   my $dbh = dbh;
 408
 409   my $cust_pay_void = new FS::cust_pay_void ( {
 410     map { $_ => $self->get($_) } $self->fields
 411   } );
 412   $cust_pay_void->reason(shift) if scalar(@_);
 413   my $error = $cust_pay_void->insert;
 414   if ( $error ) {
 415     $dbh->rollback if $oldAutoCommit;
 416     return $error;
 417   }
 418
 419   $error = $self->delete;
 420   if ( $error ) {
 421     $dbh->rollback if $oldAutoCommit;
 422     return $error;
 423   }
 424
 425   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 426
 427   '';
 428
 429 }
 430
 431 =item delete
 432
 433 Unless the closed flag is set, deletes this payment and all associated
 434 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>).  In most
 435 cases, you want to use the void method instead to leave a record of the
 436 deleted payment.
 437
 438 =cut
 439
 440 # very similar to FS::cust_credit::delete
 441 sub delete {
 442   my $self = shift;
 443   return "Can't delete closed payment" if $self->closed =~ /^Y/i;
 444
 445   local $SIG{HUP} = 'IGNORE';
 446   local $SIG{INT} = 'IGNORE';
 447   local $SIG{QUIT} = 'IGNORE';
 448   local $SIG{TERM} = 'IGNORE';
 449   local $SIG{TSTP} = 'IGNORE';
 450   local $SIG{PIPE} = 'IGNORE';
 451
 452   my $oldAutoCommit = $FS::UID::AutoCommit;
 453   local $FS::UID::AutoCommit = 0;
 454   my $dbh = dbh;
 455
 456   foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
 457     my $error = $app->delete;
 458     if ( $error ) {
 459       $dbh->rollback if $oldAutoCommit;
 460       return $error;
 461     }
 462   }
 463
 464   my $error = $self->SUPER::delete(@_);
 465   if ( $error ) {
 466     $dbh->rollback if $oldAutoCommit;
 467     return $error;
 468   }
 469
 470   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 471
 472   '';
 473
 474 }
 475
 476 =item replace [ OLD_RECORD ]
 477
 478 You can, but probably shouldn't modify payments...
 479
 480 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
 481 supplied, replaces this record.  If there is an error, returns the error,
 482 otherwise returns false.
 483
 484 =cut
 485
 486 sub replace {
 487   my $self = shift;
 488   return "Can't modify closed payment" if $self->closed =~ /^Y/i;
 489   $self->SUPER::replace(@_);
 490 }
 491
 492 =item check
 493
 494 Checks all fields to make sure this is a valid payment.  If there is an error,
 495 returns the error, otherwise returns false.  Called by the insert method.
 496
 497 =cut
 498
 499 sub check {
 500   my $self = shift;
 501
 502   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 503
 504   my $error =
 505     $self->ut_numbern('paynum')
 506     || $self->ut_numbern('custnum')
 507     || $self->ut_numbern('_date')
 508     || $self->ut_money('paid')
 509     || $self->ut_alphan('otaker')
 510     || $self->ut_textn('paybatch')
 511     || $self->ut_textn('payunique')
 512     || $self->ut_enum('closed', [ '', 'Y' ])
 513     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
 514     || $self->ut_textn('bank')
 515     || $self->ut_alphan('depositor')
 516     || $self->ut_numbern('account')
 517     || $self->ut_numbern('teller')
 518     || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
 519     || $self->payinfo_check()
 520   ;
 521   return $error if $error;
 522
 523   return "paid must be > 0 " if $self->paid <= 0;
 524
 525   return "unknown cust_main.custnum: ". $self->custnum
 526     unless $self->invnum
 527            || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 528
 529   $self->_date(time) unless $self->_date;
 530
 531   return "invalid discount_term"
 532    if ($self->discount_term && $self->discount_term < 2);
 533
 534   if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
 535     foreach (qw(bank depositor account teller)) {
 536       return "$_ required" if $self->get($_) eq '';
 537     }
 538   }
 539
 540 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
 541 #  # UNIQUE index should catch this too, without race conditions, but this
 542 #  # should give a better error message the other 99.9% of the time...
 543 #  if ( length($self->payunique)
 544 #       && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
 545 #    #well, it *could* be a better error message
 546 #    return "duplicate transaction".
 547 #           " - a payment with unique identifer ". $self->payunique.
 548 #           " already exists";
 549 #  }
 550
 551   $self->SUPER::check;
 552 }
 553
 554 =item send_receipt HASHREF | OPTION => VALUE ...
 555
 556 Sends a payment receipt for this payment..
 557
 558 Available options:
 559
 560 =over 4
 561
 562 =item manual
 563
 564 Flag indicating the payment is being made manually.
 565
 566 =item cust_bill
 567
 568 Invoice (FS::cust_bill) object.  If not specified, the most recent invoice
 569 will be assumed.
 570
 571 =item cust_main
 572
 573 Customer (FS::cust_main) object (for efficiency).
 574
 575 =back
 576
 577 =cut
 578
 579 sub send_receipt {
 580   my $self = shift;
 581   my $opt = ref($_[0]) ? shift : { @_ };
 582
 583   my $cust_bill = $opt->{'cust_bill'};
 584   my $cust_main = $opt->{'cust_main'} || $self->cust_main;
 585
 586   my $conf = new FS::Conf;
 587
 588   return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
 589
 590   my @invoicing_list = $cust_main->invoicing_list_emailonly;
 591   return '' unless @invoicing_list;
 592
 593   $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
 594
 595   my $error = '';
 596
 597   if (    ( exists($opt->{'manual'}) && $opt->{'manual'} )
 598        #|| ! $conf->exists('invoice_html_statement')
 599        || ! $cust_bill
 600      )
 601   {
 602     my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
 603     if ( $msgnum ) {
 604
 605       my $queue = new FS::queue {
 606         'job'     => 'FS::Misc::process_send_email',
 607         'paynum'  => $self->paynum,
 608         'custnum' => $cust_main->custnum,
 609       };
 610       $error = $queue->insert(
 611          FS::msg_template->by_key($msgnum)->prepare(
 612           'cust_main'   => $cust_main,
 613           'object'      => $self,
 614           'from_config' => 'payment_receipt_from',
 615         )
 616       );
 617
 618     } elsif ( $conf->exists('payment_receipt_email') ) {
 619
 620       my $receipt_template = new Text::Template (
 621         TYPE   => 'ARRAY',
 622         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 623       ) or do {
 624         warn "can't create payment receipt template: $Text::Template::ERROR";
 625         return '';
 626       };
 627
 628       my $payby = $self->payby;
 629       my $payinfo = $self->payinfo;
 630       $payby =~ s/^BILL$/Check/ if $payinfo;
 631       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 632         $payinfo = $self->paymask
 633       } else {
 634         $payinfo = $self->decrypt($payinfo);
 635       }
 636       $payby =~ s/^CHEK$/Electronic check/;
 637
 638       my %fill_in = (
 639         'date'         => time2str("%a %B %o, %Y", $self->_date),
 640         'name'         => $cust_main->name,
 641         'paynum'       => $self->paynum,
 642         'paid'         => sprintf("%.2f", $self->paid),
 643         'payby'        => ucfirst(lc($payby)),
 644         'payinfo'      => $payinfo,
 645         'balance'      => $cust_main->balance,
 646         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 647       );
 648
 649       if ( $opt->{'cust_pkg'} ) {
 650         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 651         #setup date, other things?
 652       }
 653
 654       my $queue = new FS::queue {
 655         'job'     => 'FS::Misc::process_send_generated_email',
 656         'paynum'  => $self->paynum,
 657         'custnum' => $cust_main->custnum,
 658       };
 659       $error = $queue->insert(
 660         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
 661                                    #invoice_from??? well as good as any
 662         'to'      => \@invoicing_list,
 663         'subject' => 'Payment receipt',
 664         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 665       );
 666
 667     } else {
 668
 669       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 670
 671     }
 672
 673   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
 674
 675     my $queue = new FS::queue {
 676        'job'     => 'FS::cust_bill::queueable_email',
 677        'paynum'  => $self->paynum,
 678        'custnum' => $cust_main->custnum,
 679     };
 680
 681     $error = $queue->insert(
 682       'invnum'      => $cust_bill->invnum,
 683       'template'    => 'statement',
 684       'notice_name' => 'Statement',
 685       'no_coupon'   => 1,
 686     );
 687
 688   }
 689
 690   warn "send_receipt: $error\n" if $error;
 691 }
 692
 693 =item cust_bill_pay
 694
 695 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 696 payment.
 697
 698 =cut
 699
 700 sub cust_bill_pay {
 701   my $self = shift;
 702   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 703   sort {    $a->_date  <=> $b->_date
 704          || $a->invnum <=> $b->invnum }
 705     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 706   ;
 707 }
 708
 709 =item cust_pay_refund
 710
 711 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 712 payment.
 713
 714 =cut
 715
 716 sub cust_pay_refund {
 717   my $self = shift;
 718   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 719   sort { $a->_date <=> $b->_date }
 720     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 721   ;
 722 }
 723
 724
 725 =item unapplied
 726
 727 Returns the amount of this payment that is still unapplied; which is
 728 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 729 applications (see L<FS::cust_pay_refund>).
 730
 731 =cut
 732
 733 sub unapplied {
 734   my $self = shift;
 735   my $amount = $self->paid;
 736   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 737   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 738   sprintf("%.2f", $amount );
 739 }
 740
 741 =item unrefunded
 742
 743 Returns the amount of this payment that has not been refuned; which is
 744 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 745
 746 =cut
 747
 748 sub unrefunded {
 749   my $self = shift;
 750   my $amount = $self->paid;
 751   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 752   sprintf("%.2f", $amount );
 753 }
 754
 755 =item amount
 756
 757 Returns the "paid" field.
 758
 759 =cut
 760
 761 sub amount {
 762   my $self = shift;
 763   $self->paid();
 764 }
 765
 766 =back
 767
 768 =head1 CLASS METHODS
 769
 770 =over 4
 771
 772 =item batch_insert CUST_PAY_OBJECT, ...
 773
 774 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 775 objects.  Returns a list, each element representing the status of inserting the
 776 corresponding payment - empty.  If there is an error inserting any payment, the
 777 entire transaction is rolled back, i.e. all payments are inserted or none are.
 778
 779 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 780 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 781 those objects will be inserted with the paynum of the payment, and for
 782 each one, an error message or an empty string will be inserted into the
 783 list of errors.
 784
 785 For example:
 786
 787   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 788   my $num_errors = scalar(grep $_, @errors);
 789   if ( $num_errors == 0 ) {
 790     #success; all payments were inserted
 791   } else {
 792     #failure; no payments were inserted.
 793   }
 794
 795 =cut
 796
 797 sub batch_insert {
 798   my $self = shift; #class method
 799
 800   local $SIG{HUP} = 'IGNORE';
 801   local $SIG{INT} = 'IGNORE';
 802   local $SIG{QUIT} = 'IGNORE';
 803   local $SIG{TERM} = 'IGNORE';
 804   local $SIG{TSTP} = 'IGNORE';
 805   local $SIG{PIPE} = 'IGNORE';
 806
 807   my $oldAutoCommit = $FS::UID::AutoCommit;
 808   local $FS::UID::AutoCommit = 0;
 809   my $dbh = dbh;
 810
 811   my $num_errors = 0;
 812
 813   my @errors;
 814   foreach my $cust_pay (@_) {
 815     my $error = $cust_pay->insert( 'manual' => 1 );
 816     push @errors, $error;
 817     $num_errors++ if $error;
 818
 819     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 820
 821       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 822         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 823           push @errors, '';
 824         }
 825         else {
 826           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 827           my $apply_error = $cust_bill_pay->insert;
 828           push @errors, $apply_error || '';
 829           $num_errors++ if $apply_error;
 830         }
 831       }
 832
 833     } elsif ( !$error ) { #normal case: apply payments as usual
 834       $cust_pay->cust_main->apply_payments;
 835     }
 836
 837   }
 838
 839   if ( $num_errors ) {
 840     $dbh->rollback if $oldAutoCommit;
 841   } else {
 842     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 843   }
 844
 845   @errors;
 846
 847 }
 848
 849 =item unapplied_sql
 850
 851 Returns an SQL fragment to retreive the unapplied amount.
 852
 853 =cut
 854
 855 sub unapplied_sql {
 856   my ($class, $start, $end) = @_;
 857   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 858   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 859   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 860   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 861
 862   "paid
 863         - COALESCE(
 864                     ( SELECT SUM(amount) FROM cust_bill_pay
 865                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 866                         $bill_start $bill_end )
 867                     ,0
 868                   )
 869         - COALESCE(
 870                     ( SELECT SUM(amount) FROM cust_pay_refund
 871                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 872                         $refund_start $refund_end )
 873                     ,0
 874                   )
 875   ";
 876
 877 }
 878
 879 # _upgrade_data
 880 #
 881 # Used by FS::Upgrade to migrate to a new database.
 882
 883 use FS::h_cust_pay;
 884
 885 sub _upgrade_data {  #class method
 886   my ($class, %opts) = @_;
 887
 888   warn "$me upgrading $class\n" if $DEBUG;
 889
 890   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
 891
 892   ##
 893   # otaker/ivan upgrade
 894   ##
 895
 896   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
 897
 898     #not the most efficient, but hey, it only has to run once
 899
 900     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 901                 "  AND usernum IS NULL ".
 902                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 903                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 904
 905     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 906
 907     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 908     $sth->execute or die $sth->errstr;
 909     my $total = $sth->fetchrow_arrayref->[0];
 910     #warn "$total cust_pay records to update\n"
 911     #  if $DEBUG;
 912     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 913
 914     my $count = 0;
 915     my $lastprog = 0;
 916
 917     my @cust_pay = qsearch( {
 918         'table'     => 'cust_pay',
 919         'hashref'   => {},
 920         'extra_sql' => $where,
 921         'order_by'  => 'ORDER BY paynum',
 922     } );
 923
 924     foreach my $cust_pay (@cust_pay) {
 925
 926       my $h_cust_pay = $cust_pay->h_search('insert');
 927       if ( $h_cust_pay ) {
 928         next if $cust_pay->otaker eq $h_cust_pay->history_user;
 929         #$cust_pay->otaker($h_cust_pay->history_user);
 930         $cust_pay->set('otaker', $h_cust_pay->history_user);
 931       } else {
 932         $cust_pay->set('otaker', 'legacy');
 933       }
 934
 935       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 936       my $error = $cust_pay->replace;
 937
 938       if ( $error ) {
 939         warn " *** WARNING: Error updating order taker for payment paynum ".
 940              $cust_pay->paynun. ": $error\n";
 941         next;
 942       }
 943
 944       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 945
 946       $count++;
 947       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 948         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
 949         $lastprog = time;
 950       }
 951
 952     }
 953
 954     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
 955   }
 956
 957   ###
 958   # payinfo N/A upgrade
 959   ###
 960
 961   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
 962
 963     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
 964
 965     my @na_cust_pay = qsearch( {
 966       'table'     => 'cust_pay',
 967       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
 968       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
 969     } );
 970
 971     foreach my $na ( @na_cust_pay ) {
 972
 973       next unless $na->payinfo eq 'N/A';
 974
 975       my $cust_pay_pending =
 976         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
 977       unless ( $cust_pay_pending ) {
 978         warn " *** WARNING: not-yet recoverable N/A card for payment ".
 979              $na->paynum. " (no cust_pay_pending)\n";
 980         next;
 981       }
 982       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
 983       my $error = $na->replace;
 984       if ( $error ) {
 985         warn " *** WARNING: Error updating payinfo for payment paynum ".
 986              $na->paynun. ": $error\n";
 987         next;
 988       }
 989
 990     }
 991
 992     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
 993   }
 994
 995   ###
 996   # otaker->usernum upgrade
 997   ###
 998
 999   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1000   $class->_upgrade_otaker(%opts);
1001   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1002
1003   ###
1004   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1005   ###
1006   my @cust_pay = qsearch( {
1007       'table'     => 'cust_pay',
1008       'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1009   } );
1010   foreach my $cust_pay (@cust_pay) {
1011     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1012     $cust_pay->set('paybatch' => '');
1013     my $error = $cust_pay->replace;
1014     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1015     if $error;
1016   }
1017
1018   ###
1019   # migrate gateway info from the misused 'paybatch' field
1020   ###
1021
1022   # not only cust_pay, but also voided and refunded payments
1023   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1024     local $FS::Record::nowarn_classload=1;
1025     # really inefficient, but again, only has to run once
1026     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1027       my $and_batchnum_is_null =
1028         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1029       foreach my $object ( qsearch({
1030             table     => $table,
1031             extra_sql => "WHERE payby IN('CARD','CHEK') ".
1032                          "AND (paybatch IS NOT NULL ".
1033                          "OR (paybatch IS NULL AND auth IS NULL
1034                          $and_batchnum_is_null ) )",
1035           }) )
1036       {
1037         if ( $object->paybatch eq '' ) {
1038           # repair for a previous upgrade that didn't save 'auth'
1039           my $pkey = $object->primary_key;
1040           # find the last history record that had a paybatch value
1041           my $h = qsearchs({
1042               table   => "h_$table",
1043               hashref => {
1044                 $pkey     => $object->$pkey,
1045                 paybatch  => { op=>'!=', value=>''},
1046                 history_action => 'replace_old',
1047               },
1048               order_by => 'ORDER BY history_date DESC LIMIT 1',
1049           });
1050           if (!$h) {
1051             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1052             next;
1053           }
1054           # if the paybatch didn't have an auth string, then it's fine
1055           $h->paybatch =~ /:(\w+):/ or next;
1056           # set paybatch to what it was in that record
1057           $object->set('paybatch', $h->paybatch)
1058           # and then upgrade it like the old records
1059         }
1060
1061         my $parsed = $object->_parse_paybatch;
1062         if (keys %$parsed) {
1063           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1064           $object->set('auth' => $parsed->{authorization});
1065           $object->set('paybatch', '');
1066           my $error = $object->replace;
1067           warn "error parsing CARD/CHEK paybatch fields on $object #".
1068             $object->get($object->primary_key).":\n  $error\n"
1069             if $error;
1070         }
1071       } #$object
1072     } #$table
1073     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1074   }
1075 }
1076
1077 =back
1078
1079 =head1 SUBROUTINES
1080
1081 =over 4
1082
1083 =item batch_import HASHREF
1084
1085 Inserts new payments.
1086
1087 =cut
1088
1089 sub batch_import {
1090   my $param = shift;
1091
1092   my $fh = $param->{filehandle};
1093   my $agentnum = $param->{agentnum};
1094   my $format = $param->{'format'};
1095   my $paybatch = $param->{'paybatch'};
1096
1097   # here is the agent virtualization
1098   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1099
1100   my @fields;
1101   my $payby;
1102   if ( $format eq 'simple' ) {
1103     @fields = qw( custnum agent_custid paid payinfo );
1104     $payby = 'BILL';
1105   } elsif ( $format eq 'extended' ) {
1106     die "unimplemented\n";
1107     @fields = qw( );
1108     $payby = 'BILL';
1109   } else {
1110     die "unknown format $format";
1111   }
1112
1113   eval "use Text::CSV_XS;";
1114   die $@ if $@;
1115
1116   my $csv = new Text::CSV_XS;
1117
1118   my $imported = 0;
1119
1120   local $SIG{HUP} = 'IGNORE';
1121   local $SIG{INT} = 'IGNORE';
1122   local $SIG{QUIT} = 'IGNORE';
1123   local $SIG{TERM} = 'IGNORE';
1124   local $SIG{TSTP} = 'IGNORE';
1125   local $SIG{PIPE} = 'IGNORE';
1126
1127   my $oldAutoCommit = $FS::UID::AutoCommit;
1128   local $FS::UID::AutoCommit = 0;
1129   my $dbh = dbh;
1130
1131   my $line;
1132   while ( defined($line=<$fh>) ) {
1133
1134     $csv->parse($line) or do {
1135       $dbh->rollback if $oldAutoCommit;
1136       return "can't parse: ". $csv->error_input();
1137     };
1138
1139     my @columns = $csv->fields();
1140
1141     my %cust_pay = (
1142       payby    => $payby,
1143       paybatch => $paybatch,
1144     );
1145
1146     my $cust_main;
1147     foreach my $field ( @fields ) {
1148
1149       if ( $field eq 'agent_custid'
1150         && $agentnum
1151         && $columns[0] =~ /\S+/ )
1152       {
1153
1154         my $agent_custid = $columns[0];
1155         my %hash = ( 'agent_custid' => $agent_custid,
1156                      'agentnum'     => $agentnum,
1157                    );
1158
1159         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1160           $dbh->rollback if $oldAutoCommit;
1161           return "can't specify custnum with agent_custid $agent_custid";
1162         }
1163
1164         $cust_main = qsearchs({
1165                                 'table'     => 'cust_main',
1166                                 'hashref'   => \%hash,
1167                                 'extra_sql' => $extra_sql,
1168                              });
1169
1170         unless ( $cust_main ) {
1171           $dbh->rollback if $oldAutoCommit;
1172           return "can't find customer with agent_custid $agent_custid";
1173         }
1174
1175         $field = 'custnum';
1176         $columns[0] = $cust_main->custnum;
1177       }
1178
1179       $cust_pay{$field} = shift @columns;
1180     }
1181
1182     my $cust_pay = new FS::cust_pay( \%cust_pay );
1183     my $error = $cust_pay->insert;
1184
1185     if ( $error ) {
1186       $dbh->rollback if $oldAutoCommit;
1187       return "can't insert payment for $line: $error";
1188     }
1189
1190     if ( $format eq 'simple' ) {
1191       # include agentnum for less surprise?
1192       $cust_main = qsearchs({
1193                              'table'     => 'cust_main',
1194                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1195                              'extra_sql' => $extra_sql,
1196                            })
1197         unless $cust_main;
1198
1199       unless ( $cust_main ) {
1200         $dbh->rollback if $oldAutoCommit;
1201         return "can't find customer to which payments apply at line: $line";
1202       }
1203
1204       $error = $cust_main->apply_payments_and_credits;
1205       if ( $error ) {
1206         $dbh->rollback if $oldAutoCommit;
1207         return "can't apply payments to customer for $line: $error";
1208       }
1209
1210     }
1211
1212     $imported++;
1213   }
1214
1215   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1216
1217   return "Empty file!" unless $imported;
1218
1219   ''; #no error
1220
1221 }
1222
1223 =back
1224
1225 =head1 BUGS
1226
1227 Delete and replace methods.
1228
1229 =head1 SEE ALSO
1230
1231 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1232 schema.html from the base documentation.
1233
1234 =cut
1235
1236 1;
1237