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