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