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