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;
384 $self->{'processing_fee'} = $options{'processing-fee'};
387 my $trigger = $conf->config('payment_receipt-trigger',
388 $self->cust_main->agentnum) || 'cust_pay';
389 if ( $trigger eq 'cust_pay' ) {
390 my $error = $self->send_receipt(
391 'manual' => $options{'manual'},
392 'cust_bill' => $cust_bill,
393 'cust_main' => $cust_main,
395 warn "can't send payment receipt/statement: $error" if $error;
398 #run payment events immediately
399 my $due_cust_event = $self->cust_main->due_cust_event(
400 'eventtable' => 'cust_pay',
401 'objects' => [ $self ],
403 if ( !ref($due_cust_event) ) {
404 warn "Error searching for cust_pay billing events: $due_cust_event\n";
406 foreach my $cust_event (@$due_cust_event) {
407 next unless $cust_event->test_conditions;
408 if ( my $error = $cust_event->do_event() ) {
409 warn "Error running cust_pay billing event: $error\n";
418 =item void [ REASON ]
420 Voids this payment: deletes the payment and all associated applications and
421 adds a record of the voided payment to the FS::cust_pay_void table.
428 local $SIG{HUP} = 'IGNORE';
429 local $SIG{INT} = 'IGNORE';
430 local $SIG{QUIT} = 'IGNORE';
431 local $SIG{TERM} = 'IGNORE';
432 local $SIG{TSTP} = 'IGNORE';
433 local $SIG{PIPE} = 'IGNORE';
435 my $oldAutoCommit = $FS::UID::AutoCommit;
436 local $FS::UID::AutoCommit = 0;
439 my $cust_pay_void = new FS::cust_pay_void ( {
440 map { $_ => $self->get($_) } $self->fields
442 $cust_pay_void->reason(shift) if scalar(@_);
443 my $error = $cust_pay_void->insert;
445 my $cust_pay_pending =
446 qsearchs('cust_pay_pending', { paynum => $self->paynum });
447 if ( $cust_pay_pending ) {
448 $cust_pay_pending->set('void_paynum', $self->paynum);
449 $cust_pay_pending->set('paynum', '');
450 $error ||= $cust_pay_pending->replace;
453 $error ||= $self->delete;
456 $dbh->rollback if $oldAutoCommit;
460 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
468 Unless the closed flag is set, deletes this payment and all associated
469 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
470 cases, you want to use the void method instead to leave a record of the
475 # very similar to FS::cust_credit::delete
478 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
480 local $SIG{HUP} = 'IGNORE';
481 local $SIG{INT} = 'IGNORE';
482 local $SIG{QUIT} = 'IGNORE';
483 local $SIG{TERM} = 'IGNORE';
484 local $SIG{TSTP} = 'IGNORE';
485 local $SIG{PIPE} = 'IGNORE';
487 my $oldAutoCommit = $FS::UID::AutoCommit;
488 local $FS::UID::AutoCommit = 0;
491 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
492 my $error = $app->delete;
494 $dbh->rollback if $oldAutoCommit;
499 my $error = $self->SUPER::delete(@_);
501 $dbh->rollback if $oldAutoCommit;
505 if ( $conf->exists('deletepayments')
506 && $conf->config('deletepayments') ne '' ) {
508 my $cust_main = $self->cust_main;
510 my $error = send_email(
511 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
512 #invoice_from??? well as good as any
513 'to' => $conf->config('deletepayments'),
514 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
516 "This is an automatic message from your Freeside installation\n",
517 "informing you that the following payment has been deleted:\n",
519 'paynum: '. $self->paynum. "\n",
520 'custnum: '. $self->custnum.
521 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
522 'paid: $'. sprintf("%.2f", $self->paid). "\n",
523 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
524 'payby: '. $self->payby. "\n",
525 'payinfo: '. $self->paymask. "\n",
526 'paybatch: '. $self->paybatch. "\n",
531 $dbh->rollback if $oldAutoCommit;
532 return "can't send payment deletion notification: $error";
537 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
543 =item replace [ OLD_RECORD ]
545 You can, but probably shouldn't modify payments...
547 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
548 supplied, replaces this record. If there is an error, returns the error,
549 otherwise returns false.
555 return "Can't modify closed payment"
556 if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace;
557 $self->SUPER::replace(@_);
562 Checks all fields to make sure this is a valid payment. If there is an error,
563 returns the error, otherwise returns false. Called by the insert method.
570 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
573 $self->ut_numbern('paynum')
574 || $self->ut_numbern('custnum')
575 || $self->ut_numbern('_date')
576 || $self->ut_money('paid')
577 || $self->ut_alphan('otaker')
578 || $self->ut_textn('paybatch')
579 || $self->ut_textn('payunique')
580 || $self->ut_enum('closed', [ '', 'Y' ])
581 || $self->ut_flag('no_auto_apply')
582 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
583 || $self->ut_textn('bank')
584 || $self->ut_alphan('depositor')
585 || $self->ut_numbern('account')
586 || $self->ut_numbern('teller')
587 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
588 || $self->payinfo_check()
590 return $error if $error;
592 return "paid must be > 0 " if $self->paid <= 0;
594 return "unknown cust_main.custnum: ". $self->custnum
596 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
598 $self->_date(time) unless $self->_date;
600 return "invalid discount_term"
601 if ($self->discount_term && $self->discount_term < 2);
603 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
604 foreach (qw(bank depositor account teller)) {
605 return "$_ required" if $self->get($_) eq '';
609 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
610 # # UNIQUE index should catch this too, without race conditions, but this
611 # # should give a better error message the other 99.9% of the time...
612 # if ( length($self->payunique)
613 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
614 # #well, it *could* be a better error message
615 # return "duplicate transaction".
616 # " - a payment with unique identifer ". $self->payunique.
623 =item send_receipt HASHREF | OPTION => VALUE ...
625 Sends a payment receipt for this payment..
633 Flag indicating the payment is being made manually.
637 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
642 Customer (FS::cust_main) object (for efficiency).
650 my $opt = ref($_[0]) ? shift : { @_ };
652 my $cust_bill = $opt->{'cust_bill'};
653 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
655 my $conf = new FS::Conf;
657 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
659 return '' if ($conf->config_bool('allow_payment_receipt_noemail', $cust_main->agentnum) && $cust_main->paymentreceipt_noemail);
661 my @invoicing_list = $cust_main->invoicing_list_emailonly;
662 return '' unless @invoicing_list;
664 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
668 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
669 #|| ! $conf->exists('invoice_html_statement')
674 $error = $self->send_message_receipt(
675 'cust_main' => $cust_main,
676 'cust_bill' => $opt->{cust_bill},
677 'cust_pkg' => $opt->{cust_pkg},
678 'invoicing_list' => \@invoicing_list,
679 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
682 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
684 # check to see if they want to send specific message template as receipt for auto payments
685 if ( $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum) ) {
686 $error = $self->send_message_receipt(
687 'cust_main' => $cust_main,
688 'cust_bill' => $opt->{cust_bill},
689 'msgnum' => $conf->config('payment_receipt_msgnum_auto', $cust_main->agentnum),
693 my $queue = new FS::queue {
694 'job' => 'FS::cust_bill::queueable_email',
695 'paynum' => $self->paynum,
696 'custnum' => $cust_main->custnum,
700 'invnum' => $cust_bill->invnum,
704 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
705 $opt{'mode'} = $mode;
707 # backward compatibility, no good fix for this yet as some people may
708 # still have "invoice_latex_statement" and such options
709 $opt{'template'} = 'statement';
710 $opt{'notice_name'} = 'Statement';
713 $error = $queue->insert(%opt);
717 warn "send_receipt: $error\n" if $error;
720 =item send_message_receipt
722 sends out a message receipt.
723 $error = $self->send_message_receipt(
724 'cust_main' => $cust_main,
725 'cust_bill' => $opt->{cust_bill},
726 'cust_pkg' => $opt->{cust_pkg},
727 'invoicing_list' => \@invoicing_list,
728 'msgnum' => $conf->config('payment_receipt_msgnum', $cust_main->agentnum)
733 sub send_message_receipt {
734 my ($self, %opt) = @_;
735 my $cust_main = $opt{'cust_main'};
736 my $cust_bill = $opt{'cust_bill'};
737 my $cust_pkg = $opt{'cust_pkg'};
738 my @invoicing_list = ref($opt{'invoicing_list'}) ? @{ $opt{'invoicing_list'} } : ( $opt{'invoicing_list'} );
739 my $msgnum = $opt{'msgnum'};
744 my %substitutions = ();
745 $substitutions{invnum} = $cust_bill->invnum if $cust_bill;
746 $substitutions{'processing_fee'} = $self->{'processing_fee'};
749 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
750 unless ($msg_template) {
751 return "send_receipt could not load msg_template";
754 my $queue = new FS::queue {
755 'job' => 'FS::Misc::process_send_email',
756 'paynum' => $self->paynum,
757 'custnum' => $cust_main->custnum,
759 $error = $queue->insert(
760 FS::msg_template->by_key($msgnum)->prepare(
761 'cust_main' => $cust_main,
763 'from_config' => 'payment_receipt_from',
764 'substitutions' => \%substitutions,
766 'msgtype' => 'receipt', # override msg_template's default
768 } elsif ( $conf->exists('payment_receipt_email') ) {
770 my $receipt_template = new Text::Template (
772 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
774 return "can't create payment receipt template: $Text::Template::ERROR";
777 my $payby = $self->payby;
778 my $payinfo = $self->payinfo;
779 $payby =~ s/^BILL$/Check/ if $payinfo;
780 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
781 $payinfo = $self->paymask
783 $payinfo = $self->decrypt($payinfo);
785 $payby =~ s/^CHEK$/Electronic check/;
788 'date' => time2str("%a %B %o, %Y", $self->_date),
789 'name' => $cust_main->name,
790 'paynum' => $self->paynum,
791 'paid' => sprintf("%.2f", $self->paid),
792 'payby' => ucfirst(lc($payby)),
793 'payinfo' => $payinfo,
794 'balance' => $cust_main->balance,
795 'company_name' => $conf->config('company_name', $cust_main->agentnum),
798 $fill_in{'invnum'} = $cust_bill->invnum if $cust_bill;
801 $fill_in{'pkg'} = $cust_pkg->part_pkg->pkg;
802 #setup date, other things?
805 my $queue = new FS::queue {
806 'job' => 'FS::Misc::process_send_generated_email',
807 'paynum' => $self->paynum,
808 'custnum' => $cust_main->custnum,
809 'msgtype' => 'receipt',
811 $error = $queue->insert(
812 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
813 #invoice_from??? well as good as any
814 'to' => \@invoicing_list,
815 'subject' => 'Payment receipt',
816 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
819 $error = "payment_receipt is on, but no payment_receipt_msgnum\n";
827 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
834 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
835 sort { $a->_date <=> $b->_date
836 || $a->invnum <=> $b->invnum }
837 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
841 =item cust_pay_refund
843 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
848 sub cust_pay_refund {
850 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
851 sort { $a->_date <=> $b->_date }
852 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
859 Returns the amount of this payment that is still unapplied; which is
860 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
861 applications (see L<FS::cust_pay_refund>).
867 my $amount = $self->paid;
868 $amount -= $_->amount foreach ( $self->cust_bill_pay );
869 $amount -= $_->amount foreach ( $self->cust_pay_refund );
870 sprintf("%.2f", $amount );
875 Returns the amount of this payment that has not been refuned; which is
876 paid minus all refund applications (see L<FS::cust_pay_refund>).
882 my $amount = $self->paid;
883 $amount -= $_->amount foreach ( $self->cust_pay_refund );
884 sprintf("%.2f", $amount );
889 Returns the "paid" field.
898 =item delete_cust_bill_pay OPTIONS
900 Deletes all associated cust_bill_pay records.
902 If option 'unapplied' is a specified, only deletes until
903 this object's 'unapplied' value is >= the specified amount.
904 (Deletes in order returned by L</cust_bill_pay>.)
908 sub delete_cust_bill_pay {
912 local $SIG{HUP} = 'IGNORE';
913 local $SIG{INT} = 'IGNORE';
914 local $SIG{QUIT} = 'IGNORE';
915 local $SIG{TERM} = 'IGNORE';
916 local $SIG{TSTP} = 'IGNORE';
917 local $SIG{PIPE} = 'IGNORE';
919 my $oldAutoCommit = $FS::UID::AutoCommit;
920 local $FS::UID::AutoCommit = 0;
923 my $unapplied = $self->unapplied; #only need to look it up once
927 # Maybe we should reverse the order these get deleted in?
928 # ie delete newest first?
929 # keeping consistent with how bop refunds work, for now...
930 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
931 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
932 $unapplied += $cust_bill_pay->amount;
933 $error = $cust_bill_pay->delete;
938 $dbh->rollback if $oldAutoCommit;
942 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
948 Accepts input for creating a new FS::cust_refund object.
949 Unapplies payment from invoices up to the amount of the refund,
950 creates the refund and applies payment to refund. Allows entire
951 process to be handled in one transaction.
953 Causes a fatal error if called on CARD or CHEK payments.
960 die "Cannot call cust_pay->refund on " . $self->payby
961 if grep { $_ eq $self->payby } qw(CARD CHEK);
963 local $SIG{HUP} = 'IGNORE';
964 local $SIG{INT} = 'IGNORE';
965 local $SIG{QUIT} = 'IGNORE';
966 local $SIG{TERM} = 'IGNORE';
967 local $SIG{TSTP} = 'IGNORE';
968 local $SIG{PIPE} = 'IGNORE';
970 my $oldAutoCommit = $FS::UID::AutoCommit;
971 local $FS::UID::AutoCommit = 0;
974 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
977 $dbh->rollback if $oldAutoCommit;
981 $hash->{'paynum'} = $self->paynum;
982 my $new = new FS::cust_refund ( $hash );
983 $error = $new->insert;
986 $dbh->rollback if $oldAutoCommit;
990 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
994 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
996 =item refund_to_unapply
998 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
999 (all currently applied refunds that aren't closed.)
1000 Returns empty list if payment itself is closed.
1004 sub refund_to_unapply {
1006 return () if $self->closed;
1008 'table' => 'cust_pay_refund',
1009 'hashref' => { 'paynum' => $self->paynum },
1010 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
1011 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
1015 =item unapply_refund
1017 Deletes all objects returned by L</refund_to_unapply>.
1021 sub unapply_refund {
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;
1034 foreach my $cust_pay_refund ($self->refund_to_unapply) {
1035 my $error = $cust_pay_refund->delete;
1037 dbh->rollback if $oldAutoCommit;
1042 dbh->commit or die dbh->errstr if $oldAutoCommit;
1048 =head1 CLASS METHODS
1052 =item batch_insert CUST_PAY_OBJECT, ...
1054 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1055 objects. Returns a list, each element representing the status of inserting the
1056 corresponding payment - empty. If there is an error inserting any payment, the
1057 entire transaction is rolled back, i.e. all payments are inserted or none are.
1059 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1060 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1061 those objects will be inserted with the paynum of the payment, and for
1062 each one, an error message or an empty string will be inserted into the
1067 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1068 my $num_errors = scalar(grep $_, @errors);
1069 if ( $num_errors == 0 ) {
1070 #success; all payments were inserted
1072 #failure; no payments were inserted.
1078 my $self = shift; #class method
1080 local $SIG{HUP} = 'IGNORE';
1081 local $SIG{INT} = 'IGNORE';
1082 local $SIG{QUIT} = 'IGNORE';
1083 local $SIG{TERM} = 'IGNORE';
1084 local $SIG{TSTP} = 'IGNORE';
1085 local $SIG{PIPE} = 'IGNORE';
1087 my $oldAutoCommit = $FS::UID::AutoCommit;
1088 local $FS::UID::AutoCommit = 0;
1094 foreach my $cust_pay (@_) {
1095 my $error = $cust_pay->insert( 'manual' => 1 );
1096 push @errors, $error;
1097 $num_errors++ if $error;
1099 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1101 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1102 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1106 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1107 my $apply_error = $cust_bill_pay->insert;
1108 push @errors, $apply_error || '';
1109 $num_errors++ if $apply_error;
1113 } elsif ( !$error ) { #normal case: apply payments as usual
1114 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1119 if ( $num_errors ) {
1120 $dbh->rollback if $oldAutoCommit;
1122 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1131 Returns an SQL fragment to retreive the unapplied amount.
1136 my ($class, $start, $end) = @_;
1137 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1138 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1139 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1140 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1144 ( SELECT SUM(amount) FROM cust_bill_pay
1145 WHERE cust_pay.paynum = cust_bill_pay.paynum
1146 $bill_start $bill_end )
1150 ( SELECT SUM(amount) FROM cust_pay_refund
1151 WHERE cust_pay.paynum = cust_pay_refund.paynum
1152 $refund_start $refund_end )
1164 #my( $self, %opt ) = @_;
1167 +{ 'paynum' => $self->paynum,
1168 '_date' => $self->_date,
1169 'date' => time2str("%b %o, %Y", $self->_date),
1170 'date_short' => time2str("%m-%d-%Y", $self->_date),
1171 'paid' => sprintf('%.2f', $self->paid),
1172 'payby' => $self->payby,
1173 'paycardtype' => $self->paycardtype,
1174 'paymask' => $self->paymask,
1175 'processor' => $self->processor,
1176 'auth' => $self->auth,
1177 'order_number' => $self->order_number,
1185 # Used by FS::Upgrade to migrate to a new database.
1189 sub _upgrade_data { #class method
1190 my ($class, %opt) = @_;
1192 warn "$me upgrading $class\n" if $DEBUG;
1194 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1197 # otaker/ivan upgrade
1200 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1202 #not the most efficient, but hey, it only has to run once
1204 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1205 " AND usernum IS NULL ".
1206 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1207 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1209 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1211 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1212 $sth->execute or die $sth->errstr;
1213 my $total = $sth->fetchrow_arrayref->[0];
1214 #warn "$total cust_pay records to update\n"
1216 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1221 my @cust_pay = qsearch( {
1222 'table' => 'cust_pay',
1224 'extra_sql' => $where,
1225 'order_by' => 'ORDER BY paynum',
1228 foreach my $cust_pay (@cust_pay) {
1230 my $h_cust_pay = $cust_pay->h_search('insert');
1231 if ( $h_cust_pay ) {
1232 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1233 #$cust_pay->otaker($h_cust_pay->history_user);
1234 $cust_pay->set('otaker', $h_cust_pay->history_user);
1236 $cust_pay->set('otaker', 'legacy');
1239 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1240 my $error = $cust_pay->replace;
1243 warn " *** WARNING: Error updating order taker for payment paynum ".
1244 $cust_pay->paynun. ": $error\n";
1248 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1251 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1252 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1258 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1262 # payinfo N/A upgrade
1265 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1267 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1269 my @na_cust_pay = qsearch( {
1270 'table' => 'cust_pay',
1271 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1272 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1275 foreach my $na ( @na_cust_pay ) {
1277 next unless $na->payinfo eq 'N/A';
1279 my $cust_pay_pending =
1280 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1281 unless ( $cust_pay_pending ) {
1282 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1283 $na->paynum. " (no cust_pay_pending)\n";
1286 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1287 my $error = $na->replace;
1289 warn " *** WARNING: Error updating payinfo for payment paynum ".
1290 $na->paynun. ": $error\n";
1296 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1300 # otaker->usernum upgrade
1303 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1304 $class->_upgrade_otaker(%opt);
1305 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1307 # if we do this anywhere else, it should become an FS::Upgrade method
1308 my $num_to_upgrade = $class->count('paybatch is not null');
1309 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1310 if ( $num_to_upgrade > 0 ) {
1311 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1312 if ( $opt{queue} ) {
1313 if ( $num_jobs > 0 ) {
1314 warn "Upgrade already queued.\n";
1316 warn "Scheduling upgrade.\n";
1317 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1321 process_upgrade_paybatch();
1326 # don't set paycardtype until 4.x
1328 #$class->upgrade_set_cardtype;
1330 # for batch payments, make sure paymask is set
1332 local $FS::payinfo_Mixin::allow_closed_replace = 1;
1333 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1335 my $cursor = FS::Cursor->new({
1336 table => 'cust_pay',
1337 extra_sql => ' WHERE paymask IS NULL AND payinfo IS NOT NULL
1338 AND payby IN(\'CARD\', \'CHEK\')
1339 AND batchnum IS NOT NULL',
1342 # records from cursors for some reason don't decrypt payinfo, so
1343 # call replace_old to fetch the record "normally"
1344 while (my $cust_pay = $cursor->fetch) {
1345 $cust_pay = $cust_pay->replace_old;
1346 $cust_pay->set('paymask', $cust_pay->mask_payinfo);
1347 my $error = $cust_pay->replace;
1349 die "$error (setting masked payinfo on payment#". $cust_pay->paynum.
1356 sub process_upgrade_paybatch {
1358 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1359 local $FS::UID::AutoCommit = 1;
1362 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1364 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1365 my $search = FS::Cursor->new( {
1366 'table' => 'cust_pay',
1367 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1369 while (my $cust_pay = $search->fetch) {
1370 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1371 $cust_pay->set('paybatch' => '');
1372 my $error = $cust_pay->replace;
1373 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1378 # migrate gateway info from the misused 'paybatch' field
1381 # not only cust_pay, but also voided and refunded payments
1382 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1383 local $FS::Record::nowarn_classload=1;
1384 # really inefficient, but again, only has to run once
1385 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1386 my $and_batchnum_is_null =
1387 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1388 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1389 my $search = FS::Cursor->new({
1391 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1392 "AND (paybatch IS NOT NULL ".
1393 "OR (paybatch IS NULL AND auth IS NULL
1394 $and_batchnum_is_null ) )
1395 ORDER BY $pkey DESC"
1397 while ( my $object = $search->fetch ) {
1398 if ( $object->paybatch eq '' ) {
1399 # repair for a previous upgrade that didn't save 'auth'
1400 my $pkey = $object->primary_key;
1401 # find the last history record that had a paybatch value
1403 table => "h_$table",
1405 $pkey => $object->$pkey,
1406 paybatch => { op=>'!=', value=>''},
1407 history_action => 'replace_old',
1409 order_by => 'ORDER BY history_date DESC LIMIT 1',
1412 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1415 # if the paybatch didn't have an auth string, then it's fine
1416 $h->paybatch =~ /:(\w+):/ or next;
1417 # set paybatch to what it was in that record
1418 $object->set('paybatch', $h->paybatch)
1419 # and then upgrade it like the old records
1422 my $parsed = $object->_parse_paybatch;
1423 if (keys %$parsed) {
1424 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1425 $object->set('auth' => $parsed->{authorization});
1426 $object->set('paybatch', '');
1427 my $error = $object->replace;
1428 warn "error parsing CARD/CHEK paybatch fields on $object #".
1429 $object->get($object->primary_key).":\n $error\n"
1434 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1444 =item process_batch_import
1448 sub process_batch_import {
1453 my $custnum = $hash{'custnum'};
1454 my $agentnum = $hash{'agentnum'};
1455 my $agent_custid = $hash{'agent_custid'};
1457 $hash{'_date'} = parse_datetime($hash{'_date'})
1458 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1459 #remove custnum_prefix
1460 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1461 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1464 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1465 && length($1) == $custnum_length
1469 # check agentnum against custnum and
1470 # translate agent_custid into regular custnum
1471 if ($custnum && $agent_custid) {
1472 die "can't specify both custnum and agent_custid\n";
1473 } elsif ($agentnum || $agent_custid) {
1474 # here is the agent virtualization
1475 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1477 $search{'agentnum'} = $agentnum
1479 $search{'agent_custid'} = $agent_custid
1481 $search{'custnum'} = $custnum
1483 my $cust_main = qsearchs({
1484 'table' => 'cust_main',
1485 'hashref' => \%search,
1486 'extra_sql' => $extra_sql,
1488 die "can't find customer with" .
1489 ($agentnum ? " agentnum $agentnum" : '') .
1490 ($custnum ? " custnum $custnum" : '') .
1491 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1493 die "mismatched customer number\n"
1494 if $custnum && ($custnum ne $cust_main->custnum);
1495 $custnum = $cust_main->custnum;
1497 $hash{'custnum'} = $custnum;
1498 delete($hash{'agent_custid'});
1503 'table' => 'cust_pay',
1504 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1505 #agent_custid isn't a cust_pay field, see hash callback
1506 'formats' => { 'simple' =>
1507 [ qw(custnum agent_custid paid payinfo invnum) ] },
1508 'format_types' => { 'simple' => '' }, #force infer from file extension
1509 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1510 'format_hash_callbacks' => { 'simple' => $hashcb },
1511 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1512 'postinsert_callback' => sub {
1513 my $cust_pay = shift;
1514 my $cust_main = $cust_pay->cust_main
1515 or return "can't find customer to which payments apply";
1516 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1518 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1523 FS::Record::process_batch_import( $job, $opt, @_ );
1527 =item batch_import HASHREF
1529 Inserts new payments.
1536 my $fh = $param->{filehandle};
1537 my $format = $param->{'format'};
1539 my $agentnum = $param->{agentnum};
1540 my $_date = $param->{_date};
1541 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1542 my $paybatch = $param->{'paybatch'};
1544 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1545 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1547 # here is the agent virtualization
1548 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1552 if ( $format eq 'simple' ) {
1553 @fields = qw( custnum agent_custid paid payinfo invnum );
1555 } elsif ( $format eq 'extended' ) {
1556 die "unimplemented\n";
1560 die "unknown format $format";
1563 eval "use Text::CSV_XS;";
1566 my $csv = new Text::CSV_XS;
1570 local $SIG{HUP} = 'IGNORE';
1571 local $SIG{INT} = 'IGNORE';
1572 local $SIG{QUIT} = 'IGNORE';
1573 local $SIG{TERM} = 'IGNORE';
1574 local $SIG{TSTP} = 'IGNORE';
1575 local $SIG{PIPE} = 'IGNORE';
1577 my $oldAutoCommit = $FS::UID::AutoCommit;
1578 local $FS::UID::AutoCommit = 0;
1582 while ( defined($line=<$fh>) ) {
1584 $csv->parse($line) or do {
1585 $dbh->rollback if $oldAutoCommit;
1586 return "can't parse: ". $csv->error_input();
1589 my @columns = $csv->fields();
1593 paybatch => $paybatch,
1595 $cust_pay{_date} = $_date if $_date;
1598 foreach my $field ( @fields ) {
1600 if ( $field eq 'agent_custid'
1602 && $columns[0] =~ /\S+/ )
1605 my $agent_custid = $columns[0];
1606 my %hash = ( 'agent_custid' => $agent_custid,
1607 'agentnum' => $agentnum,
1610 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1611 $dbh->rollback if $oldAutoCommit;
1612 return "can't specify custnum with agent_custid $agent_custid";
1615 $cust_main = qsearchs({
1616 'table' => 'cust_main',
1617 'hashref' => \%hash,
1618 'extra_sql' => $extra_sql,
1621 unless ( $cust_main ) {
1622 $dbh->rollback if $oldAutoCommit;
1623 return "can't find customer with agent_custid $agent_custid";
1627 $columns[0] = $cust_main->custnum;
1630 $cust_pay{$field} = shift @columns;
1633 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1634 && length($1) == $custnum_length ) {
1635 $cust_pay{custnum} = $2;
1638 my $custnum = $cust_pay{custnum};
1640 my $cust_pay = new FS::cust_pay( \%cust_pay );
1641 my $error = $cust_pay->insert;
1643 if ( ! $error && $cust_pay->custnum != $custnum ) {
1644 #invnum was defined, and ->insert set custnum to the customer for that
1645 #invoice, but it wasn't the one the import specified.
1646 $dbh->rollback if $oldAutoCommit;
1647 $error = "specified invoice #". $cust_pay{invnum}.
1648 " is for custnum ". $cust_pay->custnum.
1649 ", not specified custnum $custnum";
1653 $dbh->rollback if $oldAutoCommit;
1654 return "can't insert payment for $line: $error";
1657 if ( $format eq 'simple' ) {
1658 # include agentnum for less surprise?
1659 $cust_main = qsearchs({
1660 'table' => 'cust_main',
1661 'hashref' => { 'custnum' => $cust_pay->custnum },
1662 'extra_sql' => $extra_sql,
1666 unless ( $cust_main ) {
1667 $dbh->rollback if $oldAutoCommit;
1668 return "can't find customer to which payments apply at line: $line";
1671 $error = $cust_main->apply_payments_and_credits;
1673 $dbh->rollback if $oldAutoCommit;
1674 return "can't apply payments to customer for $line: $error";
1682 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1684 return "Empty file!" unless $imported;
1694 Delete and replace methods.
1698 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1699 schema.html from the base documentation.