4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
6 use vars qw( $DEBUG $me $conf @encrypted_fields
10 use Business::CreditCard;
12 use FS::UID qw( getotaker driver_name );
13 use FS::Misc qw( send_email );
14 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
15 use FS::Record qw( dbh qsearch qsearchs );
18 use FS::cust_main_Mixin;
19 use FS::payinfo_transaction_Mixin;
21 use FS::cust_bill_pay;
22 use FS::cust_pay_refund;
25 use FS::cust_pay_void;
26 use FS::upgrade_journal;
31 $me = '[FS::cust_pay]';
35 #ask FS::UID to run this stuff for us later
36 FS::UID->install_callback( sub {
40 @encrypted_fields = ('payinfo');
41 sub nohistory_fields { ('payinfo'); }
45 FS::cust_pay - Object methods for cust_pay objects
51 $record = new FS::cust_pay \%hash;
52 $record = new FS::cust_pay { 'column' => 'value' };
54 $error = $record->insert;
56 $error = $new_record->replace($old_record);
58 $error = $record->delete;
60 $error = $record->check;
64 An FS::cust_pay object represents a payment; the transfer of money from a
65 customer. FS::cust_pay inherits from FS::Record. The following fields are
72 primary key (assigned automatically for new payments)
76 customer (see L<FS::cust_main>)
80 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
81 L<Time::Local> and L<Date::Parse> for conversion functions.
85 Amount of this payment
89 order taker (see L<FS::access_user>)
93 Payment Type (See L<FS::payinfo_Mixin> for valid values)
97 Payment Information (See L<FS::payinfo_Mixin> for data format)
101 Credit card type, if appropriate; autodetected.
105 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
109 obsolete text field for tracking card processing or other batch grouping
113 Optional unique identifer to prevent duplicate transactions.
117 books closed flag, empty or `Y'
121 Desired pkgnum when using experimental package balances.
125 Flag to only allow manual application of payment, empty or 'Y'
129 The bank where the payment was deposited.
133 The name of the depositor.
137 The deposit account number.
145 The number of the batch this payment came from (see L<FS::pay_batch>),
146 or null if it was processed through a realtime gateway or entered manually.
150 The number of the realtime or batch gateway L<FS::payment_gateway>) this
151 payment was processed through. Null if it was entered manually or processed
152 by the "system default" gateway, which doesn't have a number.
156 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
157 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
158 redundant with C<gatewaynum>.
162 The authorization number returned by the credit card network.
166 The transaction ID returned by the gateway, if any. This is usually what
167 you would use to initiate a void or refund of the payment.
177 Creates a new payment. To add the payment to the databse, see L<"insert">.
181 sub table { 'cust_pay'; }
182 sub cust_linked { $_[0]->cust_main_custnum; }
183 sub cust_unlinked_msg {
185 "WARNING: can't find cust_main.custnum ". $self->custnum.
186 ' (cust_pay.paynum '. $self->paynum. ')';
189 =item insert [ OPTION => VALUE ... ]
191 Adds this payment to the database.
193 For backwards-compatibility and convenience, if the additional field invnum
194 is defined, an FS::cust_bill_pay record for the full amount of the payment
195 will be created. In this case, custnum is optional.
197 If the additional field discount_term is defined then a prepayment discount
198 is taken for that length of time. It is an error for the customer to owe
199 after this payment is made.
201 A hash of optional arguments may be passed. Currently "manual" is supported.
202 If true, a payment receipt is sent instead of a statement when
203 'payment_receipt_email' configuration option is set.
205 About the "manual" flag: Normally, if the 'payment_receipt' config option
206 is set, and the customer has an invoice email address, inserting a payment
207 causes a I<statement> to be emailed to the customer. If the payment is
208 considered "manual" (or if the customer has no invoices), then it will
209 instead send a I<payment receipt>. "manual" should be true whenever a
210 payment is created directly from the web interface, from a user-initiated
211 realtime payment, or from a third-party payment via self-service. It should
212 be I<false> when creating a payment from a billing event or from a batch.
217 my($self, %options) = @_;
219 local $SIG{HUP} = 'IGNORE';
220 local $SIG{INT} = 'IGNORE';
221 local $SIG{QUIT} = 'IGNORE';
222 local $SIG{TERM} = 'IGNORE';
223 local $SIG{TSTP} = 'IGNORE';
224 local $SIG{PIPE} = 'IGNORE';
226 my $oldAutoCommit = $FS::UID::AutoCommit;
227 local $FS::UID::AutoCommit = 0;
231 if ( $self->invnum ) {
232 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
234 $dbh->rollback if $oldAutoCommit;
235 return "Unknown cust_bill.invnum: ". $self->invnum;
237 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
238 $dbh->rollback if $oldAutoCommit;
239 return "Invoice custnum ".$cust_bill->custnum
240 ." does not match specified custnum ".$self->custnum
241 ." for invoice ".$self->invnum;
243 $self->custnum($cust_bill->custnum );
246 my $error = $self->check;
247 return $error if $error;
249 my $cust_main = $self->cust_main;
250 my $old_balance = $cust_main->balance;
252 $error = $self->SUPER::insert;
254 $dbh->rollback if $oldAutoCommit;
255 return "error inserting cust_pay: $error";
258 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
259 if ( my $months = $self->discount_term ) {
260 # XXX this should be moved out somewhere, but discount_term_values
262 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
263 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
265 # %billing_pkgs contains this customer's active monthly packages.
266 # Recurring fees for those packages will be credited and then rebilled
267 # for the full discount term. Other packages on the last invoice
268 # (canceled, non-monthly recurring, or one-time charges) will be
270 my %billing_pkgs = map { $_->pkgnum => $_ }
271 grep { $_->part_pkg->freq eq '1' }
272 $cust_main->billing_pkgs;
273 my $credit = 0; # sum of recurring charges from that invoice
274 my $last_bill_date = 0; # the real bill date
275 foreach my $item ( $cust_bill->cust_bill_pkg ) {
276 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
277 $credit += $item->recur;
278 $last_bill_date = $item->cust_pkg->last_bill
279 if defined($item->cust_pkg)
280 and $item->cust_pkg->last_bill > $last_bill_date
283 my $cust_credit = new FS::cust_credit {
284 'custnum' => $self->custnum,
285 'amount' => sprintf('%.2f', $credit),
286 'reason' => 'customer chose to prepay for discount',
288 $error = $cust_credit->insert('reason_type' => $credit_type);
290 $dbh->rollback if $oldAutoCommit;
291 return "error inserting prepayment credit: $error";
295 # bill for the entire term
296 $_->bill($_->last_bill) foreach (values %billing_pkgs);
297 $error = $cust_main->bill(
298 # no recurring_only, we want unbilled packages with start dates to
300 'no_usage_reset' => 1,
301 'time' => $last_bill_date, # not $cust_bill->_date
302 'pkg_list' => [ values %billing_pkgs ],
303 'freq_override' => $months,
306 $dbh->rollback if $oldAutoCommit;
307 return "error inserting cust_pay: $error";
309 $error = $cust_main->apply_payments_and_credits;
311 $dbh->rollback if $oldAutoCommit;
312 return "error inserting cust_pay: $error";
314 my $new_balance = $cust_main->balance;
315 if ($new_balance > 0) {
316 $dbh->rollback if $oldAutoCommit;
317 return "balance after prepay discount attempt: $new_balance";
319 # user friendly: override the "apply only to this invoice" mode
326 if ( $self->invnum ) {
327 my $cust_bill_pay = new FS::cust_bill_pay {
328 'invnum' => $self->invnum,
329 'paynum' => $self->paynum,
330 'amount' => $self->paid,
331 '_date' => $self->_date,
333 $error = $cust_bill_pay->insert(%options);
335 if ( $ignore_noapply ) {
336 warn "warning: error inserting cust_bill_pay: $error ".
337 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
339 $dbh->rollback if $oldAutoCommit;
340 return "error inserting cust_bill_pay: $error";
345 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
347 # possibly trigger package unsuspend, doesn't abort transaction on failure
348 $self->unsuspend_balance if $old_balance;
350 #bill setup fees for voip_cdr bill_every_call packages
351 #some false laziness w/search in freeside-cdrd
353 'LEFT JOIN part_pkg USING ( pkgpart ) '.
354 "LEFT JOIN part_pkg_option
355 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
356 AND part_pkg_option.optionname = 'bill_every_call' )";
358 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
359 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
361 my @cust_pkg = qsearch({
362 'table' => 'cust_pkg',
363 'addl_from' => $addl_from,
364 'hashref' => { 'custnum' => $self->custnum,
368 'extra_sql' => $extra_sql,
372 warn "voip_cdr bill_every_call packages found; billing customer\n";
373 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
375 warn "WARNING: Error billing customer: $bill_error\n";
378 #end of billing setup fees for voip_cdr bill_every_call packages
380 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
383 my $trigger = $conf->config('payment_receipt-trigger',
384 $self->cust_main->agentnum) || 'cust_pay';
385 if ( $trigger eq 'cust_pay' ) {
386 my $error = $self->send_receipt(
387 'manual' => $options{'manual'},
388 'cust_bill' => $cust_bill,
389 'cust_main' => $cust_main,
391 warn "can't send payment receipt/statement: $error" if $error;
394 #run payment events immediately
395 my $due_cust_event = $self->cust_main->due_cust_event(
396 'eventtable' => 'cust_pay',
397 'objects' => [ $self ],
399 if ( !ref($due_cust_event) ) {
400 warn "Error searching for cust_pay billing events: $due_cust_event\n";
402 foreach my $cust_event (@$due_cust_event) {
403 next unless $cust_event->test_conditions;
404 if ( my $error = $cust_event->do_event() ) {
405 warn "Error running cust_pay billing event: $error\n";
414 =item void [ REASON ]
416 Voids this payment: deletes the payment and all associated applications and
417 adds a record of the voided payment to the FS::cust_pay_void table.
424 local $SIG{HUP} = 'IGNORE';
425 local $SIG{INT} = 'IGNORE';
426 local $SIG{QUIT} = 'IGNORE';
427 local $SIG{TERM} = 'IGNORE';
428 local $SIG{TSTP} = 'IGNORE';
429 local $SIG{PIPE} = 'IGNORE';
431 my $oldAutoCommit = $FS::UID::AutoCommit;
432 local $FS::UID::AutoCommit = 0;
435 my $cust_pay_void = new FS::cust_pay_void ( {
436 map { $_ => $self->get($_) } $self->fields
438 $cust_pay_void->reason(shift) if scalar(@_);
439 my $error = $cust_pay_void->insert;
441 my $cust_pay_pending =
442 qsearchs('cust_pay_pending', { paynum => $self->paynum });
443 if ( $cust_pay_pending ) {
444 $cust_pay_pending->set('void_paynum', $self->paynum);
445 $cust_pay_pending->set('paynum', '');
446 $error ||= $cust_pay_pending->replace;
449 $error ||= $self->delete;
452 $dbh->rollback if $oldAutoCommit;
456 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
464 Unless the closed flag is set, deletes this payment and all associated
465 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
466 cases, you want to use the void method instead to leave a record of the
471 # very similar to FS::cust_credit::delete
474 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
476 local $SIG{HUP} = 'IGNORE';
477 local $SIG{INT} = 'IGNORE';
478 local $SIG{QUIT} = 'IGNORE';
479 local $SIG{TERM} = 'IGNORE';
480 local $SIG{TSTP} = 'IGNORE';
481 local $SIG{PIPE} = 'IGNORE';
483 my $oldAutoCommit = $FS::UID::AutoCommit;
484 local $FS::UID::AutoCommit = 0;
487 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
488 my $error = $app->delete;
490 $dbh->rollback if $oldAutoCommit;
495 my $error = $self->SUPER::delete(@_);
497 $dbh->rollback if $oldAutoCommit;
501 if ( $conf->exists('deletepayments')
502 && $conf->config('deletepayments') ne '' ) {
504 my $cust_main = $self->cust_main;
506 my $error = send_email(
507 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
508 #invoice_from??? well as good as any
509 'to' => $conf->config('deletepayments'),
510 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
512 "This is an automatic message from your Freeside installation\n",
513 "informing you that the following payment has been deleted:\n",
515 'paynum: '. $self->paynum. "\n",
516 'custnum: '. $self->custnum.
517 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
518 'paid: $'. sprintf("%.2f", $self->paid). "\n",
519 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
520 'payby: '. $self->payby. "\n",
521 'payinfo: '. $self->paymask. "\n",
522 'paybatch: '. $self->paybatch. "\n",
527 $dbh->rollback if $oldAutoCommit;
528 return "can't send payment deletion notification: $error";
533 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
539 =item replace [ OLD_RECORD ]
541 You can, but probably shouldn't modify payments...
543 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
544 supplied, replaces this record. If there is an error, returns the error,
545 otherwise returns false.
551 return "Can't modify closed payment"
552 if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace;
553 $self->SUPER::replace(@_);
558 Checks all fields to make sure this is a valid payment. If there is an error,
559 returns the error, otherwise returns false. Called by the insert method.
566 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
569 $self->ut_numbern('paynum')
570 || $self->ut_numbern('custnum')
571 || $self->ut_numbern('_date')
572 || $self->ut_money('paid')
573 || $self->ut_alphan('otaker')
574 || $self->ut_textn('paybatch')
575 || $self->ut_textn('payunique')
576 || $self->ut_enum('closed', [ '', 'Y' ])
577 || $self->ut_flag('no_auto_apply')
578 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
579 || $self->ut_textn('bank')
580 || $self->ut_alphan('depositor')
581 || $self->ut_numbern('account')
582 || $self->ut_numbern('teller')
583 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
584 || $self->payinfo_check()
586 return $error if $error;
588 return "paid must be > 0 " if $self->paid <= 0;
590 return "unknown cust_main.custnum: ". $self->custnum
592 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
594 $self->_date(time) unless $self->_date;
596 return "invalid discount_term"
597 if ($self->discount_term && $self->discount_term < 2);
599 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
600 foreach (qw(bank depositor account teller)) {
601 return "$_ required" if $self->get($_) eq '';
605 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
606 # # UNIQUE index should catch this too, without race conditions, but this
607 # # should give a better error message the other 99.9% of the time...
608 # if ( length($self->payunique)
609 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
610 # #well, it *could* be a better error message
611 # return "duplicate transaction".
612 # " - a payment with unique identifer ". $self->payunique.
619 =item send_receipt HASHREF | OPTION => VALUE ...
621 Sends a payment receipt for this payment..
629 Flag indicating the payment is being made manually.
633 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
638 Customer (FS::cust_main) object (for efficiency).
646 my $opt = ref($_[0]) ? shift : { @_ };
648 my $cust_bill = $opt->{'cust_bill'};
649 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
651 my $conf = new FS::Conf;
653 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
655 my @invoicing_list = $cust_main->invoicing_list_emailonly;
656 return '' unless @invoicing_list;
658 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
662 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
663 #|| ! $conf->exists('invoice_html_statement')
668 $error = $self->send_message_receipt(
669 'cust_main' => $cust_main,
670 'cust_bill' => $opt->{cust_bill},
671 'cust_pkg' => $opt->{cust_pkg},
672 'invoicing_list' => @invoicing_list,
673 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
676 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
678 # check to see if they want to send specific message template as receipt for auto payments
679 if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) {
680 $error = $self->send_message_receipt(
681 'cust_main' => $cust_main,
682 'cust_bill' => $opt->{cust_bill},
683 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum),
687 my $queue = new FS::queue {
688 'job' => 'FS::cust_bill::queueable_email',
689 'paynum' => $self->paynum,
690 'custnum' => $cust_main->custnum,
694 'invnum' => $cust_bill->invnum,
698 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
699 $opt{'mode'} = $mode;
701 # backward compatibility, no good fix for this yet as some people may
702 # still have "invoice_latex_statement" and such options
703 $opt{'template'} = 'statement';
704 $opt{'notice_name'} = 'Statement';
707 $error = $queue->insert(%opt);
714 warn "send_receipt: $error\n" if $error;
717 =item send_message_receipt
719 sends out a message receipt.
720 $error = $self->send_message_receipt(
721 'cust_main' => $cust_main,
722 'cust_bill' => $opt->{cust_bill},
723 'cust_pkg' => $opt->{cust_pkg},
724 'invoicing_list' => @invoicing_list,
725 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
730 sub send_message_receipt {
731 my ($self, %opt) = @_;
732 my $cust_main = $opt{'cust_main'};
733 my $cust_bill = $opt{'cust_bill'};
734 my $cust_pkg = $opt{'cust_pkg'};
735 my @invoicing_list = $opt{'invoicing_list'};
736 my $msgnum = $opt{'msgnum'};
741 my %substitutions = ();
742 $substitutions{invnum} = $cust_bill->invnum if $cust_bill;
744 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
745 unless ($msg_template) {
746 return "send_receipt could not load msg_template";
749 my $queue = new FS::queue {
750 'job' => 'FS::Misc::process_send_email',
751 'paynum' => $self->paynum,
752 'custnum' => $cust_main->custnum,
754 $error = $queue->insert(
755 FS::msg_template->by_key($msgnum)->prepare(
756 'cust_main' => $cust_main,
758 'from_config' => 'payment_receipt_from',
759 'substitutions' => \%substitutions,
761 'msgtype' => 'receipt', # override msg_template's default
763 } elsif ( $conf->exists('payment_receipt_email') ) {
765 my $receipt_template = new Text::Template (
767 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
769 return "can't create payment receipt template: $Text::Template::ERROR";
772 my $payby = $self->payby;
773 my $payinfo = $self->payinfo;
774 $payby =~ s/^BILL$/Check/ if $payinfo;
775 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
776 $payinfo = $self->paymask
778 $payinfo = $self->decrypt($payinfo);
780 $payby =~ s/^CHEK$/Electronic check/;
783 'date' => time2str("%a %B %o, %Y", $self->_date),
784 'name' => $cust_main->name,
785 'paynum' => $self->paynum,
786 'paid' => sprintf("%.2f", $self->paid),
787 'payby' => ucfirst(lc($payby)),
788 'payinfo' => $payinfo,
789 'balance' => $cust_main->balance,
790 'company_name' => $conf->config('company_name', $cust_main->agentnum),
793 $fill_in{'invnum'} = $cust_bill->invnum if $cust_bill;
796 $fill_in{'pkg'} = $cust_pkg->part_pkg->pkg;
797 #setup date, other things?
800 my $queue = new FS::queue {
801 'job' => 'FS::Misc::process_send_generated_email',
802 'paynum' => $self->paynum,
803 'custnum' => $cust_main->custnum,
804 'msgtype' => 'receipt',
806 $error = $queue->insert(
807 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
808 #invoice_from??? well as good as any
809 'to' => \@invoicing_list,
810 'subject' => 'Payment receipt',
811 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
814 $error = "payment_receipt is on, but no payment_receipt_msgnum\n";
822 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
829 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
830 sort { $a->_date <=> $b->_date
831 || $a->invnum <=> $b->invnum }
832 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
836 =item cust_pay_refund
838 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
843 sub cust_pay_refund {
845 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
846 sort { $a->_date <=> $b->_date }
847 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
854 Returns the amount of this payment that is still unapplied; which is
855 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
856 applications (see L<FS::cust_pay_refund>).
862 my $amount = $self->paid;
863 $amount -= $_->amount foreach ( $self->cust_bill_pay );
864 $amount -= $_->amount foreach ( $self->cust_pay_refund );
865 sprintf("%.2f", $amount );
870 Returns the amount of this payment that has not been refuned; which is
871 paid minus all refund applications (see L<FS::cust_pay_refund>).
877 my $amount = $self->paid;
878 $amount -= $_->amount foreach ( $self->cust_pay_refund );
879 sprintf("%.2f", $amount );
884 Returns the "paid" field.
893 =item delete_cust_bill_pay OPTIONS
895 Deletes all associated cust_bill_pay records.
897 If option 'unapplied' is a specified, only deletes until
898 this object's 'unapplied' value is >= the specified amount.
899 (Deletes in order returned by L</cust_bill_pay>.)
903 sub delete_cust_bill_pay {
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 $unapplied = $self->unapplied; #only need to look it up once
922 # Maybe we should reverse the order these get deleted in?
923 # ie delete newest first?
924 # keeping consistent with how bop refunds work, for now...
925 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
926 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
927 $unapplied += $cust_bill_pay->amount;
928 $error = $cust_bill_pay->delete;
933 $dbh->rollback if $oldAutoCommit;
937 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
943 Accepts input for creating a new FS::cust_refund object.
944 Unapplies payment from invoices up to the amount of the refund,
945 creates the refund and applies payment to refund. Allows entire
946 process to be handled in one transaction.
948 Causes a fatal error if called on CARD or CHEK payments.
955 die "Cannot call cust_pay->refund on " . $self->payby
956 if grep { $_ eq $self->payby } qw(CARD CHEK);
958 local $SIG{HUP} = 'IGNORE';
959 local $SIG{INT} = 'IGNORE';
960 local $SIG{QUIT} = 'IGNORE';
961 local $SIG{TERM} = 'IGNORE';
962 local $SIG{TSTP} = 'IGNORE';
963 local $SIG{PIPE} = 'IGNORE';
965 my $oldAutoCommit = $FS::UID::AutoCommit;
966 local $FS::UID::AutoCommit = 0;
969 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
972 $dbh->rollback if $oldAutoCommit;
976 $hash->{'paynum'} = $self->paynum;
977 my $new = new FS::cust_refund ( $hash );
978 $error = $new->insert;
981 $dbh->rollback if $oldAutoCommit;
985 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
989 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
991 =item refund_to_unapply
993 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
994 (all currently applied refunds that aren't closed.)
995 Returns empty list if payment itself is closed.
999 sub refund_to_unapply {
1001 return () if $self->closed;
1003 'table' => 'cust_pay_refund',
1004 'hashref' => { 'paynum' => $self->paynum },
1005 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
1006 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
1010 =item unapply_refund
1012 Deletes all objects returned by L</refund_to_unapply>.
1016 sub unapply_refund {
1019 local $SIG{HUP} = 'IGNORE';
1020 local $SIG{INT} = 'IGNORE';
1021 local $SIG{QUIT} = 'IGNORE';
1022 local $SIG{TERM} = 'IGNORE';
1023 local $SIG{TSTP} = 'IGNORE';
1024 local $SIG{PIPE} = 'IGNORE';
1026 my $oldAutoCommit = $FS::UID::AutoCommit;
1027 local $FS::UID::AutoCommit = 0;
1029 foreach my $cust_pay_refund ($self->refund_to_unapply) {
1030 my $error = $cust_pay_refund->delete;
1032 dbh->rollback if $oldAutoCommit;
1037 dbh->commit or die dbh->errstr if $oldAutoCommit;
1043 =head1 CLASS METHODS
1047 =item batch_insert CUST_PAY_OBJECT, ...
1049 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1050 objects. Returns a list, each element representing the status of inserting the
1051 corresponding payment - empty. If there is an error inserting any payment, the
1052 entire transaction is rolled back, i.e. all payments are inserted or none are.
1054 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1055 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1056 those objects will be inserted with the paynum of the payment, and for
1057 each one, an error message or an empty string will be inserted into the
1062 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1063 my $num_errors = scalar(grep $_, @errors);
1064 if ( $num_errors == 0 ) {
1065 #success; all payments were inserted
1067 #failure; no payments were inserted.
1073 my $self = shift; #class method
1075 local $SIG{HUP} = 'IGNORE';
1076 local $SIG{INT} = 'IGNORE';
1077 local $SIG{QUIT} = 'IGNORE';
1078 local $SIG{TERM} = 'IGNORE';
1079 local $SIG{TSTP} = 'IGNORE';
1080 local $SIG{PIPE} = 'IGNORE';
1082 my $oldAutoCommit = $FS::UID::AutoCommit;
1083 local $FS::UID::AutoCommit = 0;
1089 foreach my $cust_pay (@_) {
1090 my $error = $cust_pay->insert( 'manual' => 1 );
1091 push @errors, $error;
1092 $num_errors++ if $error;
1094 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1096 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1097 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1101 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1102 my $apply_error = $cust_bill_pay->insert;
1103 push @errors, $apply_error || '';
1104 $num_errors++ if $apply_error;
1108 } elsif ( !$error ) { #normal case: apply payments as usual
1109 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1114 if ( $num_errors ) {
1115 $dbh->rollback if $oldAutoCommit;
1117 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1126 Returns an SQL fragment to retreive the unapplied amount.
1131 my ($class, $start, $end) = @_;
1132 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1133 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1134 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1135 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1139 ( SELECT SUM(amount) FROM cust_bill_pay
1140 WHERE cust_pay.paynum = cust_bill_pay.paynum
1141 $bill_start $bill_end )
1145 ( SELECT SUM(amount) FROM cust_pay_refund
1146 WHERE cust_pay.paynum = cust_pay_refund.paynum
1147 $refund_start $refund_end )
1159 #my( $self, %opt ) = @_;
1162 +{ 'paynum' => $self->paynum,
1163 '_date' => $self->_date,
1164 'date' => time2str("%b %o, %Y", $self->_date),
1165 'date_short' => time2str("%m-%d-%Y", $self->_date),
1166 'paid' => sprintf('%.2f', $self->paid),
1167 'payby' => $self->payby,
1168 'paycardtype' => $self->paycardtype,
1169 'paymask' => $self->paymask,
1170 'processor' => $self->processor,
1171 'auth' => $self->auth,
1172 'order_number' => $self->order_number,
1180 # Used by FS::Upgrade to migrate to a new database.
1184 sub _upgrade_data { #class method
1185 my ($class, %opt) = @_;
1187 warn "$me upgrading $class\n" if $DEBUG;
1189 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1192 # otaker/ivan upgrade
1195 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1197 #not the most efficient, but hey, it only has to run once
1199 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1200 " AND usernum IS NULL ".
1201 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1202 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1204 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1206 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1207 $sth->execute or die $sth->errstr;
1208 my $total = $sth->fetchrow_arrayref->[0];
1209 #warn "$total cust_pay records to update\n"
1211 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1216 my @cust_pay = qsearch( {
1217 'table' => 'cust_pay',
1219 'extra_sql' => $where,
1220 'order_by' => 'ORDER BY paynum',
1223 foreach my $cust_pay (@cust_pay) {
1225 my $h_cust_pay = $cust_pay->h_search('insert');
1226 if ( $h_cust_pay ) {
1227 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1228 #$cust_pay->otaker($h_cust_pay->history_user);
1229 $cust_pay->set('otaker', $h_cust_pay->history_user);
1231 $cust_pay->set('otaker', 'legacy');
1234 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1235 my $error = $cust_pay->replace;
1238 warn " *** WARNING: Error updating order taker for payment paynum ".
1239 $cust_pay->paynun. ": $error\n";
1243 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1246 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1247 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1253 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1257 # payinfo N/A upgrade
1260 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1262 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1264 my @na_cust_pay = qsearch( {
1265 'table' => 'cust_pay',
1266 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1267 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1270 foreach my $na ( @na_cust_pay ) {
1272 next unless $na->payinfo eq 'N/A';
1274 my $cust_pay_pending =
1275 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1276 unless ( $cust_pay_pending ) {
1277 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1278 $na->paynum. " (no cust_pay_pending)\n";
1281 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1282 my $error = $na->replace;
1284 warn " *** WARNING: Error updating payinfo for payment paynum ".
1285 $na->paynun. ": $error\n";
1291 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1295 # otaker->usernum upgrade
1298 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1299 $class->_upgrade_otaker(%opt);
1300 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1302 # if we do this anywhere else, it should become an FS::Upgrade method
1303 my $num_to_upgrade = $class->count('paybatch is not null');
1304 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1305 if ( $num_to_upgrade > 0 ) {
1306 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1307 if ( $opt{queue} ) {
1308 if ( $num_jobs > 0 ) {
1309 warn "Upgrade already queued.\n";
1311 warn "Scheduling upgrade.\n";
1312 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1316 process_upgrade_paybatch();
1321 # don't set paycardtype until 4.x
1323 #$class->upgrade_set_cardtype;
1325 # for batch payments, make sure paymask is set
1327 local $FS::payinfo_Mixin::allow_closed_replace = 1;
1328 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1330 my $cursor = FS::Cursor->new({
1331 table => 'cust_pay',
1332 extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1333 AND payby IN(\'CARD\', \'CHEK\')
1334 AND batchnum IS NOT NULL',
1337 # records from cursors for some reason don't decrypt payinfo, so
1338 # call replace_old to fetch the record "normally"
1339 while (my $cust_pay = $cursor->fetch) {
1340 $cust_pay = $cust_pay->replace_old;
1341 $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1342 my $error = $cust_pay->replace;
1344 die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1351 sub process_upgrade_paybatch {
1353 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1354 local $FS::UID::AutoCommit = 1;
1357 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1359 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1360 my $search = FS::Cursor->new( {
1361 'table' => 'cust_pay',
1362 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1364 while (my $cust_pay = $search->fetch) {
1365 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1366 $cust_pay->set('paybatch' => '');
1367 my $error = $cust_pay->replace;
1368 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1373 # migrate gateway info from the misused 'paybatch' field
1376 # not only cust_pay, but also voided and refunded payments
1377 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1378 local $FS::Record::nowarn_classload=1;
1379 # really inefficient, but again, only has to run once
1380 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1381 my $and_batchnum_is_null =
1382 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1383 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1384 my $search = FS::Cursor->new({
1386 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1387 "AND (paybatch IS NOT NULL ".
1388 "OR (paybatch IS NULL AND auth IS NULL
1389 $and_batchnum_is_null ) )
1390 ORDER BY $pkey DESC"
1392 while ( my $object = $search->fetch ) {
1393 if ( $object->paybatch eq '' ) {
1394 # repair for a previous upgrade that didn't save 'auth'
1395 my $pkey = $object->primary_key;
1396 # find the last history record that had a paybatch value
1398 table => "h_$table",
1400 $pkey => $object->$pkey,
1401 paybatch => { op=>'!=', value=>''},
1402 history_action => 'replace_old',
1404 order_by => 'ORDER BY history_date DESC LIMIT 1',
1407 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1410 # if the paybatch didn't have an auth string, then it's fine
1411 $h->paybatch =~ /:(\w+):/ or next;
1412 # set paybatch to what it was in that record
1413 $object->set('paybatch', $h->paybatch)
1414 # and then upgrade it like the old records
1417 my $parsed = $object->_parse_paybatch;
1418 if (keys %$parsed) {
1419 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1420 $object->set('auth' => $parsed->{authorization});
1421 $object->set('paybatch', '');
1422 my $error = $object->replace;
1423 warn "error parsing CARD/CHEK paybatch fields on $object #".
1424 $object->get($object->primary_key).":\n $error\n"
1429 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1439 =item process_batch_import
1443 sub process_batch_import {
1448 my $custnum = $hash{'custnum'};
1449 my $agentnum = $hash{'agentnum'};
1450 my $agent_custid = $hash{'agent_custid'};
1452 $hash{'_date'} = parse_datetime($hash{'_date'})
1453 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1454 #remove custnum_prefix
1455 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1456 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1459 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1460 && length($1) == $custnum_length
1464 # check agentnum against custnum and
1465 # translate agent_custid into regular custnum
1466 if ($custnum && $agent_custid) {
1467 die "can't specify both custnum and agent_custid\n";
1468 } elsif ($agentnum || $agent_custid) {
1469 # here is the agent virtualization
1470 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1472 $search{'agentnum'} = $agentnum
1474 $search{'agent_custid'} = $agent_custid
1476 $search{'custnum'} = $custnum
1478 my $cust_main = qsearchs({
1479 'table' => 'cust_main',
1480 'hashref' => \%search,
1481 'extra_sql' => $extra_sql,
1483 die "can't find customer with" .
1484 ($agentnum ? " agentnum $agentnum" : '') .
1485 ($custnum ? " custnum $custnum" : '') .
1486 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1488 die "mismatched customer number\n"
1489 if $custnum && ($custnum ne $cust_main->custnum);
1490 $custnum = $cust_main->custnum;
1492 $hash{'custnum'} = $custnum;
1493 delete($hash{'agent_custid'});
1498 'table' => 'cust_pay',
1499 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1500 #agent_custid isn't a cust_pay field, see hash callback
1501 'formats' => { 'simple' =>
1502 [ qw(custnum agent_custid paid payinfo invnum) ] },
1503 'format_types' => { 'simple' => '' }, #force infer from file extension
1504 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1505 'format_hash_callbacks' => { 'simple' => $hashcb },
1506 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1507 'postinsert_callback' => sub {
1508 my $cust_pay = shift;
1509 my $cust_main = $cust_pay->cust_main
1510 or return "can't find customer to which payments apply";
1511 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1513 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1518 FS::Record::process_batch_import( $job, $opt, @_ );
1522 =item batch_import HASHREF
1524 Inserts new payments.
1531 my $fh = $param->{filehandle};
1532 my $format = $param->{'format'};
1534 my $agentnum = $param->{agentnum};
1535 my $_date = $param->{_date};
1536 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1537 my $paybatch = $param->{'paybatch'};
1539 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1540 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1542 # here is the agent virtualization
1543 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1547 if ( $format eq 'simple' ) {
1548 @fields = qw( custnum agent_custid paid payinfo invnum );
1550 } elsif ( $format eq 'extended' ) {
1551 die "unimplemented\n";
1555 die "unknown format $format";
1558 eval "use Text::CSV_XS;";
1561 my $csv = new Text::CSV_XS;
1565 local $SIG{HUP} = 'IGNORE';
1566 local $SIG{INT} = 'IGNORE';
1567 local $SIG{QUIT} = 'IGNORE';
1568 local $SIG{TERM} = 'IGNORE';
1569 local $SIG{TSTP} = 'IGNORE';
1570 local $SIG{PIPE} = 'IGNORE';
1572 my $oldAutoCommit = $FS::UID::AutoCommit;
1573 local $FS::UID::AutoCommit = 0;
1577 while ( defined($line=<$fh>) ) {
1579 $csv->parse($line) or do {
1580 $dbh->rollback if $oldAutoCommit;
1581 return "can't parse: ". $csv->error_input();
1584 my @columns = $csv->fields();
1588 paybatch => $paybatch,
1590 $cust_pay{_date} = $_date if $_date;
1593 foreach my $field ( @fields ) {
1595 if ( $field eq 'agent_custid'
1597 && $columns[0] =~ /\S+/ )
1600 my $agent_custid = $columns[0];
1601 my %hash = ( 'agent_custid' => $agent_custid,
1602 'agentnum' => $agentnum,
1605 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1606 $dbh->rollback if $oldAutoCommit;
1607 return "can't specify custnum with agent_custid $agent_custid";
1610 $cust_main = qsearchs({
1611 'table' => 'cust_main',
1612 'hashref' => \%hash,
1613 'extra_sql' => $extra_sql,
1616 unless ( $cust_main ) {
1617 $dbh->rollback if $oldAutoCommit;
1618 return "can't find customer with agent_custid $agent_custid";
1622 $columns[0] = $cust_main->custnum;
1625 $cust_pay{$field} = shift @columns;
1628 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1629 && length($1) == $custnum_length ) {
1630 $cust_pay{custnum} = $2;
1633 my $custnum = $cust_pay{custnum};
1635 my $cust_pay = new FS::cust_pay( \%cust_pay );
1636 my $error = $cust_pay->insert;
1638 if ( ! $error && $cust_pay->custnum != $custnum ) {
1639 #invnum was defined, and ->insert set custnum to the customer for that
1640 #invoice, but it wasn't the one the import specified.
1641 $dbh->rollback if $oldAutoCommit;
1642 $error = "specified invoice #". $cust_pay{invnum}.
1643 " is for custnum ". $cust_pay->custnum.
1644 ", not specified custnum $custnum";
1648 $dbh->rollback if $oldAutoCommit;
1649 return "can't insert payment for $line: $error";
1652 if ( $format eq 'simple' ) {
1653 # include agentnum for less surprise?
1654 $cust_main = qsearchs({
1655 'table' => 'cust_main',
1656 'hashref' => { 'custnum' => $cust_pay->custnum },
1657 'extra_sql' => $extra_sql,
1661 unless ( $cust_main ) {
1662 $dbh->rollback if $oldAutoCommit;
1663 return "can't find customer to which payments apply at line: $line";
1666 $error = $cust_main->apply_payments_and_credits;
1668 $dbh->rollback if $oldAutoCommit;
1669 return "can't apply payments to customer for $line: $error";
1677 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1679 return "Empty file!" unless $imported;
1689 Delete and replace methods.
1693 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1694 schema.html from the base documentation.