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