4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
6 use vars qw( $DEBUG $me $conf @encrypted_fields
7 $unsuspendauto $ignore_noapply
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 {
38 $unsuspendauto = $conf->exists('unsuspendauto');
41 @encrypted_fields = ('payinfo');
42 sub nohistory_fields { ('payinfo'); }
46 FS::cust_pay - Object methods for cust_pay objects
52 $record = new FS::cust_pay \%hash;
53 $record = new FS::cust_pay { 'column' => 'value' };
55 $error = $record->insert;
57 $error = $new_record->replace($old_record);
59 $error = $record->delete;
61 $error = $record->check;
65 An FS::cust_pay object represents a payment; the transfer of money from a
66 customer. FS::cust_pay inherits from FS::Record. The following fields are
73 primary key (assigned automatically for new payments)
77 customer (see L<FS::cust_main>)
81 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
82 L<Time::Local> and L<Date::Parse> for conversion functions.
86 Amount of this payment
90 order taker (see L<FS::access_user>)
94 Payment Type (See L<FS::payinfo_Mixin> for valid values)
98 Payment Information (See L<FS::payinfo_Mixin> for data format)
102 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
106 obsolete text field for tracking card processing or other batch grouping
110 Optional unique identifer to prevent duplicate transactions.
114 books closed flag, empty or `Y'
118 Desired pkgnum when using experimental package balances.
122 Flag to only allow manual application of payment, empty or 'Y'
126 The bank where the payment was deposited.
130 The name of the depositor.
134 The deposit account number.
142 The number of the batch this payment came from (see L<FS::pay_batch>),
143 or null if it was processed through a realtime gateway or entered manually.
147 The number of the realtime or batch gateway L<FS::payment_gateway>) this
148 payment was processed through. Null if it was entered manually or processed
149 by the "system default" gateway, which doesn't have a number.
153 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
154 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
155 redundant with C<gatewaynum>.
159 The authorization number returned by the credit card network.
163 The transaction ID returned by the gateway, if any. This is usually what
164 you would use to initiate a void or refund of the payment.
174 Creates a new payment. To add the payment to the databse, see L<"insert">.
178 sub table { 'cust_pay'; }
179 sub cust_linked { $_[0]->cust_main_custnum; }
180 sub cust_unlinked_msg {
182 "WARNING: can't find cust_main.custnum ". $self->custnum.
183 ' (cust_pay.paynum '. $self->paynum. ')';
186 =item insert [ OPTION => VALUE ... ]
188 Adds this payment to the database.
190 For backwards-compatibility and convenience, if the additional field invnum
191 is defined, an FS::cust_bill_pay record for the full amount of the payment
192 will be created. In this case, custnum is optional.
194 If the additional field discount_term is defined then a prepayment discount
195 is taken for that length of time. It is an error for the customer to owe
196 after this payment is made.
198 A hash of optional arguments may be passed. Currently "manual" is supported.
199 If true, a payment receipt is sent instead of a statement when
200 'payment_receipt_email' configuration option is set.
202 About the "manual" flag: Normally, if the 'payment_receipt' config option
203 is set, and the customer has an invoice email address, inserting a payment
204 causes a I<statement> to be emailed to the customer. If the payment is
205 considered "manual" (or if the customer has no invoices), then it will
206 instead send a I<payment receipt>. "manual" should be true whenever a
207 payment is created directly from the web interface, from a user-initiated
208 realtime payment, or from a third-party payment via self-service. It should
209 be I<false> when creating a payment from a billing event or from a batch.
214 my($self, %options) = @_;
216 local $SIG{HUP} = 'IGNORE';
217 local $SIG{INT} = 'IGNORE';
218 local $SIG{QUIT} = 'IGNORE';
219 local $SIG{TERM} = 'IGNORE';
220 local $SIG{TSTP} = 'IGNORE';
221 local $SIG{PIPE} = 'IGNORE';
223 my $oldAutoCommit = $FS::UID::AutoCommit;
224 local $FS::UID::AutoCommit = 0;
228 if ( $self->invnum ) {
229 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
231 $dbh->rollback if $oldAutoCommit;
232 return "Unknown cust_bill.invnum: ". $self->invnum;
234 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
235 $dbh->rollback if $oldAutoCommit;
236 return "Invoice custnum ".$cust_bill->custnum
237 ." does not match specified custnum ".$self->custnum
238 ." for invoice ".$self->invnum;
240 $self->custnum($cust_bill->custnum );
243 my $error = $self->check;
244 return $error if $error;
246 my $cust_main = $self->cust_main;
247 my $old_balance = $cust_main->balance;
249 $error = $self->SUPER::insert;
251 $dbh->rollback if $oldAutoCommit;
252 return "error inserting cust_pay: $error";
255 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
256 if ( my $months = $self->discount_term ) {
257 # XXX this should be moved out somewhere, but discount_term_values
259 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
260 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
262 # %billing_pkgs contains this customer's active monthly packages.
263 # Recurring fees for those packages will be credited and then rebilled
264 # for the full discount term. Other packages on the last invoice
265 # (canceled, non-monthly recurring, or one-time charges) will be
267 my %billing_pkgs = map { $_->pkgnum => $_ }
268 grep { $_->part_pkg->freq eq '1' }
269 $cust_main->billing_pkgs;
270 my $credit = 0; # sum of recurring charges from that invoice
271 my $last_bill_date = 0; # the real bill date
272 foreach my $item ( $cust_bill->cust_bill_pkg ) {
273 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
274 $credit += $item->recur;
275 $last_bill_date = $item->cust_pkg->last_bill
276 if defined($item->cust_pkg)
277 and $item->cust_pkg->last_bill > $last_bill_date
280 my $cust_credit = new FS::cust_credit {
281 'custnum' => $self->custnum,
282 'amount' => sprintf('%.2f', $credit),
283 'reason' => 'customer chose to prepay for discount',
285 $error = $cust_credit->insert('reason_type' => $credit_type);
287 $dbh->rollback if $oldAutoCommit;
288 return "error inserting prepayment credit: $error";
292 # bill for the entire term
293 $_->bill($_->last_bill) foreach (values %billing_pkgs);
294 $error = $cust_main->bill(
295 # no recurring_only, we want unbilled packages with start dates to
297 'no_usage_reset' => 1,
298 'time' => $last_bill_date, # not $cust_bill->_date
299 'pkg_list' => [ values %billing_pkgs ],
300 'freq_override' => $months,
303 $dbh->rollback if $oldAutoCommit;
304 return "error inserting cust_pay: $error";
306 $error = $cust_main->apply_payments_and_credits;
308 $dbh->rollback if $oldAutoCommit;
309 return "error inserting cust_pay: $error";
311 my $new_balance = $cust_main->balance;
312 if ($new_balance > 0) {
313 $dbh->rollback if $oldAutoCommit;
314 return "balance after prepay discount attempt: $new_balance";
316 # user friendly: override the "apply only to this invoice" mode
323 if ( $self->invnum ) {
324 my $cust_bill_pay = new FS::cust_bill_pay {
325 'invnum' => $self->invnum,
326 'paynum' => $self->paynum,
327 'amount' => $self->paid,
328 '_date' => $self->_date,
330 $error = $cust_bill_pay->insert(%options);
332 if ( $ignore_noapply ) {
333 warn "warning: error inserting cust_bill_pay: $error ".
334 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
336 $dbh->rollback if $oldAutoCommit;
337 return "error inserting cust_bill_pay: $error";
342 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 #false laziness w/ cust_credit::insert
345 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
346 my @errors = $cust_main->unsuspend;
348 # side-fx with nested transactions? upstack rolls back?
349 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
355 #bill setup fees for voip_cdr bill_every_call packages
356 #some false laziness w/search in freeside-cdrd
358 'LEFT JOIN part_pkg USING ( pkgpart ) '.
359 "LEFT JOIN part_pkg_option
360 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
361 AND part_pkg_option.optionname = 'bill_every_call' )";
363 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
364 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
366 my @cust_pkg = qsearch({
367 'table' => 'cust_pkg',
368 'addl_from' => $addl_from,
369 'hashref' => { 'custnum' => $self->custnum,
373 'extra_sql' => $extra_sql,
377 warn "voip_cdr bill_every_call packages found; billing customer\n";
378 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
380 warn "WARNING: Error billing customer: $bill_error\n";
383 #end of billing setup fees for voip_cdr bill_every_call packages
385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
388 my $trigger = $conf->config('payment_receipt-trigger',
389 $self->cust_main->agentnum) || 'cust_pay';
390 if ( $trigger eq 'cust_pay' ) {
391 my $error = $self->send_receipt(
392 'manual' => $options{'manual'},
393 'cust_bill' => $cust_bill,
394 'cust_main' => $cust_main,
396 warn "can't send payment receipt/statement: $error" if $error;
399 #run payment events immediately
400 my $due_cust_event = $self->cust_main->due_cust_event(
401 'eventtable' => 'cust_pay',
402 'objects' => [ $self ],
404 if ( !ref($due_cust_event) ) {
405 warn "Error searching for cust_pay billing events: $due_cust_event\n";
407 foreach my $cust_event (@$due_cust_event) {
408 next unless $cust_event->test_conditions;
409 if ( my $error = $cust_event->do_event() ) {
410 warn "Error running cust_pay billing event: $error\n";
419 =item void [ REASON ]
421 Voids this payment: deletes the payment and all associated applications and
422 adds a record of the voided payment to the FS::cust_pay_void table.
429 local $SIG{HUP} = 'IGNORE';
430 local $SIG{INT} = 'IGNORE';
431 local $SIG{QUIT} = 'IGNORE';
432 local $SIG{TERM} = 'IGNORE';
433 local $SIG{TSTP} = 'IGNORE';
434 local $SIG{PIPE} = 'IGNORE';
436 my $oldAutoCommit = $FS::UID::AutoCommit;
437 local $FS::UID::AutoCommit = 0;
440 my $cust_pay_void = new FS::cust_pay_void ( {
441 map { $_ => $self->get($_) } $self->fields
443 $cust_pay_void->reason(shift) if scalar(@_);
444 my $error = $cust_pay_void->insert;
446 my $cust_pay_pending =
447 qsearchs('cust_pay_pending', { paynum => $self->paynum });
448 if ( $cust_pay_pending ) {
449 $cust_pay_pending->set('void_paynum', $self->paynum);
450 $cust_pay_pending->set('paynum', '');
451 $error ||= $cust_pay_pending->replace;
454 $error ||= $self->delete;
457 $dbh->rollback if $oldAutoCommit;
461 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
469 Unless the closed flag is set, deletes this payment and all associated
470 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
471 cases, you want to use the void method instead to leave a record of the
476 # very similar to FS::cust_credit::delete
479 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
481 local $SIG{HUP} = 'IGNORE';
482 local $SIG{INT} = 'IGNORE';
483 local $SIG{QUIT} = 'IGNORE';
484 local $SIG{TERM} = 'IGNORE';
485 local $SIG{TSTP} = 'IGNORE';
486 local $SIG{PIPE} = 'IGNORE';
488 my $oldAutoCommit = $FS::UID::AutoCommit;
489 local $FS::UID::AutoCommit = 0;
492 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
493 my $error = $app->delete;
495 $dbh->rollback if $oldAutoCommit;
500 my $error = $self->SUPER::delete(@_);
502 $dbh->rollback if $oldAutoCommit;
506 if ( $conf->exists('deletepayments')
507 && $conf->config('deletepayments') ne '' ) {
509 my $cust_main = $self->cust_main;
511 my $error = send_email(
512 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
513 #invoice_from??? well as good as any
514 'to' => $conf->config('deletepayments'),
515 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
517 "This is an automatic message from your Freeside installation\n",
518 "informing you that the following payment has been deleted:\n",
520 'paynum: '. $self->paynum. "\n",
521 'custnum: '. $self->custnum.
522 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
523 'paid: $'. sprintf("%.2f", $self->paid). "\n",
524 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
525 'payby: '. $self->payby. "\n",
526 'payinfo: '. $self->paymask. "\n",
527 'paybatch: '. $self->paybatch. "\n",
532 $dbh->rollback if $oldAutoCommit;
533 return "can't send payment deletion notification: $error";
538 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
544 =item replace [ OLD_RECORD ]
546 You can, but probably shouldn't modify payments...
548 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
549 supplied, replaces this record. If there is an error, returns the error,
550 otherwise returns false.
556 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
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 my @invoicing_list = $cust_main->invoicing_list_emailonly;
660 return '' unless @invoicing_list;
662 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
666 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
667 #|| ! $conf->exists('invoice_html_statement')
671 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
674 my %substitutions = ();
675 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
677 my $queue = new FS::queue {
678 'job' => 'FS::Misc::process_send_email',
679 'paynum' => $self->paynum,
680 'custnum' => $cust_main->custnum,
682 $error = $queue->insert(
683 FS::msg_template->by_key($msgnum)->prepare(
684 'cust_main' => $cust_main,
686 'from_config' => 'payment_receipt_from',
687 'substitutions' => \%substitutions,
689 'msgtype' => 'receipt', # override msg_template's default
692 } elsif ( $conf->exists('payment_receipt_email') ) {
694 my $receipt_template = new Text::Template (
696 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
698 warn "can't create payment receipt template: $Text::Template::ERROR";
702 my $payby = $self->payby;
703 my $payinfo = $self->payinfo;
704 $payby =~ s/^BILL$/Check/ if $payinfo;
705 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
706 $payinfo = $self->paymask
708 $payinfo = $self->decrypt($payinfo);
710 $payby =~ s/^CHEK$/Electronic check/;
713 'date' => time2str("%a %B %o, %Y", $self->_date),
714 'name' => $cust_main->name,
715 'paynum' => $self->paynum,
716 'paid' => sprintf("%.2f", $self->paid),
717 'payby' => ucfirst(lc($payby)),
718 'payinfo' => $payinfo,
719 'balance' => $cust_main->balance,
720 'company_name' => $conf->config('company_name', $cust_main->agentnum),
723 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
725 if ( $opt->{'cust_pkg'} ) {
726 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
727 #setup date, other things?
730 my $queue = new FS::queue {
731 'job' => 'FS::Misc::process_send_generated_email',
732 'paynum' => $self->paynum,
733 'custnum' => $cust_main->custnum,
734 'msgtype' => 'receipt',
736 $error = $queue->insert(
737 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
738 #invoice_from??? well as good as any
739 'to' => \@invoicing_list,
740 'subject' => 'Payment receipt',
741 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
746 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
750 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
752 my $queue = new FS::queue {
753 'job' => 'FS::cust_bill::queueable_email',
754 'paynum' => $self->paynum,
755 'custnum' => $cust_main->custnum,
759 'invnum' => $cust_bill->invnum,
763 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
764 $opt{'mode'} = $mode;
766 # backward compatibility, no good fix for this yet as some people may
767 # still have "invoice_latex_statement" and such options
768 $opt{'template'} = 'statement';
769 $opt{'notice_name'} = 'Statement';
772 $error = $queue->insert(%opt);
776 warn "send_receipt: $error\n" if $error;
781 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
788 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
789 sort { $a->_date <=> $b->_date
790 || $a->invnum <=> $b->invnum }
791 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
795 =item cust_pay_refund
797 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
802 sub cust_pay_refund {
804 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
805 sort { $a->_date <=> $b->_date }
806 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
813 Returns the amount of this payment that is still unapplied; which is
814 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
815 applications (see L<FS::cust_pay_refund>).
821 my $amount = $self->paid;
822 $amount -= $_->amount foreach ( $self->cust_bill_pay );
823 $amount -= $_->amount foreach ( $self->cust_pay_refund );
824 sprintf("%.2f", $amount );
829 Returns the amount of this payment that has not been refuned; which is
830 paid minus all refund applications (see L<FS::cust_pay_refund>).
836 my $amount = $self->paid;
837 $amount -= $_->amount foreach ( $self->cust_pay_refund );
838 sprintf("%.2f", $amount );
843 Returns the "paid" field.
852 =item delete_cust_bill_pay OPTIONS
854 Deletes all associated cust_bill_pay records.
856 If option 'unapplied' is a specified, only deletes until
857 this object's 'unapplied' value is >= the specified amount.
858 (Deletes in order returned by L</cust_bill_pay>.)
862 sub delete_cust_bill_pay {
866 local $SIG{HUP} = 'IGNORE';
867 local $SIG{INT} = 'IGNORE';
868 local $SIG{QUIT} = 'IGNORE';
869 local $SIG{TERM} = 'IGNORE';
870 local $SIG{TSTP} = 'IGNORE';
871 local $SIG{PIPE} = 'IGNORE';
873 my $oldAutoCommit = $FS::UID::AutoCommit;
874 local $FS::UID::AutoCommit = 0;
877 my $unapplied = $self->unapplied; #only need to look it up once
881 # Maybe we should reverse the order these get deleted in?
882 # ie delete newest first?
883 # keeping consistent with how bop refunds work, for now...
884 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
885 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
886 $unapplied += $cust_bill_pay->amount;
887 $error = $cust_bill_pay->delete;
892 $dbh->rollback if $oldAutoCommit;
896 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
902 Accepts input for creating a new FS::cust_refund object.
903 Unapplies payment from invoices up to the amount of the refund,
904 creates the refund and applies payment to refund. Allows entire
905 process to be handled in one transaction.
907 Causes a fatal error if called on CARD or CHEK payments.
914 die "Cannot call cust_pay->refund on " . $self->payby
915 if grep { $_ eq $self->payby } qw(CARD CHEK);
917 local $SIG{HUP} = 'IGNORE';
918 local $SIG{INT} = 'IGNORE';
919 local $SIG{QUIT} = 'IGNORE';
920 local $SIG{TERM} = 'IGNORE';
921 local $SIG{TSTP} = 'IGNORE';
922 local $SIG{PIPE} = 'IGNORE';
924 my $oldAutoCommit = $FS::UID::AutoCommit;
925 local $FS::UID::AutoCommit = 0;
928 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
931 $dbh->rollback if $oldAutoCommit;
935 $hash->{'paynum'} = $self->paynum;
936 my $new = new FS::cust_refund ( $hash );
937 $error = $new->insert;
940 $dbh->rollback if $oldAutoCommit;
944 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
948 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
950 =item refund_to_unapply
952 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
953 (all currently applied refunds that aren't closed.)
954 Returns empty list if payment itself is closed.
958 sub refund_to_unapply {
960 return () if $self->closed;
962 'table' => 'cust_pay_refund',
963 'hashref' => { 'paynum' => $self->paynum },
964 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
965 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
971 Deletes all objects returned by L</refund_to_unapply>.
978 local $SIG{HUP} = 'IGNORE';
979 local $SIG{INT} = 'IGNORE';
980 local $SIG{QUIT} = 'IGNORE';
981 local $SIG{TERM} = 'IGNORE';
982 local $SIG{TSTP} = 'IGNORE';
983 local $SIG{PIPE} = 'IGNORE';
985 my $oldAutoCommit = $FS::UID::AutoCommit;
986 local $FS::UID::AutoCommit = 0;
988 foreach my $cust_pay_refund ($self->refund_to_unapply) {
989 my $error = $cust_pay_refund->delete;
991 dbh->rollback if $oldAutoCommit;
996 dbh->commit or die dbh->errstr if $oldAutoCommit;
1002 =head1 CLASS METHODS
1006 =item batch_insert CUST_PAY_OBJECT, ...
1008 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1009 objects. Returns a list, each element representing the status of inserting the
1010 corresponding payment - empty. If there is an error inserting any payment, the
1011 entire transaction is rolled back, i.e. all payments are inserted or none are.
1013 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1014 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1015 those objects will be inserted with the paynum of the payment, and for
1016 each one, an error message or an empty string will be inserted into the
1021 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1022 my $num_errors = scalar(grep $_, @errors);
1023 if ( $num_errors == 0 ) {
1024 #success; all payments were inserted
1026 #failure; no payments were inserted.
1032 my $self = shift; #class method
1034 local $SIG{HUP} = 'IGNORE';
1035 local $SIG{INT} = 'IGNORE';
1036 local $SIG{QUIT} = 'IGNORE';
1037 local $SIG{TERM} = 'IGNORE';
1038 local $SIG{TSTP} = 'IGNORE';
1039 local $SIG{PIPE} = 'IGNORE';
1041 my $oldAutoCommit = $FS::UID::AutoCommit;
1042 local $FS::UID::AutoCommit = 0;
1048 foreach my $cust_pay (@_) {
1049 my $error = $cust_pay->insert( 'manual' => 1 );
1050 push @errors, $error;
1051 $num_errors++ if $error;
1053 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1055 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1056 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1060 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1061 my $apply_error = $cust_bill_pay->insert;
1062 push @errors, $apply_error || '';
1063 $num_errors++ if $apply_error;
1067 } elsif ( !$error ) { #normal case: apply payments as usual
1068 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1073 if ( $num_errors ) {
1074 $dbh->rollback if $oldAutoCommit;
1076 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1085 Returns an SQL fragment to retreive the unapplied amount.
1090 my ($class, $start, $end) = @_;
1091 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1092 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1093 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1094 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1098 ( SELECT SUM(amount) FROM cust_bill_pay
1099 WHERE cust_pay.paynum = cust_bill_pay.paynum
1100 $bill_start $bill_end )
1104 ( SELECT SUM(amount) FROM cust_pay_refund
1105 WHERE cust_pay.paynum = cust_pay_refund.paynum
1106 $refund_start $refund_end )
1115 # Used by FS::Upgrade to migrate to a new database.
1119 sub _upgrade_data { #class method
1120 my ($class, %opt) = @_;
1122 warn "$me upgrading $class\n" if $DEBUG;
1124 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1127 # otaker/ivan upgrade
1130 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1132 #not the most efficient, but hey, it only has to run once
1134 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1135 " AND usernum IS NULL ".
1136 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1137 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1139 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1141 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1142 $sth->execute or die $sth->errstr;
1143 my $total = $sth->fetchrow_arrayref->[0];
1144 #warn "$total cust_pay records to update\n"
1146 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1151 my @cust_pay = qsearch( {
1152 'table' => 'cust_pay',
1154 'extra_sql' => $where,
1155 'order_by' => 'ORDER BY paynum',
1158 foreach my $cust_pay (@cust_pay) {
1160 my $h_cust_pay = $cust_pay->h_search('insert');
1161 if ( $h_cust_pay ) {
1162 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1163 #$cust_pay->otaker($h_cust_pay->history_user);
1164 $cust_pay->set('otaker', $h_cust_pay->history_user);
1166 $cust_pay->set('otaker', 'legacy');
1169 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1170 my $error = $cust_pay->replace;
1173 warn " *** WARNING: Error updating order taker for payment paynum ".
1174 $cust_pay->paynun. ": $error\n";
1178 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1181 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1182 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1188 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1192 # payinfo N/A upgrade
1195 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1197 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1199 my @na_cust_pay = qsearch( {
1200 'table' => 'cust_pay',
1201 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1202 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1205 foreach my $na ( @na_cust_pay ) {
1207 next unless $na->payinfo eq 'N/A';
1209 my $cust_pay_pending =
1210 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1211 unless ( $cust_pay_pending ) {
1212 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1213 $na->paynum. " (no cust_pay_pending)\n";
1216 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1217 my $error = $na->replace;
1219 warn " *** WARNING: Error updating payinfo for payment paynum ".
1220 $na->paynun. ": $error\n";
1226 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1230 # otaker->usernum upgrade
1233 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1234 $class->_upgrade_otaker(%opt);
1235 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1237 # if we do this anywhere else, it should become an FS::Upgrade method
1238 my $num_to_upgrade = $class->count('paybatch is not null');
1239 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1240 if ( $num_to_upgrade > 0 ) {
1241 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1242 if ( $opt{queue} ) {
1243 if ( $num_jobs > 0 ) {
1244 warn "Upgrade already queued.\n";
1246 warn "Scheduling upgrade.\n";
1247 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1251 process_upgrade_paybatch();
1256 sub process_upgrade_paybatch {
1258 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1259 local $FS::UID::AutoCommit = 1;
1262 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1264 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1265 my $search = FS::Cursor->new( {
1266 'table' => 'cust_pay',
1267 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1269 while (my $cust_pay = $search->fetch) {
1270 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1271 $cust_pay->set('paybatch' => '');
1272 my $error = $cust_pay->replace;
1273 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1278 # migrate gateway info from the misused 'paybatch' field
1281 # not only cust_pay, but also voided and refunded payments
1282 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1283 local $FS::Record::nowarn_classload=1;
1284 # really inefficient, but again, only has to run once
1285 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1286 my $and_batchnum_is_null =
1287 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1288 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1289 my $search = FS::Cursor->new({
1291 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1292 "AND (paybatch IS NOT NULL ".
1293 "OR (paybatch IS NULL AND auth IS NULL
1294 $and_batchnum_is_null ) )
1295 ORDER BY $pkey DESC"
1297 while ( my $object = $search->fetch ) {
1298 if ( $object->paybatch eq '' ) {
1299 # repair for a previous upgrade that didn't save 'auth'
1300 my $pkey = $object->primary_key;
1301 # find the last history record that had a paybatch value
1303 table => "h_$table",
1305 $pkey => $object->$pkey,
1306 paybatch => { op=>'!=', value=>''},
1307 history_action => 'replace_old',
1309 order_by => 'ORDER BY history_date DESC LIMIT 1',
1312 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1315 # if the paybatch didn't have an auth string, then it's fine
1316 $h->paybatch =~ /:(\w+):/ or next;
1317 # set paybatch to what it was in that record
1318 $object->set('paybatch', $h->paybatch)
1319 # and then upgrade it like the old records
1322 my $parsed = $object->_parse_paybatch;
1323 if (keys %$parsed) {
1324 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1325 $object->set('auth' => $parsed->{authorization});
1326 $object->set('paybatch', '');
1327 my $error = $object->replace;
1328 warn "error parsing CARD/CHEK paybatch fields on $object #".
1329 $object->get($object->primary_key).":\n $error\n"
1334 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1344 =item process_batch_import
1348 sub process_batch_import {
1353 my $custnum = $hash{'custnum'};
1354 my $agentnum = $hash{'agentnum'};
1355 my $agent_custid = $hash{'agent_custid'};
1357 $hash{'_date'} = parse_datetime($hash{'_date'})
1358 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1359 #remove custnum_prefix
1360 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1361 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1364 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1365 && length($1) == $custnum_length
1369 # check agentnum against custnum and
1370 # translate agent_custid into regular custnum
1371 if ($custnum && $agent_custid) {
1372 die "can't specify both custnum and agent_custid\n";
1373 } elsif ($agentnum || $agent_custid) {
1374 # here is the agent virtualization
1375 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1377 $search{'agentnum'} = $agentnum
1379 $search{'agent_custid'} = $agent_custid
1381 $search{'custnum'} = $custnum
1383 my $cust_main = qsearchs({
1384 'table' => 'cust_main',
1385 'hashref' => \%search,
1386 'extra_sql' => $extra_sql,
1388 die "can't find customer with" .
1389 ($agentnum ? " agentnum $agentnum" : '') .
1390 ($custnum ? " custnum $custnum" : '') .
1391 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1393 die "mismatched customer number\n"
1394 if $custnum && ($custnum ne $cust_main->custnum);
1395 $custnum = $cust_main->custnum;
1397 $hash{'custnum'} = $custnum;
1398 delete($hash{'agent_custid'});
1403 'table' => 'cust_pay',
1404 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1405 #agent_custid isn't a cust_pay field, see hash callback
1406 'formats' => { 'simple' =>
1407 [ qw(custnum agent_custid paid payinfo invnum) ] },
1408 'format_types' => { 'simple' => '' }, #force infer from file extension
1409 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1410 'format_hash_callbacks' => { 'simple' => $hashcb },
1411 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1412 'postinsert_callback' => sub {
1413 my $cust_pay = shift;
1414 my $cust_main = $cust_pay->cust_main
1415 or return "can't find customer to which payments apply";
1416 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1418 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1423 FS::Record::process_batch_import( $job, $opt, @_ );
1427 =item batch_import HASHREF
1429 Inserts new payments.
1436 my $fh = $param->{filehandle};
1437 my $format = $param->{'format'};
1439 my $agentnum = $param->{agentnum};
1440 my $_date = $param->{_date};
1441 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1442 my $paybatch = $param->{'paybatch'};
1444 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1445 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1447 # here is the agent virtualization
1448 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1452 if ( $format eq 'simple' ) {
1453 @fields = qw( custnum agent_custid paid payinfo invnum );
1455 } elsif ( $format eq 'extended' ) {
1456 die "unimplemented\n";
1460 die "unknown format $format";
1463 eval "use Text::CSV_XS;";
1466 my $csv = new Text::CSV_XS;
1470 local $SIG{HUP} = 'IGNORE';
1471 local $SIG{INT} = 'IGNORE';
1472 local $SIG{QUIT} = 'IGNORE';
1473 local $SIG{TERM} = 'IGNORE';
1474 local $SIG{TSTP} = 'IGNORE';
1475 local $SIG{PIPE} = 'IGNORE';
1477 my $oldAutoCommit = $FS::UID::AutoCommit;
1478 local $FS::UID::AutoCommit = 0;
1482 while ( defined($line=<$fh>) ) {
1484 $csv->parse($line) or do {
1485 $dbh->rollback if $oldAutoCommit;
1486 return "can't parse: ". $csv->error_input();
1489 my @columns = $csv->fields();
1493 paybatch => $paybatch,
1495 $cust_pay{_date} = $_date if $_date;
1498 foreach my $field ( @fields ) {
1500 if ( $field eq 'agent_custid'
1502 && $columns[0] =~ /\S+/ )
1505 my $agent_custid = $columns[0];
1506 my %hash = ( 'agent_custid' => $agent_custid,
1507 'agentnum' => $agentnum,
1510 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1511 $dbh->rollback if $oldAutoCommit;
1512 return "can't specify custnum with agent_custid $agent_custid";
1515 $cust_main = qsearchs({
1516 'table' => 'cust_main',
1517 'hashref' => \%hash,
1518 'extra_sql' => $extra_sql,
1521 unless ( $cust_main ) {
1522 $dbh->rollback if $oldAutoCommit;
1523 return "can't find customer with agent_custid $agent_custid";
1527 $columns[0] = $cust_main->custnum;
1530 $cust_pay{$field} = shift @columns;
1533 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1534 && length($1) == $custnum_length ) {
1535 $cust_pay{custnum} = $2;
1538 my $custnum = $cust_pay{custnum};
1540 my $cust_pay = new FS::cust_pay( \%cust_pay );
1541 my $error = $cust_pay->insert;
1543 if ( ! $error && $cust_pay->custnum != $custnum ) {
1544 #invnum was defined, and ->insert set custnum to the customer for that
1545 #invoice, but it wasn't the one the import specified.
1546 $dbh->rollback if $oldAutoCommit;
1547 $error = "specified invoice #". $cust_pay{invnum}.
1548 " is for custnum ". $cust_pay->custnum.
1549 ", not specified custnum $custnum";
1553 $dbh->rollback if $oldAutoCommit;
1554 return "can't insert payment for $line: $error";
1557 if ( $format eq 'simple' ) {
1558 # include agentnum for less surprise?
1559 $cust_main = qsearchs({
1560 'table' => 'cust_main',
1561 'hashref' => { 'custnum' => $cust_pay->custnum },
1562 'extra_sql' => $extra_sql,
1566 unless ( $cust_main ) {
1567 $dbh->rollback if $oldAutoCommit;
1568 return "can't find customer to which payments apply at line: $line";
1571 $error = $cust_main->apply_payments_and_credits;
1573 $dbh->rollback if $oldAutoCommit;
1574 return "can't apply payments to customer for $line: $error";
1582 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1584 return "Empty file!" unless $imported;
1594 Delete and replace methods.
1598 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1599 schema.html from the base documentation.