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