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;
230 my $conf = new FS::Conf;
233 if ( $self->invnum ) {
234 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
236 $dbh->rollback if $oldAutoCommit;
237 return "Unknown cust_bill.invnum: ". $self->invnum;
239 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
240 $dbh->rollback if $oldAutoCommit;
241 return "Invoice custnum ".$cust_bill->custnum
242 ." does not match specified custnum ".$self->custnum
243 ." for invoice ".$self->invnum;
245 $self->custnum($cust_bill->custnum );
248 my $error = $self->check;
249 return $error if $error;
251 my $cust_main = $self->cust_main;
252 my $old_balance = $cust_main->balance;
254 $error = $self->SUPER::insert;
256 $dbh->rollback if $oldAutoCommit;
257 return "error inserting cust_pay: $error";
260 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
261 if ( my $months = $self->discount_term ) {
262 # XXX this should be moved out somewhere, but discount_term_values
264 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
265 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
267 # %billing_pkgs contains this customer's active monthly packages.
268 # Recurring fees for those packages will be credited and then rebilled
269 # for the full discount term. Other packages on the last invoice
270 # (canceled, non-monthly recurring, or one-time charges) will be
272 my %billing_pkgs = map { $_->pkgnum => $_ }
273 grep { $_->part_pkg->freq eq '1' }
274 $cust_main->billing_pkgs;
275 my $credit = 0; # sum of recurring charges from that invoice
276 my $last_bill_date = 0; # the real bill date
277 foreach my $item ( $cust_bill->cust_bill_pkg ) {
278 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
279 $credit += $item->recur;
280 $last_bill_date = $item->cust_pkg->last_bill
281 if defined($item->cust_pkg)
282 and $item->cust_pkg->last_bill > $last_bill_date
285 my $cust_credit = new FS::cust_credit {
286 'custnum' => $self->custnum,
287 'amount' => sprintf('%.2f', $credit),
288 'reason' => 'customer chose to prepay for discount',
290 $error = $cust_credit->insert('reason_type' => $credit_type);
292 $dbh->rollback if $oldAutoCommit;
293 return "error inserting prepayment credit: $error";
297 # bill for the entire term
298 $_->bill($_->last_bill) foreach (values %billing_pkgs);
299 $error = $cust_main->bill(
300 # no recurring_only, we want unbilled packages with start dates to
302 'no_usage_reset' => 1,
303 'time' => $last_bill_date, # not $cust_bill->_date
304 'pkg_list' => [ values %billing_pkgs ],
305 'freq_override' => $months,
308 $dbh->rollback if $oldAutoCommit;
309 return "error inserting cust_pay: $error";
311 $error = $cust_main->apply_payments_and_credits;
313 $dbh->rollback if $oldAutoCommit;
314 return "error inserting cust_pay: $error";
316 my $new_balance = $cust_main->balance;
317 if ($new_balance > 0) {
318 $dbh->rollback if $oldAutoCommit;
319 return "balance after prepay discount attempt: $new_balance";
321 # user friendly: override the "apply only to this invoice" mode
328 if ( $self->invnum ) {
329 my $cust_bill_pay = new FS::cust_bill_pay {
330 'invnum' => $self->invnum,
331 'paynum' => $self->paynum,
332 'amount' => $self->paid,
333 '_date' => $self->_date,
335 $error = $cust_bill_pay->insert(%options);
337 if ( $ignore_noapply ) {
338 warn "warning: error inserting cust_bill_pay: $error ".
339 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
341 $dbh->rollback if $oldAutoCommit;
342 return "error inserting cust_bill_pay: $error";
347 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
349 # possibly trigger package unsuspend, doesn't abort transaction on failure
350 $self->unsuspend_balance if $old_balance;
352 #bill setup fees for voip_cdr bill_every_call packages
353 #some false laziness w/search in freeside-cdrd
355 'LEFT JOIN part_pkg USING ( pkgpart ) '.
356 "LEFT JOIN part_pkg_option
357 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
358 AND part_pkg_option.optionname = 'bill_every_call' )";
360 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
361 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
363 my @cust_pkg = qsearch({
364 'table' => 'cust_pkg',
365 'addl_from' => $addl_from,
366 'hashref' => { 'custnum' => $self->custnum,
370 'extra_sql' => $extra_sql,
374 warn "voip_cdr bill_every_call packages found; billing customer\n";
375 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
377 warn "WARNING: Error billing customer: $bill_error\n";
380 #end of billing setup fees for voip_cdr bill_every_call packages
382 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
385 my $trigger = $conf->config('payment_receipt-trigger',
386 $self->cust_main->agentnum) || 'cust_pay';
387 if ( $trigger eq 'cust_pay' ) {
388 my $error = $self->send_receipt(
389 'manual' => $options{'manual'},
390 'cust_bill' => $cust_bill,
391 'cust_main' => $cust_main,
393 warn "can't send payment receipt/statement: $error" if $error;
396 #run payment events immediately
397 my $due_cust_event = $self->cust_main->due_cust_event(
398 'eventtable' => 'cust_pay',
399 'objects' => [ $self ],
401 if ( !ref($due_cust_event) ) {
402 warn "Error searching for cust_pay billing events: $due_cust_event\n";
404 foreach my $cust_event (@$due_cust_event) {
405 next unless $cust_event->test_conditions;
406 if ( my $error = $cust_event->do_event() ) {
407 warn "Error running cust_pay billing event: $error\n";
416 =item void [ REASON ]
418 Voids this payment: deletes the payment and all associated applications and
419 adds a record of the voided payment to the FS::cust_pay_void table.
426 local $SIG{HUP} = 'IGNORE';
427 local $SIG{INT} = 'IGNORE';
428 local $SIG{QUIT} = 'IGNORE';
429 local $SIG{TERM} = 'IGNORE';
430 local $SIG{TSTP} = 'IGNORE';
431 local $SIG{PIPE} = 'IGNORE';
433 my $oldAutoCommit = $FS::UID::AutoCommit;
434 local $FS::UID::AutoCommit = 0;
437 my $cust_pay_void = new FS::cust_pay_void ( {
438 map { $_ => $self->get($_) } $self->fields
440 $cust_pay_void->reason(shift) if scalar(@_);
441 my $error = $cust_pay_void->insert;
443 my $cust_pay_pending =
444 qsearchs('cust_pay_pending', { paynum => $self->paynum });
445 if ( $cust_pay_pending ) {
446 $cust_pay_pending->set('void_paynum', $self->paynum);
447 $cust_pay_pending->set('paynum', '');
448 $error ||= $cust_pay_pending->replace;
451 $error ||= $self->delete;
454 $dbh->rollback if $oldAutoCommit;
458 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
466 Unless the closed flag is set, deletes this payment and all associated
467 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
468 cases, you want to use the void method instead to leave a record of the
473 # very similar to FS::cust_credit::delete
476 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
478 local $SIG{HUP} = 'IGNORE';
479 local $SIG{INT} = 'IGNORE';
480 local $SIG{QUIT} = 'IGNORE';
481 local $SIG{TERM} = 'IGNORE';
482 local $SIG{TSTP} = 'IGNORE';
483 local $SIG{PIPE} = 'IGNORE';
485 my $oldAutoCommit = $FS::UID::AutoCommit;
486 local $FS::UID::AutoCommit = 0;
489 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
490 my $error = $app->delete;
492 $dbh->rollback if $oldAutoCommit;
497 my $error = $self->SUPER::delete(@_);
499 $dbh->rollback if $oldAutoCommit;
503 if ( $conf->exists('deletepayments')
504 && $conf->config('deletepayments') ne '' ) {
506 my $cust_main = $self->cust_main;
508 my $error = send_email(
509 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
510 #invoice_from??? well as good as any
511 'to' => $conf->config('deletepayments'),
512 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
514 "This is an automatic message from your Freeside installation\n",
515 "informing you that the following payment has been deleted:\n",
517 'paynum: '. $self->paynum. "\n",
518 'custnum: '. $self->custnum.
519 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
520 'paid: $'. sprintf("%.2f", $self->paid). "\n",
521 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
522 'payby: '. $self->payby. "\n",
523 'payinfo: '. $self->paymask. "\n",
524 'paybatch: '. $self->paybatch. "\n",
529 $dbh->rollback if $oldAutoCommit;
530 return "can't send payment deletion notification: $error";
535 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
541 =item replace [ OLD_RECORD ]
543 You can, but probably shouldn't modify payments...
545 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
546 supplied, replaces this record. If there is an error, returns the error,
547 otherwise returns false.
553 return "Can't modify closed payment"
554 if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace;
555 $self->SUPER::replace(@_);
560 Checks all fields to make sure this is a valid payment. If there is an error,
561 returns the error, otherwise returns false. Called by the insert method.
568 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
571 $self->ut_numbern('paynum')
572 || $self->ut_numbern('custnum')
573 || $self->ut_numbern('_date')
574 || $self->ut_money('paid')
575 || $self->ut_alphan('otaker')
576 || $self->ut_textn('paybatch')
577 || $self->ut_textn('payunique')
578 || $self->ut_enum('closed', [ '', 'Y' ])
579 || $self->ut_flag('no_auto_apply')
580 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
581 || $self->ut_textn('bank')
582 || $self->ut_alphan('depositor')
583 || $self->ut_numbern('account')
584 || $self->ut_numbern('teller')
585 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
586 || $self->payinfo_check()
588 return $error if $error;
590 return "paid must be > 0 " if $self->paid <= 0;
592 return "unknown cust_main.custnum: ". $self->custnum
594 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
596 $self->_date(time) unless $self->_date;
598 return "invalid discount_term"
599 if ($self->discount_term && $self->discount_term < 2);
601 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
602 foreach (qw(bank depositor account teller)) {
603 return "$_ required" if $self->get($_) eq '';
607 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
608 # # UNIQUE index should catch this too, without race conditions, but this
609 # # should give a better error message the other 99.9% of the time...
610 # if ( length($self->payunique)
611 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
612 # #well, it *could* be a better error message
613 # return "duplicate transaction".
614 # " - a payment with unique identifer ". $self->payunique.
621 =item send_receipt HASHREF | OPTION => VALUE ...
623 Sends a payment receipt for this payment..
631 Flag indicating the payment is being made manually.
635 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
640 Customer (FS::cust_main) object (for efficiency).
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')
672 $error = $self->send_message_receipt(
673 'cust_main' => $cust_main,
674 'cust_bill' => $opt->{cust_bill},
675 'cust_pkg' => $opt->{cust_pkg},
676 'invoicing_list' => @invoicing_list,
677 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
680 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
682 # check to see if they want to send specific message template as receipt for auto payments
683 if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) {
684 $error = $self->send_message_receipt(
685 'cust_main' => $cust_main,
686 'cust_bill' => $opt->{cust_bill},
687 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum),
691 my $queue = new FS::queue {
692 'job' => 'FS::cust_bill::queueable_email',
693 'paynum' => $self->paynum,
694 'custnum' => $cust_main->custnum,
698 'invnum' => $cust_bill->invnum,
702 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
703 $opt{'mode'} = $mode;
705 # backward compatibility, no good fix for this yet as some people may
706 # still have "invoice_latex_statement" and such options
707 $opt{'template'} = 'statement';
708 $opt{'notice_name'} = 'Statement';
711 $error = $queue->insert(%opt);
718 warn "send_receipt: $error\n" if $error;
721 =item send_message_receipt
723 sends out a message receipt.
724 $error = $self->send_message_receipt(
725 'cust_main' => $cust_main,
726 'cust_bill' => $opt->{cust_bill},
727 'cust_pkg' => $opt->{cust_pkg},
728 'invoicing_list' => @invoicing_list,
729 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
734 sub send_message_receipt {
735 my ($self, %opt) = @_;
736 my $cust_main = $opt{'cust_main'};
737 my $cust_bill = $opt{'cust_bill'};
738 my $cust_pkg = $opt{'cust_pkg'};
739 my @invoicing_list = $opt{'invoicing_list'};
740 my $msgnum = $opt{'msgnum'};
745 my %substitutions = ();
746 $substitutions{invnum} = $cust_bill->invnum if $cust_bill;
748 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
749 unless ($msg_template) {
750 return "send_receipt could not load msg_template";
753 my $queue = new FS::queue {
754 'job' => 'FS::Misc::process_send_email',
755 'paynum' => $self->paynum,
756 'custnum' => $cust_main->custnum,
758 $error = $queue->insert(
759 FS::msg_template->by_key($msgnum)->prepare(
760 'cust_main' => $cust_main,
762 'from_config' => 'payment_receipt_from',
763 'substitutions' => \%substitutions,
765 'msgtype' => 'receipt', # override msg_template's default
767 } elsif ( $conf->exists('payment_receipt_email') ) {
769 my $receipt_template = new Text::Template (
771 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
773 return "can't create payment receipt template: $Text::Template::ERROR";
776 my $payby = $self->payby;
777 my $payinfo = $self->payinfo;
778 $payby =~ s/^BILL$/Check/ if $payinfo;
779 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
780 $payinfo = $self->paymask
782 $payinfo = $self->decrypt($payinfo);
784 $payby =~ s/^CHEK$/Electronic check/;
787 'date' => time2str("%a %B %o, %Y", $self->_date),
788 'name' => $cust_main->name,
789 'paynum' => $self->paynum,
790 'paid' => sprintf("%.2f", $self->paid),
791 'payby' => ucfirst(lc($payby)),
792 'payinfo' => $payinfo,
793 'balance' => $cust_main->balance,
794 'company_name' => $conf->config('company_name', $cust_main->agentnum),
797 $fill_in{'invnum'} = $cust_bill->invnum if $cust_bill;
800 $fill_in{'pkg'} = $cust_pkg->part_pkg->pkg;
801 #setup date, other things?
804 my $queue = new FS::queue {
805 'job' => 'FS::Misc::process_send_generated_email',
806 'paynum' => $self->paynum,
807 'custnum' => $cust_main->custnum,
808 'msgtype' => 'receipt',
810 $error = $queue->insert(
811 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
812 #invoice_from??? well as good as any
813 'to' => \@invoicing_list,
814 'subject' => 'Payment receipt',
815 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
818 $error = "payment_receipt is on, but no payment_receipt_msgnum\n";
826 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
833 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
834 sort { $a->_date <=> $b->_date
835 || $a->invnum <=> $b->invnum }
836 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
840 =item cust_pay_refund
842 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
847 sub cust_pay_refund {
849 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
850 sort { $a->_date <=> $b->_date }
851 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
858 Returns the amount of this payment that is still unapplied; which is
859 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
860 applications (see L<FS::cust_pay_refund>).
866 my $amount = $self->paid;
867 $amount -= $_->amount foreach ( $self->cust_bill_pay );
868 $amount -= $_->amount foreach ( $self->cust_pay_refund );
869 sprintf("%.2f", $amount );
874 Returns the amount of this payment that has not been refuned; which is
875 paid minus all refund applications (see L<FS::cust_pay_refund>).
881 my $amount = $self->paid;
882 $amount -= $_->amount foreach ( $self->cust_pay_refund );
883 sprintf("%.2f", $amount );
888 Returns the "paid" field.
897 =item delete_cust_bill_pay OPTIONS
899 Deletes all associated cust_bill_pay records.
901 If option 'unapplied' is a specified, only deletes until
902 this object's 'unapplied' value is >= the specified amount.
903 (Deletes in order returned by L</cust_bill_pay>.)
907 sub delete_cust_bill_pay {
911 local $SIG{HUP} = 'IGNORE';
912 local $SIG{INT} = 'IGNORE';
913 local $SIG{QUIT} = 'IGNORE';
914 local $SIG{TERM} = 'IGNORE';
915 local $SIG{TSTP} = 'IGNORE';
916 local $SIG{PIPE} = 'IGNORE';
918 my $oldAutoCommit = $FS::UID::AutoCommit;
919 local $FS::UID::AutoCommit = 0;
922 my $unapplied = $self->unapplied; #only need to look it up once
926 # Maybe we should reverse the order these get deleted in?
927 # ie delete newest first?
928 # keeping consistent with how bop refunds work, for now...
929 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
930 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
931 $unapplied += $cust_bill_pay->amount;
932 $error = $cust_bill_pay->delete;
937 $dbh->rollback if $oldAutoCommit;
941 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
947 Accepts input for creating a new FS::cust_refund object.
948 Unapplies payment from invoices up to the amount of the refund,
949 creates the refund and applies payment to refund. Allows entire
950 process to be handled in one transaction.
952 Causes a fatal error if called on CARD or CHEK payments.
959 die "Cannot call cust_pay->refund on " . $self->payby
960 if grep { $_ eq $self->payby } qw(CARD CHEK);
962 local $SIG{HUP} = 'IGNORE';
963 local $SIG{INT} = 'IGNORE';
964 local $SIG{QUIT} = 'IGNORE';
965 local $SIG{TERM} = 'IGNORE';
966 local $SIG{TSTP} = 'IGNORE';
967 local $SIG{PIPE} = 'IGNORE';
969 my $oldAutoCommit = $FS::UID::AutoCommit;
970 local $FS::UID::AutoCommit = 0;
973 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
976 $dbh->rollback if $oldAutoCommit;
980 $hash->{'paynum'} = $self->paynum;
981 my $new = new FS::cust_refund ( $hash );
982 $error = $new->insert;
985 $dbh->rollback if $oldAutoCommit;
989 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
993 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
995 =item refund_to_unapply
997 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
998 (all currently applied refunds that aren't closed.)
999 Returns empty list if payment itself is closed.
1003 sub refund_to_unapply {
1005 return () if $self->closed;
1007 'table' => 'cust_pay_refund',
1008 'hashref' => { 'paynum' => $self->paynum },
1009 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
1010 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
1014 =item unapply_refund
1016 Deletes all objects returned by L</refund_to_unapply>.
1020 sub unapply_refund {
1023 local $SIG{HUP} = 'IGNORE';
1024 local $SIG{INT} = 'IGNORE';
1025 local $SIG{QUIT} = 'IGNORE';
1026 local $SIG{TERM} = 'IGNORE';
1027 local $SIG{TSTP} = 'IGNORE';
1028 local $SIG{PIPE} = 'IGNORE';
1030 my $oldAutoCommit = $FS::UID::AutoCommit;
1031 local $FS::UID::AutoCommit = 0;
1033 foreach my $cust_pay_refund ($self->refund_to_unapply) {
1034 my $error = $cust_pay_refund->delete;
1036 dbh->rollback if $oldAutoCommit;
1041 dbh->commit or die dbh->errstr if $oldAutoCommit;
1047 =head1 CLASS METHODS
1051 =item batch_insert CUST_PAY_OBJECT, ...
1053 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1054 objects. Returns a list, each element representing the status of inserting the
1055 corresponding payment - empty. If there is an error inserting any payment, the
1056 entire transaction is rolled back, i.e. all payments are inserted or none are.
1058 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1059 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1060 those objects will be inserted with the paynum of the payment, and for
1061 each one, an error message or an empty string will be inserted into the
1066 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1067 my $num_errors = scalar(grep $_, @errors);
1068 if ( $num_errors == 0 ) {
1069 #success; all payments were inserted
1071 #failure; no payments were inserted.
1077 my $self = shift; #class method
1079 local $SIG{HUP} = 'IGNORE';
1080 local $SIG{INT} = 'IGNORE';
1081 local $SIG{QUIT} = 'IGNORE';
1082 local $SIG{TERM} = 'IGNORE';
1083 local $SIG{TSTP} = 'IGNORE';
1084 local $SIG{PIPE} = 'IGNORE';
1086 my $oldAutoCommit = $FS::UID::AutoCommit;
1087 local $FS::UID::AutoCommit = 0;
1093 foreach my $cust_pay (@_) {
1094 my $error = $cust_pay->insert( 'manual' => 1 );
1095 push @errors, $error;
1096 $num_errors++ if $error;
1098 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1100 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1101 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1105 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1106 my $apply_error = $cust_bill_pay->insert;
1107 push @errors, $apply_error || '';
1108 $num_errors++ if $apply_error;
1112 } elsif ( !$error ) { #normal case: apply payments as usual
1113 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1118 if ( $num_errors ) {
1119 $dbh->rollback if $oldAutoCommit;
1121 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1130 Returns an SQL fragment to retreive the unapplied amount.
1135 my ($class, $start, $end) = @_;
1136 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1137 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1138 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1139 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1143 ( SELECT SUM(amount) FROM cust_bill_pay
1144 WHERE cust_pay.paynum = cust_bill_pay.paynum
1145 $bill_start $bill_end )
1149 ( SELECT SUM(amount) FROM cust_pay_refund
1150 WHERE cust_pay.paynum = cust_pay_refund.paynum
1151 $refund_start $refund_end )
1163 #my( $self, %opt ) = @_;
1166 +{ 'paynum' => $self->paynum,
1167 '_date' => $self->_date,
1168 'date' => time2str("%b %o, %Y", $self->_date),
1169 'date_short' => time2str("%m-%d-%Y", $self->_date),
1170 'paid' => sprintf('%.2f', $self->paid),
1171 'payby' => $self->payby,
1172 'paycardtype' => $self->paycardtype,
1173 'paymask' => $self->paymask,
1174 'processor' => $self->processor,
1175 'auth' => $self->auth,
1176 'order_number' => $self->order_number,
1184 # Used by FS::Upgrade to migrate to a new database.
1188 sub _upgrade_data { #class method
1189 my ($class, %opt) = @_;
1191 warn "$me upgrading $class\n" if $DEBUG;
1193 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1196 # otaker/ivan upgrade
1199 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1201 #not the most efficient, but hey, it only has to run once
1203 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1204 " AND usernum IS NULL ".
1205 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1206 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1208 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1210 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1211 $sth->execute or die $sth->errstr;
1212 my $total = $sth->fetchrow_arrayref->[0];
1213 #warn "$total cust_pay records to update\n"
1215 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1220 my @cust_pay = qsearch( {
1221 'table' => 'cust_pay',
1223 'extra_sql' => $where,
1224 'order_by' => 'ORDER BY paynum',
1227 foreach my $cust_pay (@cust_pay) {
1229 my $h_cust_pay = $cust_pay->h_search('insert');
1230 if ( $h_cust_pay ) {
1231 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1232 #$cust_pay->otaker($h_cust_pay->history_user);
1233 $cust_pay->set('otaker', $h_cust_pay->history_user);
1235 $cust_pay->set('otaker', 'legacy');
1238 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1239 my $error = $cust_pay->replace;
1242 warn " *** WARNING: Error updating order taker for payment paynum ".
1243 $cust_pay->paynun. ": $error\n";
1247 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1250 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1251 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1257 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1261 # payinfo N/A upgrade
1264 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1266 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1268 my @na_cust_pay = qsearch( {
1269 'table' => 'cust_pay',
1270 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1271 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1274 foreach my $na ( @na_cust_pay ) {
1276 next unless $na->payinfo eq 'N/A';
1278 my $cust_pay_pending =
1279 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1280 unless ( $cust_pay_pending ) {
1281 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1282 $na->paynum. " (no cust_pay_pending)\n";
1285 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1286 my $error = $na->replace;
1288 warn " *** WARNING: Error updating payinfo for payment paynum ".
1289 $na->paynun. ": $error\n";
1295 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1299 # otaker->usernum upgrade
1302 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1303 $class->_upgrade_otaker(%opt);
1304 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1306 # if we do this anywhere else, it should become an FS::Upgrade method
1307 my $num_to_upgrade = $class->count('paybatch is not null');
1308 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1309 if ( $num_to_upgrade > 0 ) {
1310 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1311 if ( $opt{queue} ) {
1312 if ( $num_jobs > 0 ) {
1313 warn "Upgrade already queued.\n";
1315 warn "Scheduling upgrade.\n";
1316 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1320 process_upgrade_paybatch();
1325 # don't set paycardtype until 4.x
1327 #$class->upgrade_set_cardtype;
1329 # for batch payments, make sure paymask is set
1331 local $FS::payinfo_Mixin::allow_closed_replace = 1;
1332 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1334 my $cursor = FS::Cursor->new({
1335 table => 'cust_pay',
1336 extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1337 AND payby IN(\'CARD\', \'CHEK\')
1338 AND batchnum IS NOT NULL',
1341 # records from cursors for some reason don't decrypt payinfo, so
1342 # call replace_old to fetch the record "normally"
1343 while (my $cust_pay = $cursor->fetch) {
1344 $cust_pay = $cust_pay->replace_old;
1345 $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1346 my $error = $cust_pay->replace;
1348 die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1355 sub process_upgrade_paybatch {
1357 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1358 local $FS::UID::AutoCommit = 1;
1361 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1363 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1364 my $search = FS::Cursor->new( {
1365 'table' => 'cust_pay',
1366 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1368 while (my $cust_pay = $search->fetch) {
1369 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1370 $cust_pay->set('paybatch' => '');
1371 my $error = $cust_pay->replace;
1372 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1377 # migrate gateway info from the misused 'paybatch' field
1380 # not only cust_pay, but also voided and refunded payments
1381 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1382 local $FS::Record::nowarn_classload=1;
1383 # really inefficient, but again, only has to run once
1384 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1385 my $and_batchnum_is_null =
1386 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1387 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1388 my $search = FS::Cursor->new({
1390 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1391 "AND (paybatch IS NOT NULL ".
1392 "OR (paybatch IS NULL AND auth IS NULL
1393 $and_batchnum_is_null ) )
1394 ORDER BY $pkey DESC"
1396 while ( my $object = $search->fetch ) {
1397 if ( $object->paybatch eq '' ) {
1398 # repair for a previous upgrade that didn't save 'auth'
1399 my $pkey = $object->primary_key;
1400 # find the last history record that had a paybatch value
1402 table => "h_$table",
1404 $pkey => $object->$pkey,
1405 paybatch => { op=>'!=', value=>''},
1406 history_action => 'replace_old',
1408 order_by => 'ORDER BY history_date DESC LIMIT 1',
1411 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1414 # if the paybatch didn't have an auth string, then it's fine
1415 $h->paybatch =~ /:(\w+):/ or next;
1416 # set paybatch to what it was in that record
1417 $object->set('paybatch', $h->paybatch)
1418 # and then upgrade it like the old records
1421 my $parsed = $object->_parse_paybatch;
1422 if (keys %$parsed) {
1423 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1424 $object->set('auth' => $parsed->{authorization});
1425 $object->set('paybatch', '');
1426 my $error = $object->replace;
1427 warn "error parsing CARD/CHEK paybatch fields on $object #".
1428 $object->get($object->primary_key).":\n $error\n"
1433 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1443 =item process_batch_import
1447 sub process_batch_import {
1452 my $custnum = $hash{'custnum'};
1453 my $agentnum = $hash{'agentnum'};
1454 my $agent_custid = $hash{'agent_custid'};
1456 $hash{'_date'} = parse_datetime($hash{'_date'})
1457 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1458 #remove custnum_prefix
1459 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1460 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1463 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1464 && length($1) == $custnum_length
1468 # check agentnum against custnum and
1469 # translate agent_custid into regular custnum
1470 if ($custnum && $agent_custid) {
1471 die "can't specify both custnum and agent_custid\n";
1472 } elsif ($agentnum || $agent_custid) {
1473 # here is the agent virtualization
1474 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1476 $search{'agentnum'} = $agentnum
1478 $search{'agent_custid'} = $agent_custid
1480 $search{'custnum'} = $custnum
1482 my $cust_main = qsearchs({
1483 'table' => 'cust_main',
1484 'hashref' => \%search,
1485 'extra_sql' => $extra_sql,
1487 die "can't find customer with" .
1488 ($agentnum ? " agentnum $agentnum" : '') .
1489 ($custnum ? " custnum $custnum" : '') .
1490 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1492 die "mismatched customer number\n"
1493 if $custnum && ($custnum ne $cust_main->custnum);
1494 $custnum = $cust_main->custnum;
1496 $hash{'custnum'} = $custnum;
1497 delete($hash{'agent_custid'});
1502 'table' => 'cust_pay',
1503 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1504 #agent_custid isn't a cust_pay field, see hash callback
1505 'formats' => { 'simple' =>
1506 [ qw(custnum agent_custid paid payinfo invnum) ] },
1507 'format_types' => { 'simple' => '' }, #force infer from file extension
1508 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1509 'format_hash_callbacks' => { 'simple' => $hashcb },
1510 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1511 'postinsert_callback' => sub {
1512 my $cust_pay = shift;
1513 my $cust_main = $cust_pay->cust_main
1514 or return "can't find customer to which payments apply";
1515 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1517 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1522 FS::Record::process_batch_import( $job, $opt, @_ );
1526 =item batch_import HASHREF
1528 Inserts new payments.
1535 my $fh = $param->{filehandle};
1536 my $format = $param->{'format'};
1538 my $agentnum = $param->{agentnum};
1539 my $_date = $param->{_date};
1540 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1541 my $paybatch = $param->{'paybatch'};
1543 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1544 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1546 # here is the agent virtualization
1547 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1551 if ( $format eq 'simple' ) {
1552 @fields = qw( custnum agent_custid paid payinfo invnum );
1554 } elsif ( $format eq 'extended' ) {
1555 die "unimplemented\n";
1559 die "unknown format $format";
1562 eval "use Text::CSV_XS;";
1565 my $csv = new Text::CSV_XS;
1569 local $SIG{HUP} = 'IGNORE';
1570 local $SIG{INT} = 'IGNORE';
1571 local $SIG{QUIT} = 'IGNORE';
1572 local $SIG{TERM} = 'IGNORE';
1573 local $SIG{TSTP} = 'IGNORE';
1574 local $SIG{PIPE} = 'IGNORE';
1576 my $oldAutoCommit = $FS::UID::AutoCommit;
1577 local $FS::UID::AutoCommit = 0;
1581 while ( defined($line=<$fh>) ) {
1583 $csv->parse($line) or do {
1584 $dbh->rollback if $oldAutoCommit;
1585 return "can't parse: ". $csv->error_input();
1588 my @columns = $csv->fields();
1592 paybatch => $paybatch,
1594 $cust_pay{_date} = $_date if $_date;
1597 foreach my $field ( @fields ) {
1599 if ( $field eq 'agent_custid'
1601 && $columns[0] =~ /\S+/ )
1604 my $agent_custid = $columns[0];
1605 my %hash = ( 'agent_custid' => $agent_custid,
1606 'agentnum' => $agentnum,
1609 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1610 $dbh->rollback if $oldAutoCommit;
1611 return "can't specify custnum with agent_custid $agent_custid";
1614 $cust_main = qsearchs({
1615 'table' => 'cust_main',
1616 'hashref' => \%hash,
1617 'extra_sql' => $extra_sql,
1620 unless ( $cust_main ) {
1621 $dbh->rollback if $oldAutoCommit;
1622 return "can't find customer with agent_custid $agent_custid";
1626 $columns[0] = $cust_main->custnum;
1629 $cust_pay{$field} = shift @columns;
1632 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1633 && length($1) == $custnum_length ) {
1634 $cust_pay{custnum} = $2;
1637 my $custnum = $cust_pay{custnum};
1639 my $cust_pay = new FS::cust_pay( \%cust_pay );
1640 my $error = $cust_pay->insert;
1642 if ( ! $error && $cust_pay->custnum != $custnum ) {
1643 #invnum was defined, and ->insert set custnum to the customer for that
1644 #invoice, but it wasn't the one the import specified.
1645 $dbh->rollback if $oldAutoCommit;
1646 $error = "specified invoice #". $cust_pay{invnum}.
1647 " is for custnum ". $cust_pay->custnum.
1648 ", not specified custnum $custnum";
1652 $dbh->rollback if $oldAutoCommit;
1653 return "can't insert payment for $line: $error";
1656 if ( $format eq 'simple' ) {
1657 # include agentnum for less surprise?
1658 $cust_main = qsearchs({
1659 'table' => 'cust_main',
1660 'hashref' => { 'custnum' => $cust_pay->custnum },
1661 'extra_sql' => $extra_sql,
1665 unless ( $cust_main ) {
1666 $dbh->rollback if $oldAutoCommit;
1667 return "can't find customer to which payments apply at line: $line";
1670 $error = $cust_main->apply_payments_and_credits;
1672 $dbh->rollback if $oldAutoCommit;
1673 return "can't apply payments to customer for $line: $error";
1681 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1683 return "Empty file!" unless $imported;
1693 Delete and replace methods.
1697 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1698 schema.html from the base documentation.