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