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