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