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
 630       my $queue = new FS::queue {
 631         'job'     => 'FS::Misc::process_send_email',
 632         'paynum'  => $self->paynum,
 633         'custnum' => $cust_main->custnum,
 634       };
 635       $error = $queue->insert(
 636          FS::msg_template->by_key($msgnum)->prepare(
 637           'cust_main'   => $cust_main,
 638           'object'      => $self,
 639           'from_config' => 'payment_receipt_from',
 640         )
 641       );
 642
 643     } elsif ( $conf->exists('payment_receipt_email') ) {
 644
 645       my $receipt_template = new Text::Template (
 646         TYPE   => 'ARRAY',
 647         SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
 648       ) or do {
 649         warn "can't create payment receipt template: $Text::Template::ERROR";
 650         return '';
 651       };
 652
 653       my $payby = $self->payby;
 654       my $payinfo = $self->payinfo;
 655       $payby =~ s/^BILL$/Check/ if $payinfo;
 656       if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
 657         $payinfo = $self->paymask
 658       } else {
 659         $payinfo = $self->decrypt($payinfo);
 660       }
 661       $payby =~ s/^CHEK$/Electronic check/;
 662
 663       my %fill_in = (
 664         'date'         => time2str("%a %B %o, %Y", $self->_date),
 665         'name'         => $cust_main->name,
 666         'paynum'       => $self->paynum,
 667         'paid'         => sprintf("%.2f", $self->paid),
 668         'payby'        => ucfirst(lc($payby)),
 669         'payinfo'      => $payinfo,
 670         'balance'      => $cust_main->balance,
 671         'company_name' => $conf->config('company_name', $cust_main->agentnum),
 672       );
 673
 674       if ( $opt->{'cust_pkg'} ) {
 675         $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
 676         #setup date, other things?
 677       }
 678
 679       my $queue = new FS::queue {
 680         'job'     => 'FS::Misc::process_send_generated_email',
 681         'paynum'  => $self->paynum,
 682         'custnum' => $cust_main->custnum,
 683       };
 684       $error = $queue->insert(
 685         'from'    => $conf->config('invoice_from', $cust_main->agentnum),
 686                                    #invoice_from??? well as good as any
 687         'to'      => \@invoicing_list,
 688         'subject' => 'Payment receipt',
 689         'body'    => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
 690       );
 691
 692     } else {
 693
 694       warn "payment_receipt is on, but no payment_receipt_msgnum\n";
 695
 696     }
 697
 698   } elsif ( ! $cust_main->invoice_noemail ) { #not manual
 699
 700     my $queue = new FS::queue {
 701        'job'     => 'FS::cust_bill::queueable_email',
 702        'paynum'  => $self->paynum,
 703        'custnum' => $cust_main->custnum,
 704     };
 705
 706     $error = $queue->insert(
 707       'invnum'      => $cust_bill->invnum,
 708       'template'    => 'statement',
 709       'notice_name' => 'Statement',
 710       'no_coupon'   => 1,
 711     );
 712
 713   }
 714
 715   warn "send_receipt: $error\n" if $error;
 716 }
 717
 718 =item cust_bill_pay
 719
 720 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
 721 payment.
 722
 723 =cut
 724
 725 sub cust_bill_pay {
 726   my $self = shift;
 727   map { $_ } #return $self->num_cust_bill_pay unless wantarray;
 728   sort {    $a->_date  <=> $b->_date
 729          || $a->invnum <=> $b->invnum }
 730     qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
 731   ;
 732 }
 733
 734 =item cust_pay_refund
 735
 736 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
 737 payment.
 738
 739 =cut
 740
 741 sub cust_pay_refund {
 742   my $self = shift;
 743   map { $_ } #return $self->num_cust_pay_refund unless wantarray;
 744   sort { $a->_date <=> $b->_date }
 745     qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
 746   ;
 747 }
 748
 749
 750 =item unapplied
 751
 752 Returns the amount of this payment that is still unapplied; which is
 753 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
 754 applications (see L<FS::cust_pay_refund>).
 755
 756 =cut
 757
 758 sub unapplied {
 759   my $self = shift;
 760   my $amount = $self->paid;
 761   $amount -= $_->amount foreach ( $self->cust_bill_pay );
 762   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 763   sprintf("%.2f", $amount );
 764 }
 765
 766 =item unrefunded
 767
 768 Returns the amount of this payment that has not been refuned; which is
 769 paid minus all  refund applications (see L<FS::cust_pay_refund>).
 770
 771 =cut
 772
 773 sub unrefunded {
 774   my $self = shift;
 775   my $amount = $self->paid;
 776   $amount -= $_->amount foreach ( $self->cust_pay_refund );
 777   sprintf("%.2f", $amount );
 778 }
 779
 780 =item amount
 781
 782 Returns the "paid" field.
 783
 784 =cut
 785
 786 sub amount {
 787   my $self = shift;
 788   $self->paid();
 789 }
 790
 791 =back
 792
 793 =head1 CLASS METHODS
 794
 795 =over 4
 796
 797 =item batch_insert CUST_PAY_OBJECT, ...
 798
 799 Class method which inserts multiple payments.  Takes a list of FS::cust_pay
 800 objects.  Returns a list, each element representing the status of inserting the
 801 corresponding payment - empty.  If there is an error inserting any payment, the
 802 entire transaction is rolled back, i.e. all payments are inserted or none are.
 803
 804 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
 805 reference to an array of (uninserted) FS::cust_bill_pay objects.  If so,
 806 those objects will be inserted with the paynum of the payment, and for
 807 each one, an error message or an empty string will be inserted into the
 808 list of errors.
 809
 810 For example:
 811
 812   my @errors = FS::cust_pay->batch_insert(@cust_pay);
 813   my $num_errors = scalar(grep $_, @errors);
 814   if ( $num_errors == 0 ) {
 815     #success; all payments were inserted
 816   } else {
 817     #failure; no payments were inserted.
 818   }
 819
 820 =cut
 821
 822 sub batch_insert {
 823   my $self = shift; #class method
 824
 825   local $SIG{HUP} = 'IGNORE';
 826   local $SIG{INT} = 'IGNORE';
 827   local $SIG{QUIT} = 'IGNORE';
 828   local $SIG{TERM} = 'IGNORE';
 829   local $SIG{TSTP} = 'IGNORE';
 830   local $SIG{PIPE} = 'IGNORE';
 831
 832   my $oldAutoCommit = $FS::UID::AutoCommit;
 833   local $FS::UID::AutoCommit = 0;
 834   my $dbh = dbh;
 835
 836   my $num_errors = 0;
 837
 838   my @errors;
 839   foreach my $cust_pay (@_) {
 840     my $error = $cust_pay->insert( 'manual' => 1 );
 841     push @errors, $error;
 842     $num_errors++ if $error;
 843
 844     if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
 845
 846       foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
 847         if ( $error ) { # insert placeholders if cust_pay wasn't inserted
 848           push @errors, '';
 849         }
 850         else {
 851           $cust_bill_pay->set('paynum', $cust_pay->paynum);
 852           my $apply_error = $cust_bill_pay->insert;
 853           push @errors, $apply_error || '';
 854           $num_errors++ if $apply_error;
 855         }
 856       }
 857
 858     } elsif ( !$error ) { #normal case: apply payments as usual
 859       $cust_pay->cust_main->apply_payments;
 860     }
 861
 862   }
 863
 864   if ( $num_errors ) {
 865     $dbh->rollback if $oldAutoCommit;
 866   } else {
 867     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 868   }
 869
 870   @errors;
 871
 872 }
 873
 874 =item unapplied_sql
 875
 876 Returns an SQL fragment to retreive the unapplied amount.
 877
 878 =cut
 879
 880 sub unapplied_sql {
 881   my ($class, $start, $end) = @_;
 882   my $bill_start   = $start ? "AND cust_bill_pay._date <= $start"   : '';
 883   my $bill_end     = $end   ? "AND cust_bill_pay._date > $end"     : '';
 884   my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
 885   my $refund_end   = $end   ? "AND cust_pay_refund._date > $end"   : '';
 886
 887   "paid
 888         - COALESCE(
 889                     ( SELECT SUM(amount) FROM cust_bill_pay
 890                         WHERE cust_pay.paynum = cust_bill_pay.paynum
 891                         $bill_start $bill_end )
 892                     ,0
 893                   )
 894         - COALESCE(
 895                     ( SELECT SUM(amount) FROM cust_pay_refund
 896                         WHERE cust_pay.paynum = cust_pay_refund.paynum
 897                         $refund_start $refund_end )
 898                     ,0
 899                   )
 900   ";
 901
 902 }
 903
 904 # _upgrade_data
 905 #
 906 # Used by FS::Upgrade to migrate to a new database.
 907
 908 use FS::h_cust_pay;
 909
 910 sub _upgrade_data {  #class method
 911   my ($class, %opts) = @_;
 912
 913   warn "$me upgrading $class\n" if $DEBUG;
 914
 915   local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
 916
 917   ##
 918   # otaker/ivan upgrade
 919   ##
 920
 921   unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
 922
 923     #not the most efficient, but hey, it only has to run once
 924
 925     my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
 926                 "  AND usernum IS NULL ".
 927                 "  AND 0 < ( SELECT COUNT(*) FROM cust_main                 ".
 928                 "              WHERE cust_main.custnum = cust_pay.custnum ) ";
 929
 930     my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
 931
 932     my $sth = dbh->prepare($count_sql) or die dbh->errstr;
 933     $sth->execute or die $sth->errstr;
 934     my $total = $sth->fetchrow_arrayref->[0];
 935     #warn "$total cust_pay records to update\n"
 936     #  if $DEBUG;
 937     local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
 938
 939     my $count = 0;
 940     my $lastprog = 0;
 941
 942     my @cust_pay = qsearch( {
 943         'table'     => 'cust_pay',
 944         'hashref'   => {},
 945         'extra_sql' => $where,
 946         'order_by'  => 'ORDER BY paynum',
 947     } );
 948
 949     foreach my $cust_pay (@cust_pay) {
 950
 951       my $h_cust_pay = $cust_pay->h_search('insert');
 952       if ( $h_cust_pay ) {
 953         next if $cust_pay->otaker eq $h_cust_pay->history_user;
 954         #$cust_pay->otaker($h_cust_pay->history_user);
 955         $cust_pay->set('otaker', $h_cust_pay->history_user);
 956       } else {
 957         $cust_pay->set('otaker', 'legacy');
 958       }
 959
 960       delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
 961       my $error = $cust_pay->replace;
 962
 963       if ( $error ) {
 964         warn " *** WARNING: Error updating order taker for payment paynum ".
 965              $cust_pay->paynun. ": $error\n";
 966         next;
 967       }
 968
 969       $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
 970
 971       $count++;
 972       if ( $DEBUG > 1 && $lastprog + 30 < time ) {
 973         warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
 974         $lastprog = time;
 975       }
 976
 977     }
 978
 979     FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
 980   }
 981
 982   ###
 983   # payinfo N/A upgrade
 984   ###
 985
 986   unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
 987
 988     #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
 989
 990     my @na_cust_pay = qsearch( {
 991       'table'     => 'cust_pay',
 992       'hashref'   => {}, #could be encrypted# { 'payinfo' => 'N/A' },
 993       'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
 994     } );
 995
 996     foreach my $na ( @na_cust_pay ) {
 997
 998       next unless $na->payinfo eq 'N/A';
 999
1000       my $cust_pay_pending =
1001         qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1002       unless ( $cust_pay_pending ) {
1003         warn " *** WARNING: not-yet recoverable N/A card for payment ".
1004              $na->paynum. " (no cust_pay_pending)\n";
1005         next;
1006       }
1007       $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1008       my $error = $na->replace;
1009       if ( $error ) {
1010         warn " *** WARNING: Error updating payinfo for payment paynum ".
1011              $na->paynun. ": $error\n";
1012         next;
1013       }
1014
1015     }
1016
1017     FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1018   }
1019
1020   ###
1021   # otaker->usernum upgrade
1022   ###
1023
1024   delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1025   $class->_upgrade_otaker(%opts);
1026   $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1027
1028   ###
1029   # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1030   ###
1031   my @cust_pay = qsearch( {
1032       'table'     => 'cust_pay',
1033       'addl_from' => ' JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS text) ',
1034   } );
1035   foreach my $cust_pay (@cust_pay) {
1036     $cust_pay->set('batchnum' => $cust_pay->paybatch);
1037     $cust_pay->set('paybatch' => '');
1038     my $error = $cust_pay->replace;
1039     warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n  $error"
1040     if $error;
1041   }
1042
1043   ###
1044   # migrate gateway info from the misused 'paybatch' field
1045   ###
1046
1047   # not only cust_pay, but also voided and refunded payments
1048   if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1049     local $FS::Record::nowarn_classload=1;
1050     # really inefficient, but again, only has to run once
1051     foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1052       my $and_batchnum_is_null =
1053         ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1054       foreach my $object ( qsearch({
1055             table     => $table,
1056             extra_sql => "WHERE payby IN('CARD','CHEK') ".
1057                          "AND (paybatch IS NOT NULL ".
1058                          "OR (paybatch IS NULL AND auth IS NULL
1059                          $and_batchnum_is_null ) )",
1060           }) )
1061       {
1062         if ( $object->paybatch eq '' ) {
1063           # repair for a previous upgrade that didn't save 'auth'
1064           my $pkey = $object->primary_key;
1065           # find the last history record that had a paybatch value
1066           my $h = qsearchs({
1067               table   => "h_$table",
1068               hashref => {
1069                 $pkey     => $object->$pkey,
1070                 paybatch  => { op=>'!=', value=>''},
1071                 history_action => 'replace_old',
1072               },
1073               order_by => 'ORDER BY history_date DESC LIMIT 1',
1074           });
1075           if (!$h) {
1076             warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1077             next;
1078           }
1079           # if the paybatch didn't have an auth string, then it's fine
1080           $h->paybatch =~ /:(\w+):/ or next;
1081           # set paybatch to what it was in that record
1082           $object->set('paybatch', $h->paybatch)
1083           # and then upgrade it like the old records
1084         }
1085
1086         my $parsed = $object->_parse_paybatch;
1087         if (keys %$parsed) {
1088           $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1089           $object->set('auth' => $parsed->{authorization});
1090           $object->set('paybatch', '');
1091           my $error = $object->replace;
1092           warn "error parsing CARD/CHEK paybatch fields on $object #".
1093             $object->get($object->primary_key).":\n  $error\n"
1094             if $error;
1095         }
1096       } #$object
1097     } #$table
1098     FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1099   }
1100 }
1101
1102 =back
1103
1104 =head1 SUBROUTINES
1105
1106 =over 4
1107
1108 =item batch_import HASHREF
1109
1110 Inserts new payments.
1111
1112 =cut
1113
1114 sub batch_import {
1115   my $param = shift;
1116
1117   my $fh = $param->{filehandle};
1118   my $agentnum = $param->{agentnum};
1119   my $format = $param->{'format'};
1120   my $paybatch = $param->{'paybatch'};
1121
1122   # here is the agent virtualization
1123   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1124
1125   my @fields;
1126   my $payby;
1127   if ( $format eq 'simple' ) {
1128     @fields = qw( custnum agent_custid paid payinfo );
1129     $payby = 'BILL';
1130   } elsif ( $format eq 'extended' ) {
1131     die "unimplemented\n";
1132     @fields = qw( );
1133     $payby = 'BILL';
1134   } else {
1135     die "unknown format $format";
1136   }
1137
1138   eval "use Text::CSV_XS;";
1139   die $@ if $@;
1140
1141   my $csv = new Text::CSV_XS;
1142
1143   my $imported = 0;
1144
1145   local $SIG{HUP} = 'IGNORE';
1146   local $SIG{INT} = 'IGNORE';
1147   local $SIG{QUIT} = 'IGNORE';
1148   local $SIG{TERM} = 'IGNORE';
1149   local $SIG{TSTP} = 'IGNORE';
1150   local $SIG{PIPE} = 'IGNORE';
1151
1152   my $oldAutoCommit = $FS::UID::AutoCommit;
1153   local $FS::UID::AutoCommit = 0;
1154   my $dbh = dbh;
1155
1156   my $line;
1157   while ( defined($line=<$fh>) ) {
1158
1159     $csv->parse($line) or do {
1160       $dbh->rollback if $oldAutoCommit;
1161       return "can't parse: ". $csv->error_input();
1162     };
1163
1164     my @columns = $csv->fields();
1165
1166     my %cust_pay = (
1167       payby    => $payby,
1168       paybatch => $paybatch,
1169     );
1170
1171     my $cust_main;
1172     foreach my $field ( @fields ) {
1173
1174       if ( $field eq 'agent_custid'
1175         && $agentnum
1176         && $columns[0] =~ /\S+/ )
1177       {
1178
1179         my $agent_custid = $columns[0];
1180         my %hash = ( 'agent_custid' => $agent_custid,
1181                      'agentnum'     => $agentnum,
1182                    );
1183
1184         if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1185           $dbh->rollback if $oldAutoCommit;
1186           return "can't specify custnum with agent_custid $agent_custid";
1187         }
1188
1189         $cust_main = qsearchs({
1190                                 'table'     => 'cust_main',
1191                                 'hashref'   => \%hash,
1192                                 'extra_sql' => $extra_sql,
1193                              });
1194
1195         unless ( $cust_main ) {
1196           $dbh->rollback if $oldAutoCommit;
1197           return "can't find customer with agent_custid $agent_custid";
1198         }
1199
1200         $field = 'custnum';
1201         $columns[0] = $cust_main->custnum;
1202       }
1203
1204       $cust_pay{$field} = shift @columns;
1205     }
1206
1207     my $cust_pay = new FS::cust_pay( \%cust_pay );
1208     my $error = $cust_pay->insert;
1209
1210     if ( $error ) {
1211       $dbh->rollback if $oldAutoCommit;
1212       return "can't insert payment for $line: $error";
1213     }
1214
1215     if ( $format eq 'simple' ) {
1216       # include agentnum for less surprise?
1217       $cust_main = qsearchs({
1218                              'table'     => 'cust_main',
1219                              'hashref'   => { 'custnum' => $cust_pay->custnum },
1220                              'extra_sql' => $extra_sql,
1221                            })
1222         unless $cust_main;
1223
1224       unless ( $cust_main ) {
1225         $dbh->rollback if $oldAutoCommit;
1226         return "can't find customer to which payments apply at line: $line";
1227       }
1228
1229       $error = $cust_main->apply_payments_and_credits;
1230       if ( $error ) {
1231         $dbh->rollback if $oldAutoCommit;
1232         return "can't apply payments to customer for $line: $error";
1233       }
1234
1235     }
1236
1237     $imported++;
1238   }
1239
1240   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1241
1242   return "Empty file!" unless $imported;
1243
1244   ''; #no error
1245
1246 }
1247
1248 =back
1249
1250 =head1 BUGS
1251
1252 Delete and replace methods.
1253
1254 =head1 SEE ALSO
1255
1256 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1257 schema.html from the base documentation.
1258
1259 =cut
1260
1261 1;
1262