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;
245 if ( $self->invnum ) {
246 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
248 $dbh->rollback if $oldAutoCommit;
249 return "Unknown cust_bill.invnum: ". $self->invnum;
251 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
252 $dbh->rollback if $oldAutoCommit;
253 return "Invoice custnum ".$cust_bill->custnum
254 ." does not match specified custnum ".$self->custnum
255 ." for invoice ".$self->invnum;
257 $self->custnum($cust_bill->custnum );
260 my $error = $self->check;
261 return $error if $error;
263 my $cust_main = $self->cust_main;
264 my $old_balance = $cust_main->balance;
266 $error = $self->SUPER::insert;
268 $dbh->rollback if $oldAutoCommit;
269 return "error inserting cust_pay: $error";
272 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
273 if ( my $months = $self->discount_term ) {
274 # XXX this should be moved out somewhere, but discount_term_values
276 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
277 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
279 # %billing_pkgs contains this customer's active monthly packages.
280 # Recurring fees for those packages will be credited and then rebilled
281 # for the full discount term. Other packages on the last invoice
282 # (canceled, non-monthly recurring, or one-time charges) will be
284 my %billing_pkgs = map { $_->pkgnum => $_ }
285 grep { $_->part_pkg->freq eq '1' }
286 $cust_main->billing_pkgs;
287 my $credit = 0; # sum of recurring charges from that invoice
288 my $last_bill_date = 0; # the real bill date
289 foreach my $item ( $cust_bill->cust_bill_pkg ) {
290 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
291 $credit += $item->recur;
292 $last_bill_date = $item->cust_pkg->last_bill
293 if defined($item->cust_pkg)
294 and $item->cust_pkg->last_bill > $last_bill_date
297 my $cust_credit = new FS::cust_credit {
298 'custnum' => $self->custnum,
299 'amount' => sprintf('%.2f', $credit),
300 'reason' => 'customer chose to prepay for discount',
302 $error = $cust_credit->insert('reason_type' => $credit_type);
304 $dbh->rollback if $oldAutoCommit;
305 return "error inserting prepayment credit: $error";
309 # bill for the entire term
310 $_->bill($_->last_bill) foreach (values %billing_pkgs);
311 $error = $cust_main->bill(
312 # no recurring_only, we want unbilled packages with start dates to
314 'no_usage_reset' => 1,
315 'time' => $last_bill_date, # not $cust_bill->_date
316 'pkg_list' => [ values %billing_pkgs ],
317 'freq_override' => $months,
320 $dbh->rollback if $oldAutoCommit;
321 return "error inserting cust_pay: $error";
323 $error = $cust_main->apply_payments_and_credits;
325 $dbh->rollback if $oldAutoCommit;
326 return "error inserting cust_pay: $error";
328 my $new_balance = $cust_main->balance;
329 if ($new_balance > 0) {
330 $dbh->rollback if $oldAutoCommit;
331 return "balance after prepay discount attempt: $new_balance";
333 # user friendly: override the "apply only to this invoice" mode
340 if ( $self->invnum ) {
341 my $cust_bill_pay = new FS::cust_bill_pay {
342 'invnum' => $self->invnum,
343 'paynum' => $self->paynum,
344 'amount' => $self->paid,
345 '_date' => $self->_date,
347 $error = $cust_bill_pay->insert(%options);
349 if ( $ignore_noapply ) {
350 warn "warning: error inserting cust_bill_pay: $error ".
351 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
353 $dbh->rollback if $oldAutoCommit;
354 return "error inserting cust_bill_pay: $error";
359 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
361 # possibly trigger package unsuspend, doesn't abort transaction on failure
362 $self->unsuspend_balance if $old_balance;
364 #bill setup fees for voip_cdr bill_every_call packages
365 #some false laziness w/search in freeside-cdrd
367 'LEFT JOIN part_pkg USING ( pkgpart ) '.
368 "LEFT JOIN part_pkg_option
369 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
370 AND part_pkg_option.optionname = 'bill_every_call' )";
372 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
373 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
375 my @cust_pkg = qsearch({
376 'table' => 'cust_pkg',
377 'addl_from' => $addl_from,
378 'hashref' => { 'custnum' => $self->custnum,
382 'extra_sql' => $extra_sql,
386 warn "voip_cdr bill_every_call packages found; billing customer\n";
387 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
389 warn "WARNING: Error billing customer: $bill_error\n";
392 #end of billing setup fees for voip_cdr bill_every_call packages
394 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
397 my $trigger = $conf->config('payment_receipt-trigger',
398 $self->cust_main->agentnum) || 'cust_pay';
399 if ( $trigger eq 'cust_pay' ) {
400 my $error = $self->send_receipt(
401 'manual' => $options{'manual'},
402 'noemail' => $options{'noemail'},
403 'cust_bill' => $cust_bill,
404 'cust_main' => $cust_main,
406 warn "can't send payment receipt/statement: $error" if $error;
409 #run payment events immediately
410 my $due_cust_event = $self->cust_main->due_cust_event(
411 'eventtable' => 'cust_pay',
412 'objects' => [ $self ],
414 if ( !ref($due_cust_event) ) {
415 warn "Error searching for cust_pay billing events: $due_cust_event\n";
417 foreach my $cust_event (@$due_cust_event) {
418 next unless $cust_event->test_conditions;
419 if ( my $error = $cust_event->do_event() ) {
420 warn "Error running cust_pay billing event: $error\n";
429 =item void [ REASON ]
431 Voids this payment: deletes the payment and all associated applications and
432 adds a record of the voided payment to the FS::cust_pay_void table.
440 unless (ref($reason) || !$reason) {
441 $reason = FS::reason->new_or_existing(
443 'type' => 'Void payment',
448 local $SIG{HUP} = 'IGNORE';
449 local $SIG{INT} = 'IGNORE';
450 local $SIG{QUIT} = 'IGNORE';
451 local $SIG{TERM} = 'IGNORE';
452 local $SIG{TSTP} = 'IGNORE';
453 local $SIG{PIPE} = 'IGNORE';
455 my $oldAutoCommit = $FS::UID::AutoCommit;
456 local $FS::UID::AutoCommit = 0;
459 my $cust_pay_void = new FS::cust_pay_void ( {
460 map { $_ => $self->get($_) } $self->fields
462 $cust_pay_void->reasonnum($reason->reasonnum) if $reason;
463 my $error = $cust_pay_void->insert;
465 my $cust_pay_pending =
466 qsearchs('cust_pay_pending', { paynum => $self->paynum });
467 if ( $cust_pay_pending ) {
468 $cust_pay_pending->set('void_paynum', $self->paynum);
469 $cust_pay_pending->set('paynum', '');
470 $error ||= $cust_pay_pending->replace;
473 $error ||= $self->delete;
476 $dbh->rollback if $oldAutoCommit;
480 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
488 Unless the closed flag is set, deletes this payment and all associated
489 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
490 cases, you want to use the void method instead to leave a record of the
495 # very similar to FS::cust_credit::delete
498 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
500 local $SIG{HUP} = 'IGNORE';
501 local $SIG{INT} = 'IGNORE';
502 local $SIG{QUIT} = 'IGNORE';
503 local $SIG{TERM} = 'IGNORE';
504 local $SIG{TSTP} = 'IGNORE';
505 local $SIG{PIPE} = 'IGNORE';
507 my $oldAutoCommit = $FS::UID::AutoCommit;
508 local $FS::UID::AutoCommit = 0;
511 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
512 my $error = $app->delete;
514 $dbh->rollback if $oldAutoCommit;
519 my $error = $self->SUPER::delete(@_);
521 $dbh->rollback if $oldAutoCommit;
525 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
531 =item replace [ OLD_RECORD ]
533 You can, but probably shouldn't modify payments...
535 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
536 supplied, replaces this record. If there is an error, returns the error,
537 otherwise returns false.
543 return "Can't modify closed payment"
544 if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace;
545 $self->SUPER::replace(@_);
550 Checks all fields to make sure this is a valid payment. If there is an error,
551 returns the error, otherwise returns false. Called by the insert method.
558 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
561 $self->ut_numbern('paynum')
562 || $self->ut_numbern('custnum')
563 || $self->ut_numbern('_date')
564 || $self->ut_money('paid')
565 || $self->ut_alphan('otaker')
566 || $self->ut_textn('paybatch')
567 || $self->ut_textn('payunique')
568 || $self->ut_enum('closed', [ '', 'Y' ])
569 || $self->ut_flag('no_auto_apply')
570 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
571 || $self->ut_textn('bank')
572 || $self->ut_alphan('depositor')
573 || $self->ut_numbern('account')
574 || $self->ut_numbern('teller')
575 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
576 || $self->payinfo_check()
578 return $error if $error;
580 return "paid must be > 0 " if $self->paid <= 0;
582 return "unknown cust_main.custnum: ". $self->custnum
584 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
586 $self->_date(time) unless $self->_date;
588 return "invalid discount_term"
589 if ($self->discount_term && $self->discount_term < 2);
591 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
592 foreach (qw(bank depositor account teller)) {
593 return "$_ required" if $self->get($_) eq '';
597 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
598 # # UNIQUE index should catch this too, without race conditions, but this
599 # # should give a better error message the other 99.9% of the time...
600 # if ( length($self->payunique)
601 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
602 # #well, it *could* be a better error message
603 # return "duplicate transaction".
604 # " - a payment with unique identifer ". $self->payunique.
611 =item send_receipt HASHREF | OPTION => VALUE ...
613 Sends a payment receipt for this payment..
621 Flag indicating the payment is being made manually.
625 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
630 Customer (FS::cust_main) object (for efficiency).
634 Don't send an email receipt.
644 my $opt = ref($_[0]) ? shift : { @_ };
646 my $cust_bill = $opt->{'cust_bill'};
647 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
649 my $conf = new FS::Conf;
651 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
653 my @invoicing_list = $cust_main->invoicing_list_emailonly;
654 return '' unless @invoicing_list;
656 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
660 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
661 #|| ! $conf->exists('invoice_html_statement')
665 $error = $self->send_message_receipt(
666 'cust_main' => $cust_main,
667 'cust_bill' => $opt->{cust_bill},
668 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
670 #not manual and no noemail flag (here or on the customer)
671 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
673 # check to see if they want to send specific message template as receipt for auto payments
674 if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) {
675 $error = $self->send_message_receipt(
676 'cust_main' => $cust_main,
677 'cust_bill' => $opt->{cust_bill},
678 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum),
682 my $queue = new FS::queue {
683 'job' => 'FS::cust_bill::queueable_email',
684 'paynum' => $self->paynum,
685 'custnum' => $cust_main->custnum,
689 'invnum' => $cust_bill->invnum,
693 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
694 $opt{'mode'} = $mode;
696 # backward compatibility, no good fix for this yet as some people may
697 # still have "invoice_latex_statement" and such options
698 $opt{'template'} = 'statement';
699 $opt{'notice_name'} = 'Statement';
702 $error = $queue->insert(%opt);
709 warn "send_receipt: $error\n" if $error;
712 =item send_message_receipt
714 sends out a message receipt.
715 $error = $self->send_message_receipt(
716 'cust_main' => $cust_main,
717 'cust_bill' => $opt->{cust_bill},
718 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
723 sub send_message_receipt {
724 my ($self, %opt) = @_;
725 my $cust_main = $opt{'cust_main'};
726 my $cust_bill = $opt{'cust_bill'};
727 my $msgnum = $opt{'msgnum'};
732 my %substitutions = ();
733 $substitutions{invnum} = $cust_bill->invnum if $cust_bill;
735 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
736 unless ($msg_template) {
737 warn "send_receipt could not load msg_template";
741 my $cust_msg = $msg_template->prepare(
742 'cust_main' => $cust_main,
744 'from_config' => 'payment_receipt_from',
745 'substitutions' => \%substitutions,
746 'msgtype' => 'receipt',
748 $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
750 warn "send_receipt: $error";
754 my $queue = new FS::queue {
755 'job' => 'FS::cust_msg::process_send',
756 'paynum' => $self->paynum,
757 'custnum' => $cust_main->custnum,
759 $error = $queue->insert( $cust_msg->custmsgnum );
762 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
763 $error = "payment_receipt is on, but no payment_receipt_msgnum";
771 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
778 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
779 sort { $a->_date <=> $b->_date
780 || $a->invnum <=> $b->invnum }
781 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
785 =item cust_pay_refund
787 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
792 sub cust_pay_refund {
794 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
795 sort { $a->_date <=> $b->_date }
796 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
803 Returns the amount of this payment that is still unapplied; which is
804 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
805 applications (see L<FS::cust_pay_refund>).
811 my $amount = $self->paid;
812 $amount -= $_->amount foreach ( $self->cust_bill_pay );
813 $amount -= $_->amount foreach ( $self->cust_pay_refund );
814 sprintf("%.2f", $amount );
819 Returns the amount of this payment that has not been refuned; which is
820 paid minus all refund applications (see L<FS::cust_pay_refund>).
826 my $amount = $self->paid;
827 $amount -= $_->amount foreach ( $self->cust_pay_refund );
828 sprintf("%.2f", $amount );
833 Returns the "paid" field.
842 =item delete_cust_bill_pay OPTIONS
844 Deletes all associated cust_bill_pay records.
846 If option 'unapplied' is a specified, only deletes until
847 this object's 'unapplied' value is >= the specified amount.
848 (Deletes in order returned by L</cust_bill_pay>.)
852 sub delete_cust_bill_pay {
856 local $SIG{HUP} = 'IGNORE';
857 local $SIG{INT} = 'IGNORE';
858 local $SIG{QUIT} = 'IGNORE';
859 local $SIG{TERM} = 'IGNORE';
860 local $SIG{TSTP} = 'IGNORE';
861 local $SIG{PIPE} = 'IGNORE';
863 my $oldAutoCommit = $FS::UID::AutoCommit;
864 local $FS::UID::AutoCommit = 0;
867 my $unapplied = $self->unapplied; #only need to look it up once
871 # Maybe we should reverse the order these get deleted in?
872 # ie delete newest first?
873 # keeping consistent with how bop refunds work, for now...
874 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
875 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
876 $unapplied += $cust_bill_pay->amount;
877 $error = $cust_bill_pay->delete;
882 $dbh->rollback if $oldAutoCommit;
886 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
892 Accepts input for creating a new FS::cust_refund object.
893 Unapplies payment from invoices up to the amount of the refund,
894 creates the refund and applies payment to refund. Allows entire
895 process to be handled in one transaction.
897 Causes a fatal error if called on CARD or CHEK payments.
904 die "Cannot call cust_pay->refund on " . $self->payby
905 if grep { $_ eq $self->payby } qw(CARD CHEK);
907 local $SIG{HUP} = 'IGNORE';
908 local $SIG{INT} = 'IGNORE';
909 local $SIG{QUIT} = 'IGNORE';
910 local $SIG{TERM} = 'IGNORE';
911 local $SIG{TSTP} = 'IGNORE';
912 local $SIG{PIPE} = 'IGNORE';
914 my $oldAutoCommit = $FS::UID::AutoCommit;
915 local $FS::UID::AutoCommit = 0;
918 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
921 $dbh->rollback if $oldAutoCommit;
925 $hash->{'paynum'} = $self->paynum;
926 my $new = new FS::cust_refund ( $hash );
927 $error = $new->insert;
930 $dbh->rollback if $oldAutoCommit;
934 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
938 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
940 =item refund_to_unapply
942 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
943 (all currently applied refunds that aren't closed.)
944 Returns empty list if payment itself is closed.
948 sub refund_to_unapply {
950 return () if $self->closed;
952 'table' => 'cust_pay_refund',
953 'hashref' => { 'paynum' => $self->paynum },
954 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
955 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
961 Deletes all objects returned by L</refund_to_unapply>.
968 local $SIG{HUP} = 'IGNORE';
969 local $SIG{INT} = 'IGNORE';
970 local $SIG{QUIT} = 'IGNORE';
971 local $SIG{TERM} = 'IGNORE';
972 local $SIG{TSTP} = 'IGNORE';
973 local $SIG{PIPE} = 'IGNORE';
975 my $oldAutoCommit = $FS::UID::AutoCommit;
976 local $FS::UID::AutoCommit = 0;
978 foreach my $cust_pay_refund ($self->refund_to_unapply) {
979 my $error = $cust_pay_refund->delete;
981 dbh->rollback if $oldAutoCommit;
986 dbh->commit or die dbh->errstr if $oldAutoCommit;
996 =item batch_insert CUST_PAY_OBJECT, ...
998 Class method which inserts multiple payments. Takes a list of FS::cust_pay
999 objects. Returns a list, each element representing the status of inserting the
1000 corresponding payment - empty. If there is an error inserting any payment, the
1001 entire transaction is rolled back, i.e. all payments are inserted or none are.
1003 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1004 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1005 those objects will be inserted with the paynum of the payment, and for
1006 each one, an error message or an empty string will be inserted into the
1011 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1012 my $num_errors = scalar(grep $_, @errors);
1013 if ( $num_errors == 0 ) {
1014 #success; all payments were inserted
1016 #failure; no payments were inserted.
1022 my $self = shift; #class method
1024 local $SIG{HUP} = 'IGNORE';
1025 local $SIG{INT} = 'IGNORE';
1026 local $SIG{QUIT} = 'IGNORE';
1027 local $SIG{TERM} = 'IGNORE';
1028 local $SIG{TSTP} = 'IGNORE';
1029 local $SIG{PIPE} = 'IGNORE';
1031 my $oldAutoCommit = $FS::UID::AutoCommit;
1032 local $FS::UID::AutoCommit = 0;
1038 foreach my $cust_pay (@_) {
1039 my $error = $cust_pay->insert( 'manual' => 1 );
1040 push @errors, $error;
1041 $num_errors++ if $error;
1043 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1045 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1046 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1050 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1051 my $apply_error = $cust_bill_pay->insert;
1052 push @errors, $apply_error || '';
1053 $num_errors++ if $apply_error;
1057 } elsif ( !$error ) { #normal case: apply payments as usual
1058 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1063 if ( $num_errors ) {
1064 $dbh->rollback if $oldAutoCommit;
1066 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1075 Returns an SQL fragment to retreive the unapplied amount.
1080 my ($class, $start, $end) = @_;
1081 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1082 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1083 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1084 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1088 ( SELECT SUM(amount) FROM cust_bill_pay
1089 WHERE cust_pay.paynum = cust_bill_pay.paynum
1090 $bill_start $bill_end )
1094 ( SELECT SUM(amount) FROM cust_pay_refund
1095 WHERE cust_pay.paynum = cust_pay_refund.paynum
1096 $refund_start $refund_end )
1105 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1106 +{ ( map { $_=>$self->$_ } @fields ),
1115 #my( $self, %opt ) = @_;
1118 +{ 'paynum' => $self->paynum,
1119 '_date' => $self->_date,
1120 'date' => time2str("%b %o, %Y", $self->_date),
1121 'date_short' => time2str("%m-%d-%Y", $self->_date),
1122 'paid' => sprintf('%.2f', $self->paid),
1123 'payby' => $self->payby,
1124 'paycardtype' => $self->paycardtype,
1125 'paymask' => $self->paymask,
1126 'processor' => $self->processor,
1127 'auth' => $self->auth,
1128 'order_number' => $self->order_number,
1136 # Used by FS::Upgrade to migrate to a new database.
1140 sub _upgrade_data { #class method
1141 my ($class, %opt) = @_;
1143 warn "$me upgrading $class\n" if $DEBUG;
1145 $class->_upgrade_reasonnum(%opt);
1147 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1150 # otaker/ivan upgrade
1153 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1155 #not the most efficient, but hey, it only has to run once
1157 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1159 AND EXISTS ( SELECT 1 FROM cust_main
1160 WHERE cust_main.custnum = cust_pay.custnum )
1163 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1165 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1166 $sth->execute or die $sth->errstr;
1167 my $total = $sth->fetchrow_arrayref->[0];
1168 #warn "$total cust_pay records to update\n"
1170 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1175 my @cust_pay = qsearch( {
1176 'table' => 'cust_pay',
1178 'extra_sql' => $where,
1179 'order_by' => 'ORDER BY paynum',
1182 foreach my $cust_pay (@cust_pay) {
1184 my $h_cust_pay = $cust_pay->h_search('insert');
1185 if ( $h_cust_pay ) {
1186 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1187 #$cust_pay->otaker($h_cust_pay->history_user);
1188 $cust_pay->set('otaker', $h_cust_pay->history_user);
1190 $cust_pay->set('otaker', 'legacy');
1193 my $error = $cust_pay->replace;
1196 warn " *** WARNING: Error updating order taker for payment paynum ".
1197 $cust_pay->paynun. ": $error\n";
1202 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1203 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1209 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1213 # payinfo N/A upgrade
1216 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1218 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1220 my @na_cust_pay = qsearch( {
1221 'table' => 'cust_pay',
1222 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1223 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1226 foreach my $na ( @na_cust_pay ) {
1228 next unless $na->payinfo eq 'N/A';
1230 my $cust_pay_pending =
1231 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1232 unless ( $cust_pay_pending ) {
1233 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1234 $na->paynum. " (no cust_pay_pending)\n";
1237 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1238 my $error = $na->replace;
1240 warn " *** WARNING: Error updating payinfo for payment paynum ".
1241 $na->paynun. ": $error\n";
1247 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1251 # otaker->usernum upgrade
1254 $class->_upgrade_otaker(%opt);
1256 # if we do this anywhere else, it should become an FS::Upgrade method
1257 my $num_to_upgrade = $class->count('paybatch is not null');
1258 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1259 if ( $num_to_upgrade > 0 ) {
1260 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1261 if ( $opt{queue} ) {
1262 if ( $num_jobs > 0 ) {
1263 warn "Upgrade already queued.\n";
1265 warn "Scheduling upgrade.\n";
1266 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1270 process_upgrade_paybatch();
1277 $class->upgrade_set_cardtype;
1279 # for batch payments, make sure paymask is set
1281 local $FS::payinfo_Mixin::allow_closed_replace = 1;
1282 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1284 my $cursor = FS::Cursor->new({
1285 table => 'cust_pay',
1286 extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1287 AND payby IN(\'CARD\', \'CHEK\')
1288 AND batchnum IS NOT NULL',
1291 # records from cursors for some reason don't decrypt payinfo, so
1292 # call replace_old to fetch the record "normally"
1293 while (my $cust_pay = $cursor->fetch) {
1294 $cust_pay = $cust_pay->replace_old;
1295 $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1296 my $error = $cust_pay->replace;
1298 die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1305 sub process_upgrade_paybatch {
1307 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1308 local $FS::UID::AutoCommit = 1;
1311 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1313 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1314 my $search = FS::Cursor->new( {
1315 'table' => 'cust_pay',
1316 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1318 while (my $cust_pay = $search->fetch) {
1319 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1320 $cust_pay->set('paybatch' => '');
1321 my $error = $cust_pay->replace;
1322 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1327 # migrate gateway info from the misused 'paybatch' field
1330 # not only cust_pay, but also voided and refunded payments
1331 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1332 local $FS::Record::nowarn_classload=1;
1333 # really inefficient, but again, only has to run once
1334 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1335 my $and_batchnum_is_null =
1336 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1337 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1338 my $search = FS::Cursor->new({
1340 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1341 "AND (paybatch IS NOT NULL ".
1342 "OR (paybatch IS NULL AND auth IS NULL
1343 $and_batchnum_is_null ) )
1344 ORDER BY $pkey DESC"
1346 while ( my $object = $search->fetch ) {
1347 if ( $object->paybatch eq '' ) {
1348 # repair for a previous upgrade that didn't save 'auth'
1349 my $pkey = $object->primary_key;
1350 # find the last history record that had a paybatch value
1352 table => "h_$table",
1354 $pkey => $object->$pkey,
1355 paybatch => { op=>'!=', value=>''},
1356 history_action => 'replace_old',
1358 order_by => 'ORDER BY history_date DESC LIMIT 1',
1361 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1364 # if the paybatch didn't have an auth string, then it's fine
1365 $h->paybatch =~ /:(\w+):/ or next;
1366 # set paybatch to what it was in that record
1367 $object->set('paybatch', $h->paybatch)
1368 # and then upgrade it like the old records
1371 my $parsed = $object->_parse_paybatch;
1372 if (keys %$parsed) {
1373 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1374 $object->set('auth' => $parsed->{authorization});
1375 $object->set('paybatch', '');
1376 my $error = $object->replace;
1377 warn "error parsing CARD/CHEK paybatch fields on $object #".
1378 $object->get($object->primary_key).":\n $error\n"
1383 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1393 =item process_batch_import
1397 sub process_batch_import {
1402 my $custnum = $hash{'custnum'};
1403 my $agentnum = $hash{'agentnum'};
1404 my $agent_custid = $hash{'agent_custid'};
1406 $hash{'_date'} = parse_datetime($hash{'_date'})
1407 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1408 #remove custnum_prefix
1409 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1410 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1413 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1414 && length($1) == $custnum_length
1418 # check agentnum against custnum and
1419 # translate agent_custid into regular custnum
1420 if ($custnum && $agent_custid) {
1421 die "can't specify both custnum and agent_custid\n";
1422 } elsif ($agentnum || $agent_custid) {
1423 # here is the agent virtualization
1424 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1426 $search{'agentnum'} = $agentnum
1428 $search{'agent_custid'} = $agent_custid
1430 $search{'custnum'} = $custnum
1432 my $cust_main = qsearchs({
1433 'table' => 'cust_main',
1434 'hashref' => \%search,
1435 'extra_sql' => $extra_sql,
1437 die "can't find customer with" .
1438 ($agentnum ? " agentnum $agentnum" : '') .
1439 ($custnum ? " custnum $custnum" : '') .
1440 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1442 die "mismatched customer number\n"
1443 if $custnum && ($custnum ne $cust_main->custnum);
1444 $custnum = $cust_main->custnum;
1446 $hash{'custnum'} = $custnum;
1447 delete($hash{'agent_custid'});
1452 'table' => 'cust_pay',
1453 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1454 #agent_custid isn't a cust_pay field, see hash callback
1455 'formats' => { 'simple' =>
1456 [ qw(custnum agent_custid paid payinfo invnum) ] },
1457 'format_types' => { 'simple' => '' }, #force infer from file extension
1458 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1459 'format_hash_callbacks' => { 'simple' => $hashcb },
1460 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1461 'postinsert_callback' => sub {
1462 my $cust_pay = shift;
1463 my $cust_main = $cust_pay->cust_main
1464 or return "can't find customer to which payments apply";
1465 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1467 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1472 FS::Record::process_batch_import( $job, $opt, @_ );
1476 =item batch_import HASHREF
1478 Inserts new payments.
1485 my $fh = $param->{filehandle};
1486 my $format = $param->{'format'};
1488 my $agentnum = $param->{agentnum};
1489 my $_date = $param->{_date};
1490 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1491 my $paybatch = $param->{'paybatch'};
1493 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1494 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1496 # here is the agent virtualization
1497 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1501 if ( $format eq 'simple' ) {
1502 @fields = qw( custnum agent_custid paid payinfo invnum );
1504 } elsif ( $format eq 'extended' ) {
1505 die "unimplemented\n";
1509 die "unknown format $format";
1512 eval "use Text::CSV_XS;";
1515 my $csv = new Text::CSV_XS;
1519 local $SIG{HUP} = 'IGNORE';
1520 local $SIG{INT} = 'IGNORE';
1521 local $SIG{QUIT} = 'IGNORE';
1522 local $SIG{TERM} = 'IGNORE';
1523 local $SIG{TSTP} = 'IGNORE';
1524 local $SIG{PIPE} = 'IGNORE';
1526 my $oldAutoCommit = $FS::UID::AutoCommit;
1527 local $FS::UID::AutoCommit = 0;
1531 while ( defined($line=<$fh>) ) {
1533 $csv->parse($line) or do {
1534 $dbh->rollback if $oldAutoCommit;
1535 return "can't parse: ". $csv->error_input();
1538 my @columns = $csv->fields();
1542 paybatch => $paybatch,
1544 $cust_pay{_date} = $_date if $_date;
1547 foreach my $field ( @fields ) {
1549 if ( $field eq 'agent_custid'
1551 && $columns[0] =~ /\S+/ )
1554 my $agent_custid = $columns[0];
1555 my %hash = ( 'agent_custid' => $agent_custid,
1556 'agentnum' => $agentnum,
1559 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1560 $dbh->rollback if $oldAutoCommit;
1561 return "can't specify custnum with agent_custid $agent_custid";
1564 $cust_main = qsearchs({
1565 'table' => 'cust_main',
1566 'hashref' => \%hash,
1567 'extra_sql' => $extra_sql,
1570 unless ( $cust_main ) {
1571 $dbh->rollback if $oldAutoCommit;
1572 return "can't find customer with agent_custid $agent_custid";
1576 $columns[0] = $cust_main->custnum;
1579 $cust_pay{$field} = shift @columns;
1582 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1583 && length($1) == $custnum_length ) {
1584 $cust_pay{custnum} = $2;
1587 my $custnum = $cust_pay{custnum};
1589 my $cust_pay = new FS::cust_pay( \%cust_pay );
1590 my $error = $cust_pay->insert;
1592 if ( ! $error && $cust_pay->custnum != $custnum ) {
1593 #invnum was defined, and ->insert set custnum to the customer for that
1594 #invoice, but it wasn't the one the import specified.
1595 $dbh->rollback if $oldAutoCommit;
1596 $error = "specified invoice #". $cust_pay{invnum}.
1597 " is for custnum ". $cust_pay->custnum.
1598 ", not specified custnum $custnum";
1602 $dbh->rollback if $oldAutoCommit;
1603 return "can't insert payment for $line: $error";
1606 if ( $format eq 'simple' ) {
1607 # include agentnum for less surprise?
1608 $cust_main = qsearchs({
1609 'table' => 'cust_main',
1610 'hashref' => { 'custnum' => $cust_pay->custnum },
1611 'extra_sql' => $extra_sql,
1615 unless ( $cust_main ) {
1616 $dbh->rollback if $oldAutoCommit;
1617 return "can't find customer to which payments apply at line: $line";
1620 $error = $cust_main->apply_payments_and_credits;
1622 $dbh->rollback if $oldAutoCommit;
1623 return "can't apply payments to customer for $line: $error";
1631 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1633 return "Empty file!" unless $imported;
1643 Delete and replace methods.
1647 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1648 schema.html from the base documentation.