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