4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
5 FS::reason_Mixin FS::Record);
6 use vars qw( $DEBUG $me $conf @encrypted_fields
10 use Business::CreditCard;
12 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
13 use FS::Record qw( dbh qsearch qsearchs );
14 use FS::UID qw( driver_name );
17 use FS::cust_main_Mixin;
18 use FS::payinfo_transaction_Mixin;
20 use FS::cust_bill_pay;
21 use FS::cust_pay_refund;
24 use FS::cust_pay_void;
25 use FS::upgrade_journal;
32 $me = '[FS::cust_pay]';
36 #ask FS::UID to run this stuff for us later
37 FS::UID->install_callback( sub {
41 @encrypted_fields = ('payinfo');
42 sub nohistory_fields { ('payinfo'); }
46 FS::cust_pay - Object methods for cust_pay objects
52 $record = new FS::cust_pay \%hash;
53 $record = new FS::cust_pay { 'column' => 'value' };
55 $error = $record->insert;
57 $error = $new_record->replace($old_record);
59 $error = $record->delete;
61 $error = $record->check;
65 An FS::cust_pay object represents a payment; the transfer of money from a
66 customer. FS::cust_pay inherits from FS::Record. The following fields are
73 primary key (assigned automatically for new payments)
77 customer (see L<FS::cust_main>)
81 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
82 L<Time::Local> and L<Date::Parse> for conversion functions.
86 Amount of this payment
90 order taker (see L<FS::access_user>)
94 Payment Type (See L<FS::payinfo_Mixin> for valid values)
98 Payment Information (See L<FS::payinfo_Mixin> for data format)
102 Credit card type, if appropriate; autodetected.
106 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
110 obsolete text field for tracking card processing or other batch grouping
114 Optional unique identifer to prevent duplicate transactions.
118 books closed flag, empty or `Y'
122 Desired pkgnum when using experimental package balances.
126 Flag to only allow manual application of payment, empty or 'Y'
130 The bank where the payment was deposited.
134 The name of the depositor.
138 The deposit account number.
146 The number of the batch this payment came from (see L<FS::pay_batch>),
147 or null if it was processed through a realtime gateway or entered manually.
151 The number of the realtime or batch gateway L<FS::payment_gateway>) this
152 payment was processed through. Null if it was entered manually or processed
153 by the "system default" gateway, which doesn't have a number.
157 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
158 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
159 redundant with C<gatewaynum>.
163 The authorization number returned by the credit card network.
167 The transaction ID returned by the gateway, if any. This is usually what
168 you would use to initiate a void or refund of the payment.
178 Creates a new payment. To add the payment to the databse, see L<"insert">.
182 sub table { 'cust_pay'; }
183 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
184 sub cust_unlinked_msg {
186 "WARNING: can't find cust_main.custnum ". $self->custnum.
187 ' (cust_pay.paynum '. $self->paynum. ')';
190 =item insert [ OPTION => VALUE ... ]
192 Adds this payment to the database.
194 For backwards-compatibility and convenience, if the additional field invnum
195 is defined, an FS::cust_bill_pay record for the full amount of the payment
196 will be created. In this case, custnum is optional.
198 If the additional field discount_term is defined then a prepayment discount
199 is taken for that length of time. It is an error for the customer to owe
200 after this payment is made.
202 A hash of optional arguments may be passed. The following arguments are
209 If true, a payment receipt is sent instead of a statement when
210 'payment_receipt_email' configuration option is set.
212 About the "manual" flag: Normally, if the 'payment_receipt' config option
213 is set, and the customer has an invoice email address, inserting a payment
214 causes a I<statement> to be emailed to the customer. If the payment is
215 considered "manual" (or if the customer has no invoices), then it will
216 instead send a I<payment receipt>. "manual" should be true whenever a
217 payment is created directly from the web interface, from a user-initiated
218 realtime payment, or from a third-party payment via self-service. It should
219 be I<false> when creating a payment from a billing event or from a batch.
223 Don't send an email receipt. (Note: does not currently work when
224 payment_receipt-trigger is set to something other than default / cust_bill)
231 my($self, %options) = @_;
233 local $SIG{HUP} = 'IGNORE';
234 local $SIG{INT} = 'IGNORE';
235 local $SIG{QUIT} = 'IGNORE';
236 local $SIG{TERM} = 'IGNORE';
237 local $SIG{TSTP} = 'IGNORE';
238 local $SIG{PIPE} = 'IGNORE';
240 my $oldAutoCommit = $FS::UID::AutoCommit;
241 local $FS::UID::AutoCommit = 0;
244 my $conf = new FS::Conf;
247 if ( $self->invnum ) {
248 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
250 $dbh->rollback if $oldAutoCommit;
251 return "Unknown cust_bill.invnum: ". $self->invnum;
253 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
254 $dbh->rollback if $oldAutoCommit;
255 return "Invoice custnum ".$cust_bill->custnum
256 ." does not match specified custnum ".$self->custnum
257 ." for invoice ".$self->invnum;
259 $self->custnum($cust_bill->custnum );
262 my $error = $self->check;
263 return $error if $error;
265 my $cust_main = $self->cust_main;
266 my $old_balance = $cust_main->balance;
268 $error = $self->SUPER::insert;
270 $dbh->rollback if $oldAutoCommit;
271 return "error inserting cust_pay: $error";
274 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
275 if ( my $months = $self->discount_term ) {
276 # XXX this should be moved out somewhere, but discount_term_values
278 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
279 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
281 # %billing_pkgs contains this customer's active monthly packages.
282 # Recurring fees for those packages will be credited and then rebilled
283 # for the full discount term. Other packages on the last invoice
284 # (canceled, non-monthly recurring, or one-time charges) will be
286 my %billing_pkgs = map { $_->pkgnum => $_ }
287 grep { $_->part_pkg->freq eq '1' }
288 $cust_main->billing_pkgs;
289 my $credit = 0; # sum of recurring charges from that invoice
290 my $last_bill_date = 0; # the real bill date
291 foreach my $item ( $cust_bill->cust_bill_pkg ) {
292 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
293 $credit += $item->recur;
294 $last_bill_date = $item->cust_pkg->last_bill
295 if defined($item->cust_pkg)
296 and $item->cust_pkg->last_bill > $last_bill_date
299 my $cust_credit = new FS::cust_credit {
300 'custnum' => $self->custnum,
301 'amount' => sprintf('%.2f', $credit),
302 'reason' => 'customer chose to prepay for discount',
304 $error = $cust_credit->insert('reason_type' => $credit_type);
306 $dbh->rollback if $oldAutoCommit;
307 return "error inserting prepayment credit: $error";
311 # bill for the entire term
312 $_->bill($_->last_bill) foreach (values %billing_pkgs);
313 $error = $cust_main->bill(
314 # no recurring_only, we want unbilled packages with start dates to
316 'no_usage_reset' => 1,
317 'time' => $last_bill_date, # not $cust_bill->_date
318 'pkg_list' => [ values %billing_pkgs ],
319 'freq_override' => $months,
322 $dbh->rollback if $oldAutoCommit;
323 return "error inserting cust_pay: $error";
325 $error = $cust_main->apply_payments_and_credits;
327 $dbh->rollback if $oldAutoCommit;
328 return "error inserting cust_pay: $error";
330 my $new_balance = $cust_main->balance;
331 if ($new_balance > 0) {
332 $dbh->rollback if $oldAutoCommit;
333 return "balance after prepay discount attempt: $new_balance";
335 # user friendly: override the "apply only to this invoice" mode
342 if ( $self->invnum ) {
343 my $cust_bill_pay = new FS::cust_bill_pay {
344 'invnum' => $self->invnum,
345 'paynum' => $self->paynum,
346 'amount' => $self->paid,
347 '_date' => $self->_date,
349 $error = $cust_bill_pay->insert(%options);
351 if ( $ignore_noapply ) {
352 warn "warning: error inserting cust_bill_pay: $error ".
353 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
355 $dbh->rollback if $oldAutoCommit;
356 return "error inserting cust_bill_pay: $error";
361 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
363 # possibly trigger package unsuspend, doesn't abort transaction on failure
364 $self->unsuspend_balance if $old_balance;
366 #bill setup fees for voip_cdr bill_every_call packages
367 #some false laziness w/search in freeside-cdrd
369 'LEFT JOIN part_pkg USING ( pkgpart ) '.
370 "LEFT JOIN part_pkg_option
371 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
372 AND part_pkg_option.optionname = 'bill_every_call' )";
374 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
375 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
377 my @cust_pkg = qsearch({
378 'table' => 'cust_pkg',
379 'addl_from' => $addl_from,
380 'hashref' => { 'custnum' => $self->custnum,
384 'extra_sql' => $extra_sql,
388 warn "voip_cdr bill_every_call packages found; billing customer\n";
389 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
391 warn "WARNING: Error billing customer: $bill_error\n";
394 #end of billing setup fees for voip_cdr bill_every_call packages
396 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
398 $self->{'processing_fee'} = $options{'processing-fee'};
401 my $trigger = $conf->config('payment_receipt-trigger',
402 $self->cust_main->agentnum) || 'cust_pay';
403 if ( $trigger eq 'cust_pay' ) {
404 my $error = $self->send_receipt(
405 'manual' => $options{'manual'},
406 'noemail' => $options{'noemail'},
407 'cust_bill' => $cust_bill,
408 'cust_main' => $cust_main,
410 warn "can't send payment receipt/statement: $error" if $error;
413 #run payment events immediately
414 my $due_cust_event = $self->cust_main->due_cust_event(
415 'eventtable' => 'cust_pay',
416 'objects' => [ $self ],
418 if ( !ref($due_cust_event) ) {
419 warn "Error searching for cust_pay billing events: $due_cust_event\n";
421 foreach my $cust_event (@$due_cust_event) {
422 next unless $cust_event->test_conditions;
423 if ( my $error = $cust_event->do_event() ) {
424 warn "Error running cust_pay billing event: $error\n";
433 =item void [ REASON ]
435 Voids this payment: deletes the payment and all associated applications and
436 adds a record of the voided payment to the FS::cust_pay_void table.
444 unless (ref($reason) || !$reason) {
445 $reason = FS::reason->new_or_existing(
447 'type' => 'Void payment',
452 local $SIG{HUP} = 'IGNORE';
453 local $SIG{INT} = 'IGNORE';
454 local $SIG{QUIT} = 'IGNORE';
455 local $SIG{TERM} = 'IGNORE';
456 local $SIG{TSTP} = 'IGNORE';
457 local $SIG{PIPE} = 'IGNORE';
459 my $oldAutoCommit = $FS::UID::AutoCommit;
460 local $FS::UID::AutoCommit = 0;
463 my $cust_pay_void = new FS::cust_pay_void ( {
464 map { $_ => $self->get($_) } $self->fields
466 $cust_pay_void->reasonnum($reason->reasonnum) if $reason;
467 my $error = $cust_pay_void->insert;
469 my $cust_pay_pending =
470 qsearchs('cust_pay_pending', { paynum => $self->paynum });
471 if ( $cust_pay_pending ) {
472 $cust_pay_pending->set('void_paynum', $self->paynum);
473 $cust_pay_pending->set('paynum', '');
474 $error ||= $cust_pay_pending->replace;
477 $error ||= $self->delete;
480 $dbh->rollback if $oldAutoCommit;
484 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
492 Unless the closed flag is set, deletes this payment and all associated
493 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
494 cases, you want to use the void method instead to leave a record of the
499 # very similar to FS::cust_credit::delete
502 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
504 local $SIG{HUP} = 'IGNORE';
505 local $SIG{INT} = 'IGNORE';
506 local $SIG{QUIT} = 'IGNORE';
507 local $SIG{TERM} = 'IGNORE';
508 local $SIG{TSTP} = 'IGNORE';
509 local $SIG{PIPE} = 'IGNORE';
511 my $oldAutoCommit = $FS::UID::AutoCommit;
512 local $FS::UID::AutoCommit = 0;
515 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
516 my $error = $app->delete;
518 $dbh->rollback if $oldAutoCommit;
523 my $error = $self->SUPER::delete(@_);
525 $dbh->rollback if $oldAutoCommit;
529 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
535 =item replace [ OLD_RECORD ]
537 You can, but probably shouldn't modify payments...
539 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
540 supplied, replaces this record. If there is an error, returns the error,
541 otherwise returns false.
547 return "Can't modify closed payment"
548 if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace;
549 $self->SUPER::replace(@_);
554 Checks all fields to make sure this is a valid payment. If there is an error,
555 returns the error, otherwise returns false. Called by the insert method.
562 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
565 $self->ut_numbern('paynum')
566 || $self->ut_numbern('custnum')
567 || $self->ut_numbern('_date')
568 || $self->ut_money('paid')
569 || $self->ut_alphan('otaker')
570 || $self->ut_textn('paybatch')
571 || $self->ut_textn('payunique')
572 || $self->ut_enum('closed', [ '', 'Y' ])
573 || $self->ut_flag('no_auto_apply')
574 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
575 || $self->ut_textn('bank')
576 || $self->ut_alphan('depositor')
577 || $self->ut_numbern('account')
578 || $self->ut_numbern('teller')
579 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
580 || $self->payinfo_check()
582 return $error if $error;
584 return "paid must be > 0 " if $self->paid <= 0;
586 return "unknown cust_main.custnum: ". $self->custnum
588 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
590 $self->_date(time) unless $self->_date;
592 return "invalid discount_term"
593 if ($self->discount_term && $self->discount_term < 2);
595 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
596 foreach (qw(bank depositor account teller)) {
597 return "$_ required" if $self->get($_) eq '';
601 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
602 # # UNIQUE index should catch this too, without race conditions, but this
603 # # should give a better error message the other 99.9% of the time...
604 # if ( length($self->payunique)
605 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
606 # #well, it *could* be a better error message
607 # return "duplicate transaction".
608 # " - a payment with unique identifer ". $self->payunique.
615 =item send_receipt HASHREF | OPTION => VALUE ...
617 Sends a payment receipt for this payment..
625 Flag indicating the payment is being made manually.
629 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
634 Customer (FS::cust_main) object (for efficiency).
638 Don't send an email receipt.
648 my $opt = ref($_[0]) ? shift : { @_ };
650 my $cust_bill = $opt->{'cust_bill'};
651 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
653 my $conf = new FS::Conf;
655 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
657 return '' if ($conf->config_bool('allow_payment_receipt_noemail', $cust_main->agentnum) && $cust_main->paymentreceipt_noemail);
659 my @invoicing_list = $cust_main->invoicing_list_emailonly;
660 return '' unless @invoicing_list;
662 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
666 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
667 #|| ! $conf->exists('invoice_html_statement')
671 $error = $self->send_message_receipt(
672 'cust_main' => $cust_main,
673 'cust_bill' => $opt->{cust_bill},
674 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
676 #not manual and no noemail flag (here or on the customer)
677 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
679 # check to see if they want to send specific message template as receipt for auto payments
680 if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) {
681 $error = $self->send_message_receipt(
682 'cust_main' => $cust_main,
683 'cust_bill' => $opt->{cust_bill},
684 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum),
688 my $queue = new FS::queue {
689 'job' => 'FS::cust_bill::queueable_email',
690 'paynum' => $self->paynum,
691 'custnum' => $cust_main->custnum,
695 'invnum' => $cust_bill->invnum,
699 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
700 $opt{'mode'} = $mode;
702 # backward compatibility, no good fix for this yet as some people may
703 # still have "invoice_latex_statement" and such options
704 $opt{'template'} = 'statement';
705 $opt{'notice_name'} = 'Statement';
708 $error = $queue->insert(%opt);
715 warn "send_receipt: $error\n" if $error;
718 =item send_message_receipt
720 sends out a message receipt.
721 $error = $self->send_message_receipt(
722 'cust_main' => $cust_main,
723 'cust_bill' => $opt->{cust_bill},
724 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
729 sub send_message_receipt {
730 my ($self, %opt) = @_;
731 my $cust_main = $opt{'cust_main'};
732 my $cust_bill = $opt{'cust_bill'};
733 my $msgnum = $opt{'msgnum'};
738 my %substitutions = ();
739 $substitutions{invnum} = $cust_bill->invnum if $cust_bill;
740 $substitutions{'processing_fee'} = $self->{'processing_fee'};
743 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
744 unless ($msg_template) {
745 warn "send_receipt could not load msg_template";
749 my $cust_msg = $msg_template->prepare(
750 'cust_main' => $cust_main,
752 'from_config' => 'payment_receipt_from',
753 'substitutions' => \%substitutions,
754 'msgtype' => 'receipt',
756 $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
758 warn "send_receipt: $error";
762 my $queue = new FS::queue {
763 'job' => 'FS::cust_msg::process_send',
764 'paynum' => $self->paynum,
765 'custnum' => $cust_main->custnum,
767 $error = $queue->insert( $cust_msg->custmsgnum );
770 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
771 $error = "payment_receipt is on, but no payment_receipt_msgnum";
779 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
786 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
787 sort { $a->_date <=> $b->_date
788 || $a->invnum <=> $b->invnum }
789 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
793 =item cust_pay_refund
795 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
800 sub cust_pay_refund {
802 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
803 sort { $a->_date <=> $b->_date }
804 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
811 Returns the amount of this payment that is still unapplied; which is
812 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
813 applications (see L<FS::cust_pay_refund>).
819 my $amount = $self->paid;
820 $amount -= $_->amount foreach ( $self->cust_bill_pay );
821 $amount -= $_->amount foreach ( $self->cust_pay_refund );
822 sprintf("%.2f", $amount );
827 Returns the amount of this payment that has not been refuned; which is
828 paid minus all refund applications (see L<FS::cust_pay_refund>).
834 my $amount = $self->paid;
835 $amount -= $_->amount foreach ( $self->cust_pay_refund );
836 sprintf("%.2f", $amount );
841 Returns the "paid" field.
850 =item delete_cust_bill_pay OPTIONS
852 Deletes all associated cust_bill_pay records.
854 If option 'unapplied' is a specified, only deletes until
855 this object's 'unapplied' value is >= the specified amount.
856 (Deletes in order returned by L</cust_bill_pay>.)
860 sub delete_cust_bill_pay {
864 local $SIG{HUP} = 'IGNORE';
865 local $SIG{INT} = 'IGNORE';
866 local $SIG{QUIT} = 'IGNORE';
867 local $SIG{TERM} = 'IGNORE';
868 local $SIG{TSTP} = 'IGNORE';
869 local $SIG{PIPE} = 'IGNORE';
871 my $oldAutoCommit = $FS::UID::AutoCommit;
872 local $FS::UID::AutoCommit = 0;
875 my $unapplied = $self->unapplied; #only need to look it up once
879 # Maybe we should reverse the order these get deleted in?
880 # ie delete newest first?
881 # keeping consistent with how bop refunds work, for now...
882 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
883 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
884 $unapplied += $cust_bill_pay->amount;
885 $error = $cust_bill_pay->delete;
890 $dbh->rollback if $oldAutoCommit;
894 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
900 Accepts input for creating a new FS::cust_refund object.
901 Unapplies payment from invoices up to the amount of the refund,
902 creates the refund and applies payment to refund. Allows entire
903 process to be handled in one transaction.
905 Causes a fatal error if called on CARD or CHEK payments.
912 die "Cannot call cust_pay->refund on " . $self->payby
913 if grep { $_ eq $self->payby } qw(CARD CHEK);
915 local $SIG{HUP} = 'IGNORE';
916 local $SIG{INT} = 'IGNORE';
917 local $SIG{QUIT} = 'IGNORE';
918 local $SIG{TERM} = 'IGNORE';
919 local $SIG{TSTP} = 'IGNORE';
920 local $SIG{PIPE} = 'IGNORE';
922 my $oldAutoCommit = $FS::UID::AutoCommit;
923 local $FS::UID::AutoCommit = 0;
926 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
929 $dbh->rollback if $oldAutoCommit;
933 $hash->{'paynum'} = $self->paynum;
934 my $new = new FS::cust_refund ( $hash );
935 $error = $new->insert;
938 $dbh->rollback if $oldAutoCommit;
942 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
946 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
948 =item refund_to_unapply
950 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
951 (all currently applied refunds that aren't closed.)
952 Returns empty list if payment itself is closed.
956 sub refund_to_unapply {
958 return () if $self->closed;
960 'table' => 'cust_pay_refund',
961 'hashref' => { 'paynum' => $self->paynum },
962 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
963 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
969 Deletes all objects returned by L</refund_to_unapply>.
976 local $SIG{HUP} = 'IGNORE';
977 local $SIG{INT} = 'IGNORE';
978 local $SIG{QUIT} = 'IGNORE';
979 local $SIG{TERM} = 'IGNORE';
980 local $SIG{TSTP} = 'IGNORE';
981 local $SIG{PIPE} = 'IGNORE';
983 my $oldAutoCommit = $FS::UID::AutoCommit;
984 local $FS::UID::AutoCommit = 0;
986 foreach my $cust_pay_refund ($self->refund_to_unapply) {
987 my $error = $cust_pay_refund->delete;
989 dbh->rollback if $oldAutoCommit;
994 dbh->commit or die dbh->errstr if $oldAutoCommit;
1000 =head1 CLASS METHODS
1004 =item batch_insert CUST_PAY_OBJECT, ...
1006 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1007 objects. Returns a list, each element representing the status of inserting the
1008 corresponding payment - empty. If there is an error inserting any payment, the
1009 entire transaction is rolled back, i.e. all payments are inserted or none are.
1011 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1012 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1013 those objects will be inserted with the paynum of the payment, and for
1014 each one, an error message or an empty string will be inserted into the
1019 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1020 my $num_errors = scalar(grep $_, @errors);
1021 if ( $num_errors == 0 ) {
1022 #success; all payments were inserted
1024 #failure; no payments were inserted.
1030 my $self = shift; #class method
1032 local $SIG{HUP} = 'IGNORE';
1033 local $SIG{INT} = 'IGNORE';
1034 local $SIG{QUIT} = 'IGNORE';
1035 local $SIG{TERM} = 'IGNORE';
1036 local $SIG{TSTP} = 'IGNORE';
1037 local $SIG{PIPE} = 'IGNORE';
1039 my $oldAutoCommit = $FS::UID::AutoCommit;
1040 local $FS::UID::AutoCommit = 0;
1046 foreach my $cust_pay (@_) {
1047 my $error = $cust_pay->insert( 'manual' => 1 );
1048 push @errors, $error;
1049 $num_errors++ if $error;
1051 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1053 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1054 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1058 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1059 my $apply_error = $cust_bill_pay->insert;
1060 push @errors, $apply_error || '';
1061 $num_errors++ if $apply_error;
1065 } elsif ( !$error ) { #normal case: apply payments as usual
1066 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1071 if ( $num_errors ) {
1072 $dbh->rollback if $oldAutoCommit;
1074 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1083 Returns an SQL fragment to retreive the unapplied amount.
1088 my ($class, $start, $end) = @_;
1089 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1090 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1091 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1092 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1096 ( SELECT SUM(amount) FROM cust_bill_pay
1097 WHERE cust_pay.paynum = cust_bill_pay.paynum
1098 $bill_start $bill_end )
1102 ( SELECT SUM(amount) FROM cust_pay_refund
1103 WHERE cust_pay.paynum = cust_pay_refund.paynum
1104 $refund_start $refund_end )
1113 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1114 +{ ( map { $_=>$self->$_ } @fields ),
1123 #my( $self, %opt ) = @_;
1126 +{ 'paynum' => $self->paynum,
1127 '_date' => $self->_date,
1128 'date' => time2str("%b %o, %Y", $self->_date),
1129 'date_short' => time2str("%m-%d-%Y", $self->_date),
1130 'paid' => sprintf('%.2f', $self->paid),
1131 'payby' => $self->payby,
1132 'paycardtype' => $self->paycardtype,
1133 'paymask' => $self->paymask,
1134 'processor' => $self->processor,
1135 'auth' => $self->auth,
1136 'order_number' => $self->order_number,
1144 # Used by FS::Upgrade to migrate to a new database.
1148 sub _upgrade_data { #class method
1149 my ($class, %opt) = @_;
1151 warn "$me upgrading $class\n" if $DEBUG;
1153 $class->_upgrade_reasonnum(%opt);
1155 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1158 # otaker/ivan upgrade
1161 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1163 #not the most efficient, but hey, it only has to run once
1165 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1167 AND EXISTS ( SELECT 1 FROM cust_main
1168 WHERE cust_main.custnum = cust_pay.custnum )
1171 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1173 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1174 $sth->execute or die $sth->errstr;
1175 my $total = $sth->fetchrow_arrayref->[0];
1176 #warn "$total cust_pay records to update\n"
1178 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1183 my @cust_pay = qsearch( {
1184 'table' => 'cust_pay',
1186 'extra_sql' => $where,
1187 'order_by' => 'ORDER BY paynum',
1190 foreach my $cust_pay (@cust_pay) {
1192 my $h_cust_pay = $cust_pay->h_search('insert');
1193 if ( $h_cust_pay ) {
1194 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1195 #$cust_pay->otaker($h_cust_pay->history_user);
1196 $cust_pay->set('otaker', $h_cust_pay->history_user);
1198 $cust_pay->set('otaker', 'legacy');
1201 my $error = $cust_pay->replace;
1204 warn " *** WARNING: Error updating order taker for payment paynum ".
1205 $cust_pay->paynun. ": $error\n";
1210 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1211 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1217 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1221 # payinfo N/A upgrade
1224 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1226 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1228 my @na_cust_pay = qsearch( {
1229 'table' => 'cust_pay',
1230 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1231 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1234 foreach my $na ( @na_cust_pay ) {
1236 next unless $na->payinfo eq 'N/A';
1238 my $cust_pay_pending =
1239 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1240 unless ( $cust_pay_pending ) {
1241 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1242 $na->paynum. " (no cust_pay_pending)\n";
1245 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1246 my $error = $na->replace;
1248 warn " *** WARNING: Error updating payinfo for payment paynum ".
1249 $na->paynun. ": $error\n";
1255 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1259 # otaker->usernum upgrade
1262 $class->_upgrade_otaker(%opt);
1264 # if we do this anywhere else, it should become an FS::Upgrade method
1265 my $num_to_upgrade = $class->count('paybatch is not null');
1266 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1267 if ( $num_to_upgrade > 0 ) {
1268 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1269 if ( $opt{queue} ) {
1270 if ( $num_jobs > 0 ) {
1271 warn "Upgrade already queued.\n";
1273 warn "Scheduling upgrade.\n";
1274 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1278 process_upgrade_paybatch();
1285 $class->upgrade_set_cardtype;
1287 # for batch payments, make sure paymask is set
1289 local $FS::payinfo_Mixin::allow_closed_replace = 1;
1290 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1292 my $cursor = FS::Cursor->new({
1293 table => 'cust_pay',
1294 extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1295 AND payby IN(\'CARD\', \'CHEK\')
1296 AND batchnum IS NOT NULL',
1299 # records from cursors for some reason don't decrypt payinfo, so
1300 # call replace_old to fetch the record "normally"
1301 while (my $cust_pay = $cursor->fetch) {
1302 $cust_pay = $cust_pay->replace_old;
1303 $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1304 my $error = $cust_pay->replace;
1306 die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1313 sub process_upgrade_paybatch {
1315 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1316 local $FS::UID::AutoCommit = 1;
1319 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1321 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1322 my $search = FS::Cursor->new( {
1323 'table' => 'cust_pay',
1324 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1326 while (my $cust_pay = $search->fetch) {
1327 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1328 $cust_pay->set('paybatch' => '');
1329 my $error = $cust_pay->replace;
1330 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1335 # migrate gateway info from the misused 'paybatch' field
1338 # not only cust_pay, but also voided and refunded payments
1339 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1340 local $FS::Record::nowarn_classload=1;
1341 # really inefficient, but again, only has to run once
1342 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1343 my $and_batchnum_is_null =
1344 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1345 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1346 my $search = FS::Cursor->new({
1348 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1349 "AND (paybatch IS NOT NULL ".
1350 "OR (paybatch IS NULL AND auth IS NULL
1351 $and_batchnum_is_null ) )
1352 ORDER BY $pkey DESC"
1354 while ( my $object = $search->fetch ) {
1355 if ( $object->paybatch eq '' ) {
1356 # repair for a previous upgrade that didn't save 'auth'
1357 my $pkey = $object->primary_key;
1358 # find the last history record that had a paybatch value
1360 table => "h_$table",
1362 $pkey => $object->$pkey,
1363 paybatch => { op=>'!=', value=>''},
1364 history_action => 'replace_old',
1366 order_by => 'ORDER BY history_date DESC LIMIT 1',
1369 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1372 # if the paybatch didn't have an auth string, then it's fine
1373 $h->paybatch =~ /:(\w+):/ or next;
1374 # set paybatch to what it was in that record
1375 $object->set('paybatch', $h->paybatch)
1376 # and then upgrade it like the old records
1379 my $parsed = $object->_parse_paybatch;
1380 if (keys %$parsed) {
1381 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1382 $object->set('auth' => $parsed->{authorization});
1383 $object->set('paybatch', '');
1384 my $error = $object->replace;
1385 warn "error parsing CARD/CHEK paybatch fields on $object #".
1386 $object->get($object->primary_key).":\n $error\n"
1391 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1401 =item process_batch_import
1405 sub process_batch_import {
1410 my $custnum = $hash{'custnum'};
1411 my $agentnum = $hash{'agentnum'};
1412 my $agent_custid = $hash{'agent_custid'};
1414 $hash{'_date'} = parse_datetime($hash{'_date'})
1415 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1416 #remove custnum_prefix
1417 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1418 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1421 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1422 && length($1) == $custnum_length
1426 # check agentnum against custnum and
1427 # translate agent_custid into regular custnum
1428 if ($custnum && $agent_custid) {
1429 die "can't specify both custnum and agent_custid\n";
1430 } elsif ($agentnum || $agent_custid) {
1431 # here is the agent virtualization
1432 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1434 $search{'agentnum'} = $agentnum
1436 $search{'agent_custid'} = $agent_custid
1438 $search{'custnum'} = $custnum
1440 my $cust_main = qsearchs({
1441 'table' => 'cust_main',
1442 'hashref' => \%search,
1443 'extra_sql' => $extra_sql,
1445 die "can't find customer with" .
1446 ($agentnum ? " agentnum $agentnum" : '') .
1447 ($custnum ? " custnum $custnum" : '') .
1448 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1450 die "mismatched customer number\n"
1451 if $custnum && ($custnum ne $cust_main->custnum);
1452 $custnum = $cust_main->custnum;
1454 $hash{'custnum'} = $custnum;
1455 delete($hash{'agent_custid'});
1460 'table' => 'cust_pay',
1461 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1462 #agent_custid isn't a cust_pay field, see hash callback
1463 'formats' => { 'simple' =>
1464 [ qw(custnum agent_custid paid payinfo invnum) ] },
1465 'format_types' => { 'simple' => '' }, #force infer from file extension
1466 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1467 'format_hash_callbacks' => { 'simple' => $hashcb },
1468 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1469 'postinsert_callback' => sub {
1470 my $cust_pay = shift;
1471 my $cust_main = $cust_pay->cust_main
1472 or return "can't find customer to which payments apply";
1473 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1475 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1480 FS::Record::process_batch_import( $job, $opt, @_ );
1484 =item batch_import HASHREF
1486 Inserts new payments.
1493 my $fh = $param->{filehandle};
1494 my $format = $param->{'format'};
1496 my $agentnum = $param->{agentnum};
1497 my $_date = $param->{_date};
1498 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1499 my $paybatch = $param->{'paybatch'};
1501 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1502 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1504 # here is the agent virtualization
1505 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1509 if ( $format eq 'simple' ) {
1510 @fields = qw( custnum agent_custid paid payinfo invnum );
1512 } elsif ( $format eq 'extended' ) {
1513 die "unimplemented\n";
1517 die "unknown format $format";
1520 eval "use Text::CSV_XS;";
1523 my $csv = new Text::CSV_XS;
1527 local $SIG{HUP} = 'IGNORE';
1528 local $SIG{INT} = 'IGNORE';
1529 local $SIG{QUIT} = 'IGNORE';
1530 local $SIG{TERM} = 'IGNORE';
1531 local $SIG{TSTP} = 'IGNORE';
1532 local $SIG{PIPE} = 'IGNORE';
1534 my $oldAutoCommit = $FS::UID::AutoCommit;
1535 local $FS::UID::AutoCommit = 0;
1539 while ( defined($line=<$fh>) ) {
1541 $csv->parse($line) or do {
1542 $dbh->rollback if $oldAutoCommit;
1543 return "can't parse: ". $csv->error_input();
1546 my @columns = $csv->fields();
1550 paybatch => $paybatch,
1552 $cust_pay{_date} = $_date if $_date;
1555 foreach my $field ( @fields ) {
1557 if ( $field eq 'agent_custid'
1559 && $columns[0] =~ /\S+/ )
1562 my $agent_custid = $columns[0];
1563 my %hash = ( 'agent_custid' => $agent_custid,
1564 'agentnum' => $agentnum,
1567 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1568 $dbh->rollback if $oldAutoCommit;
1569 return "can't specify custnum with agent_custid $agent_custid";
1572 $cust_main = qsearchs({
1573 'table' => 'cust_main',
1574 'hashref' => \%hash,
1575 'extra_sql' => $extra_sql,
1578 unless ( $cust_main ) {
1579 $dbh->rollback if $oldAutoCommit;
1580 return "can't find customer with agent_custid $agent_custid";
1584 $columns[0] = $cust_main->custnum;
1587 $cust_pay{$field} = shift @columns;
1590 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1591 && length($1) == $custnum_length ) {
1592 $cust_pay{custnum} = $2;
1595 my $custnum = $cust_pay{custnum};
1597 my $cust_pay = new FS::cust_pay( \%cust_pay );
1598 my $error = $cust_pay->insert;
1600 if ( ! $error && $cust_pay->custnum != $custnum ) {
1601 #invnum was defined, and ->insert set custnum to the customer for that
1602 #invoice, but it wasn't the one the import specified.
1603 $dbh->rollback if $oldAutoCommit;
1604 $error = "specified invoice #". $cust_pay{invnum}.
1605 " is for custnum ". $cust_pay->custnum.
1606 ", not specified custnum $custnum";
1610 $dbh->rollback if $oldAutoCommit;
1611 return "can't insert payment for $line: $error";
1614 if ( $format eq 'simple' ) {
1615 # include agentnum for less surprise?
1616 $cust_main = qsearchs({
1617 'table' => 'cust_main',
1618 'hashref' => { 'custnum' => $cust_pay->custnum },
1619 'extra_sql' => $extra_sql,
1623 unless ( $cust_main ) {
1624 $dbh->rollback if $oldAutoCommit;
1625 return "can't find customer to which payments apply at line: $line";
1628 $error = $cust_main->apply_payments_and_credits;
1630 $dbh->rollback if $oldAutoCommit;
1631 return "can't apply payments to customer for $line: $error";
1639 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1641 return "Empty file!" unless $imported;
1651 Delete and replace methods.
1655 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1656 schema.html from the base documentation.