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