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 payby 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 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 764 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 765 those objects will be inserted with the paynum of the payment, and for
 766 each one, an error message or an empty string will be inserted into the
 767 list of errors.
 768
 769 For example:
 770
 771   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 772   my $num_errors = scalar(grep $_, @errors);
 773   if ( $num_errors == 0 ) {
 774     #success; all payments were inserted
 775   } else {
 776     #failure; no payments were inserted.
 777   }
 778
 779 =cut
 780
 781 sub batch_insert {
 782   my $self = shift; #class method
 783
 784   local $SIG{HUP} = 'IGNORE';
 785   local $SIG{INT} = 'IGNORE';
 786   local $SIG{QUIT} = 'IGNORE';
 787   local $SIG{TERM} = 'IGNORE';
 788   local $SIG{TSTP} = 'IGNORE';
 789   local $SIG{PIPE} = 'IGNORE';
 790
 791   my $oldAutoCommit = $FS::UID::AutoCommit;
 792   local $FS::UID::AutoCommit = 0;
 793   my $dbh = dbh;
 794
 795   my $num_errors = 0;
 796
 797   my @errors;
 798   foreach my $cust_pay (@_) {
 799     my $error = $cust_pay->insert( 'manual' => 1 );
 800     push @errors, $error;
 801     $num_errors++ if $error;
 802
 803     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 804
 805       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 806         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 807           push @errors, '';
 808         }
 809         else {
 810           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 811           my $apply_error = $cust_bill_pay->insert;
 812           push @errors, $apply_error || '';
 813           $num_errors++ if $apply_error;
 814         }
 815       }
 816
 817     } elsif ( !$error ) { #normal case: apply payments as usual
 818       $cust_pay->cust_main->apply_payments;
 819     }
 820
 821   }
 822
 823   if ( $num_errors ) {
 824     $dbh->rollback if $oldAutoCommit;
 825   } else {
 826     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 827   }
 828
 829   @errors;
 830
 831 }
 832
 833 =item unapplied_sql
 834
 835 Returns an SQL fragment to retreive the unapplied amount.
 836
 837 =cut
 838
 839 sub unapplied_sql {
 840   my ($class, $start, $end) = @_;
 841   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 842   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 843   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 844   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 845
 846   "paid
 847         - COALESCE(
 848                     ( SELECT SUM(amount) FROM cust_bill_pay
 849                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 850                         $bill_start $bill_end )
 851                     ,0
 852                   )
 853         - COALESCE(
 854                     ( SELECT SUM(amount) FROM cust_pay_refund
 855                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 856                         $refund_start $refund_end )
 857                     ,0
 858                   )
 859   ";
 860
 861 }
 862
 863 # _upgrade_data
 864 #
 865 # Used by FS::Upgrade to migrate to a new database.
 866
 867 use FS::h_cust_pay;
 868
 869 sub _upgrade_data {  #class method
 870   my ($class, %opts) = @_;
 871
 872   warn "$me upgrading $class\n" if $DEBUG;
 873
 874   ##
 875   # otaker/ivan upgrade
 876   ##
 877
 878   #not the most efficient, but hey, it only has to run once
 879
 880   my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 881               "  AND usernum IS NULL ".
 882               "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 883               "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 884
 885   my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 886
 887   my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 888   $sth->execute or die $sth->errstr;
 889   my $total = $sth->fetchrow_arrayref->[0];
 890   #warn "$total cust_pay records to update\n"
 891   #  if $DEBUG;
 892   local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 893
 894   my $count = 0;
 895   my $lastprog = 0;
 896
 897   my @cust_pay = qsearch( {
 898       'table'     => 'cust_pay',
 899       'hashref'   => {},
 900       'extra_sql' => $where,
 901       'order_by'  => 'ORDER BY paynum',
 902   } );
 903
 904   foreach my $cust_pay (@cust_pay) {
 905
 906     my $h_cust_pay = $cust_pay->h_search('insert');
 907     if ( $h_cust_pay ) {
 908       next if $cust_pay->otaker eq $h_cust_pay->history_user;
 909       #$cust_pay->otaker($h_cust_pay->history_user);
 910       $cust_pay->set('otaker', $h_cust_pay->history_user);
 911     } else {
 912       $cust_pay->set('otaker', 'legacy');
 913     }
 914
 915     delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 916     my $error = $cust_pay->replace;
 917
 918     if ( $error ) {
 919       warn " *** WARNING: Error updating order taker for payment paynum ".
 920            $cust_pay->paynun. ": $error\n";
 921       next;
 922     }
 923
 924     $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 925
 926     $count++;
 927     if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 928       warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n";
 929       $lastprog = time;
 930     }
 931
 932   }
 933
 934   ###
 935   # payinfo N/A upgrade
 936   ###
 937
 938   #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
 939
 940   my @na_cust_pay = qsearch( {
 941     'table'     => 'cust_pay',
 942     'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
 943     'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
 944   } );
 945
 946   foreach my $na ( @na_cust_pay ) {
 947
 948     next unless $na->payinfo eq 'N/A';
 949
 950     my $cust_pay_pending =
 951       qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
 952     unless ( $cust_pay_pending ) {
 953       warn " *** WARNING: not-yet recoverable N/A card for payment ".
 954            $na->paynum. " (no cust_pay_pending)\n";
 955       next;
 956     }
 957     $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
 958     my $error = $na->replace;
 959     if ( $error ) {
 960       warn " *** WARNING: Error updating payinfo for payment paynum ".
 961            $na->paynun. ": $error\n";
 962       next;
 963     }
 964
 965   }
 966
 967   ###
 968   # otaker->usernum upgrade
 969   ###
 970
 971   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 972   $class->_upgrade_otaker(%opts);
 973   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 974
 975 }
 976
 977 =back
 978
 979 =head1 SUBROUTINES
 980
 981 =over 4
 982
 983 =item batch_import HASHREF
 984
 985 Inserts new payments.
 986
 987 =cut
 988
 989 sub batch_import {
 990   my $param = shift;
 991
 992   my $fh = $param->{filehandle};
 993   my $agentnum = $param->{agentnum};
 994   my $format = $param->{'format'};
 995   my $paybatch = $param->{'paybatch'};
 996
 997   # here is the agent virtualization
 998   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
 999
1000   my @fields;
1001   my $payby;
1002   if ( $format eq 'simple' ) {
1003     @fields = qw( custnum agent_custid paid payinfo );
1004     $payby = 'BILL';
1005   } elsif ( $format eq 'extended' ) {
1006     die "unimplemented\n";
1007     @fields = qw( );
1008     $payby = 'BILL';
1009   } else {
1010     die "unknown format $format";
1011   }
1012
1013   eval "use Text::CSV_XS;";
1014   die $@ if $@;
1015
1016   my $csv = new Text::CSV_XS;
1017
1018   my $imported = 0;
1019
1020   local $SIG{HUP} = 'IGNORE';
1021   local $SIG{INT} = 'IGNORE';
1022   local $SIG{QUIT} = 'IGNORE';
1023   local $SIG{TERM} = 'IGNORE';
1024   local $SIG{TSTP} = 'IGNORE';
1025   local $SIG{PIPE} = 'IGNORE';
1026
1027   my $oldAutoCommit = $FS::UID::AutoCommit;
1028   local $FS::UID::AutoCommit = 0;
1029   my $dbh = dbh;
1030
1031   my $line;
1032   while ( defined($line=<$fh>) ) {
1033
1034     $csv->parse($line) or do {
1035       $dbh->rollback if $oldAutoCommit;
1036       return "can't parse: ". $csv->error_input();
1037     };
1038
1039     my @columns = $csv->fields();
1040
1041     my %cust_pay = (
1042       payby    => $payby,
1043       paybatch => $paybatch,
1044     );
1045
1046     my $cust_main;
1047     foreach my $field ( @fields ) {
1048
1049       if ( $field eq 'agent_custid'
1050         && $agentnum
1051         && $columns[0] =~ /\S+/ )
1052       {
1053
1054         my $agent_custid = $columns[0];
1055         my %hash = ( 'agent_custid' => $agent_custid,
1056                      'agentnum'     => $agentnum,
1057                    );
1058
1059         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1060           $dbh->rollback if $oldAutoCommit;
1061           return "can't specify custnum with agent_custid $agent_custid";
1062         }
1063
1064         $cust_main = qsearchs({
1065                                 'table'     => 'cust_main',
1066                                 'hashref'   => \%hash,
1067                                 'extra_sql' => $extra_sql,
1068                              });
1069
1070         unless ( $cust_main ) {
1071           $dbh->rollback if $oldAutoCommit;
1072           return "can't find customer with agent_custid $agent_custid";
1073         }
1074
1075         $field = 'custnum';
1076         $columns[0] = $cust_main->custnum;
1077       }
1078
1079       $cust_pay{$field} = shift @columns;
1080     }
1081
1082     my $cust_pay = new FS::cust_pay( \%cust_pay );
1083     my $error = $cust_pay->insert;
1084
1085     if ( $error ) {
1086       $dbh->rollback if $oldAutoCommit;
1087       return "can't insert payment for $line: $error";
1088     }
1089
1090     if ( $format eq 'simple' ) {
1091       # include agentnum for less surprise?
1092       $cust_main = qsearchs({
1093                              'table'     => 'cust_main',
1094                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1095                              'extra_sql' => $extra_sql,
1096                            })
1097         unless $cust_main;
1098
1099       unless ( $cust_main ) {
1100         $dbh->rollback if $oldAutoCommit;
1101         return "can't find customer to which payments apply at line: $line";
1102       }
1103
1104       $error = $cust_main->apply_payments_and_credits;
1105       if ( $error ) {
1106         $dbh->rollback if $oldAutoCommit;
1107         return "can't apply payments to customer for $line: $error";
1108       }
1109
1110     }
1111
1112     $imported++;
1113   }
1114
1115   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1116
1117   return "Empty file!" unless $imported;
1118
1119   ''; #no error
1120
1121 }
1122
1123 =back
1124
1125 =head1 BUGS
1126
1127 Delete and replace methods.
1128
1129 =head1 SEE ALSO
1130
1131 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1132 schema.html from the base documentation.
1133
1134 =cut
1135
1136 1;
1137