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