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;
403 =item void [ REASON ]
405 Voids this payment: deletes the payment and all associated applications and
406 adds a record of the voided payment to the FS::cust_pay_void table.
413 local $SIG{HUP} = 'IGNORE';
414 local $SIG{INT} = 'IGNORE';
415 local $SIG{QUIT} = 'IGNORE';
416 local $SIG{TERM} = 'IGNORE';
417 local $SIG{TSTP} = 'IGNORE';
418 local $SIG{PIPE} = 'IGNORE';
420 my $oldAutoCommit = $FS::UID::AutoCommit;
421 local $FS::UID::AutoCommit = 0;
424 my $cust_pay_void = new FS::cust_pay_void ( {
425 map { $_ => $self->get($_) } $self->fields
427 $cust_pay_void->reason(shift) if scalar(@_);
428 my $error = $cust_pay_void->insert;
430 my $cust_pay_pending =
431 qsearchs('cust_pay_pending', { paynum => $self->paynum });
432 if ( $cust_pay_pending ) {
433 $cust_pay_pending->set('void_paynum', $self->paynum);
434 $cust_pay_pending->set('paynum', '');
435 $error ||= $cust_pay_pending->replace;
438 $error ||= $self->delete;
441 $dbh->rollback if $oldAutoCommit;
445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
453 Unless the closed flag is set, deletes this payment and all associated
454 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
455 cases, you want to use the void method instead to leave a record of the
460 # very similar to FS::cust_credit::delete
463 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
465 local $SIG{HUP} = 'IGNORE';
466 local $SIG{INT} = 'IGNORE';
467 local $SIG{QUIT} = 'IGNORE';
468 local $SIG{TERM} = 'IGNORE';
469 local $SIG{TSTP} = 'IGNORE';
470 local $SIG{PIPE} = 'IGNORE';
472 my $oldAutoCommit = $FS::UID::AutoCommit;
473 local $FS::UID::AutoCommit = 0;
476 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
477 my $error = $app->delete;
479 $dbh->rollback if $oldAutoCommit;
484 my $error = $self->SUPER::delete(@_);
486 $dbh->rollback if $oldAutoCommit;
490 if ( $conf->exists('deletepayments')
491 && $conf->config('deletepayments') ne '' ) {
493 my $cust_main = $self->cust_main;
495 my $error = send_email(
496 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
497 #invoice_from??? well as good as any
498 'to' => $conf->config('deletepayments'),
499 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
501 "This is an automatic message from your Freeside installation\n",
502 "informing you that the following payment has been deleted:\n",
504 'paynum: '. $self->paynum. "\n",
505 'custnum: '. $self->custnum.
506 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
507 'paid: $'. sprintf("%.2f", $self->paid). "\n",
508 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
509 'payby: '. $self->payby. "\n",
510 'payinfo: '. $self->paymask. "\n",
511 'paybatch: '. $self->paybatch. "\n",
516 $dbh->rollback if $oldAutoCommit;
517 return "can't send payment deletion notification: $error";
522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
528 =item replace [ OLD_RECORD ]
530 You can, but probably shouldn't modify payments...
532 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
533 supplied, replaces this record. If there is an error, returns the error,
534 otherwise returns false.
540 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
541 $self->SUPER::replace(@_);
546 Checks all fields to make sure this is a valid payment. If there is an error,
547 returns the error, otherwise returns false. Called by the insert method.
554 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
557 $self->ut_numbern('paynum')
558 || $self->ut_numbern('custnum')
559 || $self->ut_numbern('_date')
560 || $self->ut_money('paid')
561 || $self->ut_alphan('otaker')
562 || $self->ut_textn('paybatch')
563 || $self->ut_textn('payunique')
564 || $self->ut_enum('closed', [ '', 'Y' ])
565 || $self->ut_flag('no_auto_apply')
566 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
567 || $self->ut_textn('bank')
568 || $self->ut_alphan('depositor')
569 || $self->ut_numbern('account')
570 || $self->ut_numbern('teller')
571 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
572 || $self->payinfo_check()
574 return $error if $error;
576 return "paid must be > 0 " if $self->paid <= 0;
578 return "unknown cust_main.custnum: ". $self->custnum
580 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
582 $self->_date(time) unless $self->_date;
584 return "invalid discount_term"
585 if ($self->discount_term && $self->discount_term < 2);
587 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
588 foreach (qw(bank depositor account teller)) {
589 return "$_ required" if $self->get($_) eq '';
593 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
594 # # UNIQUE index should catch this too, without race conditions, but this
595 # # should give a better error message the other 99.9% of the time...
596 # if ( length($self->payunique)
597 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
598 # #well, it *could* be a better error message
599 # return "duplicate transaction".
600 # " - a payment with unique identifer ". $self->payunique.
607 =item send_receipt HASHREF | OPTION => VALUE ...
609 Sends a payment receipt for this payment..
617 Flag indicating the payment is being made manually.
621 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
626 Customer (FS::cust_main) object (for efficiency).
634 my $opt = ref($_[0]) ? shift : { @_ };
636 my $cust_bill = $opt->{'cust_bill'};
637 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
639 my $conf = new FS::Conf;
641 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
643 my @invoicing_list = $cust_main->invoicing_list_emailonly;
644 return '' unless @invoicing_list;
646 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
650 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
651 #|| ! $conf->exists('invoice_html_statement')
655 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
658 my %substitutions = ();
659 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
661 my $queue = new FS::queue {
662 'job' => 'FS::Misc::process_send_email',
663 'paynum' => $self->paynum,
664 'custnum' => $cust_main->custnum,
666 $error = $queue->insert(
667 FS::msg_template->by_key($msgnum)->prepare(
668 'cust_main' => $cust_main,
670 'from_config' => 'payment_receipt_from',
671 'substitutions' => \%substitutions,
673 'msgtype' => 'receipt', # override msg_template's default
676 } elsif ( $conf->exists('payment_receipt_email') ) {
678 my $receipt_template = new Text::Template (
680 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
682 warn "can't create payment receipt template: $Text::Template::ERROR";
686 my $payby = $self->payby;
687 my $payinfo = $self->payinfo;
688 $payby =~ s/^BILL$/Check/ if $payinfo;
689 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
690 $payinfo = $self->paymask
692 $payinfo = $self->decrypt($payinfo);
694 $payby =~ s/^CHEK$/Electronic check/;
697 'date' => time2str("%a %B %o, %Y", $self->_date),
698 'name' => $cust_main->name,
699 'paynum' => $self->paynum,
700 'paid' => sprintf("%.2f", $self->paid),
701 'payby' => ucfirst(lc($payby)),
702 'payinfo' => $payinfo,
703 'balance' => $cust_main->balance,
704 'company_name' => $conf->config('company_name', $cust_main->agentnum),
707 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
709 if ( $opt->{'cust_pkg'} ) {
710 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
711 #setup date, other things?
714 my $queue = new FS::queue {
715 'job' => 'FS::Misc::process_send_generated_email',
716 'paynum' => $self->paynum,
717 'custnum' => $cust_main->custnum,
718 'msgtype' => 'receipt',
720 $error = $queue->insert(
721 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
722 #invoice_from??? well as good as any
723 'to' => \@invoicing_list,
724 'subject' => 'Payment receipt',
725 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
730 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
734 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
736 my $queue = new FS::queue {
737 'job' => 'FS::cust_bill::queueable_email',
738 'paynum' => $self->paynum,
739 'custnum' => $cust_main->custnum,
743 'invnum' => $cust_bill->invnum,
747 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
748 $opt{'mode'} = $mode;
750 # backward compatibility, no good fix for this yet as some people may
751 # still have "invoice_latex_statement" and such options
752 $opt{'template'} = 'statement';
753 $opt{'notice_name'} = 'Statement';
756 $error = $queue->insert(%opt);
760 warn "send_receipt: $error\n" if $error;
765 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
772 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
773 sort { $a->_date <=> $b->_date
774 || $a->invnum <=> $b->invnum }
775 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
779 =item cust_pay_refund
781 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
786 sub cust_pay_refund {
788 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
789 sort { $a->_date <=> $b->_date }
790 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
797 Returns the amount of this payment that is still unapplied; which is
798 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
799 applications (see L<FS::cust_pay_refund>).
805 my $amount = $self->paid;
806 $amount -= $_->amount foreach ( $self->cust_bill_pay );
807 $amount -= $_->amount foreach ( $self->cust_pay_refund );
808 sprintf("%.2f", $amount );
813 Returns the amount of this payment that has not been refuned; which is
814 paid minus all refund applications (see L<FS::cust_pay_refund>).
820 my $amount = $self->paid;
821 $amount -= $_->amount foreach ( $self->cust_pay_refund );
822 sprintf("%.2f", $amount );
827 Returns the "paid" field.
836 =item delete_cust_bill_pay OPTIONS
838 Deletes all associated cust_bill_pay records.
840 If option 'unapplied' is a specified, only deletes until
841 this object's 'unapplied' value is >= the specified amount.
842 (Deletes in order returned by L</cust_bill_pay>.)
846 sub delete_cust_bill_pay {
850 local $SIG{HUP} = 'IGNORE';
851 local $SIG{INT} = 'IGNORE';
852 local $SIG{QUIT} = 'IGNORE';
853 local $SIG{TERM} = 'IGNORE';
854 local $SIG{TSTP} = 'IGNORE';
855 local $SIG{PIPE} = 'IGNORE';
857 my $oldAutoCommit = $FS::UID::AutoCommit;
858 local $FS::UID::AutoCommit = 0;
861 my $unapplied = $self->unapplied; #only need to look it up once
865 # Maybe we should reverse the order these get deleted in?
866 # ie delete newest first?
867 # keeping consistent with how bop refunds work, for now...
868 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
869 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
870 $unapplied += $cust_bill_pay->amount;
871 $error = $cust_bill_pay->delete;
876 $dbh->rollback if $oldAutoCommit;
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
886 Accepts input for creating a new FS::cust_refund object.
887 Unapplies payment from invoices up to the amount of the refund,
888 creates the refund and applies payment to refund. Allows entire
889 process to be handled in one transaction.
891 Causes a fatal error if called on CARD or CHEK payments.
898 die "Cannot call cust_pay->refund on " . $self->payby
899 if grep { $_ eq $self->payby } qw(CARD CHEK);
901 local $SIG{HUP} = 'IGNORE';
902 local $SIG{INT} = 'IGNORE';
903 local $SIG{QUIT} = 'IGNORE';
904 local $SIG{TERM} = 'IGNORE';
905 local $SIG{TSTP} = 'IGNORE';
906 local $SIG{PIPE} = 'IGNORE';
908 my $oldAutoCommit = $FS::UID::AutoCommit;
909 local $FS::UID::AutoCommit = 0;
912 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
915 $dbh->rollback if $oldAutoCommit;
919 $hash->{'paynum'} = $self->paynum;
920 my $new = new FS::cust_refund ( $hash );
921 $error = $new->insert;
924 $dbh->rollback if $oldAutoCommit;
928 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
938 =item batch_insert CUST_PAY_OBJECT, ...
940 Class method which inserts multiple payments. Takes a list of FS::cust_pay
941 objects. Returns a list, each element representing the status of inserting the
942 corresponding payment - empty. If there is an error inserting any payment, the
943 entire transaction is rolled back, i.e. all payments are inserted or none are.
945 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
946 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
947 those objects will be inserted with the paynum of the payment, and for
948 each one, an error message or an empty string will be inserted into the
953 my @errors = FS::cust_pay->batch_insert(@cust_pay);
954 my $num_errors = scalar(grep $_, @errors);
955 if ( $num_errors == 0 ) {
956 #success; all payments were inserted
958 #failure; no payments were inserted.
964 my $self = shift; #class method
966 local $SIG{HUP} = 'IGNORE';
967 local $SIG{INT} = 'IGNORE';
968 local $SIG{QUIT} = 'IGNORE';
969 local $SIG{TERM} = 'IGNORE';
970 local $SIG{TSTP} = 'IGNORE';
971 local $SIG{PIPE} = 'IGNORE';
973 my $oldAutoCommit = $FS::UID::AutoCommit;
974 local $FS::UID::AutoCommit = 0;
980 foreach my $cust_pay (@_) {
981 my $error = $cust_pay->insert( 'manual' => 1 );
982 push @errors, $error;
983 $num_errors++ if $error;
985 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
987 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
988 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
992 $cust_bill_pay->set('paynum', $cust_pay->paynum);
993 my $apply_error = $cust_bill_pay->insert;
994 push @errors, $apply_error || '';
995 $num_errors++ if $apply_error;
999 } elsif ( !$error ) { #normal case: apply payments as usual
1000 $cust_pay->cust_main->apply_payments;
1005 if ( $num_errors ) {
1006 $dbh->rollback if $oldAutoCommit;
1008 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1017 Returns an SQL fragment to retreive the unapplied amount.
1022 my ($class, $start, $end) = @_;
1023 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1024 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1025 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1026 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1030 ( SELECT SUM(amount) FROM cust_bill_pay
1031 WHERE cust_pay.paynum = cust_bill_pay.paynum
1032 $bill_start $bill_end )
1036 ( SELECT SUM(amount) FROM cust_pay_refund
1037 WHERE cust_pay.paynum = cust_pay_refund.paynum
1038 $refund_start $refund_end )
1047 # Used by FS::Upgrade to migrate to a new database.
1051 sub _upgrade_data { #class method
1052 my ($class, %opt) = @_;
1054 warn "$me upgrading $class\n" if $DEBUG;
1056 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1059 # otaker/ivan upgrade
1062 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1064 #not the most efficient, but hey, it only has to run once
1066 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1067 " AND usernum IS NULL ".
1068 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1069 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1071 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1073 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1074 $sth->execute or die $sth->errstr;
1075 my $total = $sth->fetchrow_arrayref->[0];
1076 #warn "$total cust_pay records to update\n"
1078 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1083 my @cust_pay = qsearch( {
1084 'table' => 'cust_pay',
1086 'extra_sql' => $where,
1087 'order_by' => 'ORDER BY paynum',
1090 foreach my $cust_pay (@cust_pay) {
1092 my $h_cust_pay = $cust_pay->h_search('insert');
1093 if ( $h_cust_pay ) {
1094 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1095 #$cust_pay->otaker($h_cust_pay->history_user);
1096 $cust_pay->set('otaker', $h_cust_pay->history_user);
1098 $cust_pay->set('otaker', 'legacy');
1101 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1102 my $error = $cust_pay->replace;
1105 warn " *** WARNING: Error updating order taker for payment paynum ".
1106 $cust_pay->paynun. ": $error\n";
1110 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1113 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1114 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1120 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1124 # payinfo N/A upgrade
1127 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1129 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1131 my @na_cust_pay = qsearch( {
1132 'table' => 'cust_pay',
1133 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1134 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1137 foreach my $na ( @na_cust_pay ) {
1139 next unless $na->payinfo eq 'N/A';
1141 my $cust_pay_pending =
1142 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1143 unless ( $cust_pay_pending ) {
1144 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1145 $na->paynum. " (no cust_pay_pending)\n";
1148 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1149 my $error = $na->replace;
1151 warn " *** WARNING: Error updating payinfo for payment paynum ".
1152 $na->paynun. ": $error\n";
1158 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1162 # otaker->usernum upgrade
1165 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1166 $class->_upgrade_otaker(%opt);
1167 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1169 # if we do this anywhere else, it should become an FS::Upgrade method
1170 my $num_to_upgrade = $class->count('paybatch is not null');
1171 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1172 if ( $num_to_upgrade > 0 ) {
1173 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1174 if ( $opt{queue} ) {
1175 if ( $num_jobs > 0 ) {
1176 warn "Upgrade already queued.\n";
1178 warn "Scheduling upgrade.\n";
1179 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1183 process_upgrade_paybatch();
1188 sub process_upgrade_paybatch {
1190 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1191 local $FS::UID::AutoCommit = 1;
1194 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1196 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1197 my $search = FS::Cursor->new( {
1198 'table' => 'cust_pay',
1199 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1201 while (my $cust_pay = $search->fetch) {
1202 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1203 $cust_pay->set('paybatch' => '');
1204 my $error = $cust_pay->replace;
1205 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1210 # migrate gateway info from the misused 'paybatch' field
1213 # not only cust_pay, but also voided and refunded payments
1214 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1215 local $FS::Record::nowarn_classload=1;
1216 # really inefficient, but again, only has to run once
1217 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1218 my $and_batchnum_is_null =
1219 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1220 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1221 my $search = FS::Cursor->new({
1223 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1224 "AND (paybatch IS NOT NULL ".
1225 "OR (paybatch IS NULL AND auth IS NULL
1226 $and_batchnum_is_null ) )
1227 ORDER BY $pkey DESC"
1229 while ( my $object = $search->fetch ) {
1230 if ( $object->paybatch eq '' ) {
1231 # repair for a previous upgrade that didn't save 'auth'
1232 my $pkey = $object->primary_key;
1233 # find the last history record that had a paybatch value
1235 table => "h_$table",
1237 $pkey => $object->$pkey,
1238 paybatch => { op=>'!=', value=>''},
1239 history_action => 'replace_old',
1241 order_by => 'ORDER BY history_date DESC LIMIT 1',
1244 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1247 # if the paybatch didn't have an auth string, then it's fine
1248 $h->paybatch =~ /:(\w+):/ or next;
1249 # set paybatch to what it was in that record
1250 $object->set('paybatch', $h->paybatch)
1251 # and then upgrade it like the old records
1254 my $parsed = $object->_parse_paybatch;
1255 if (keys %$parsed) {
1256 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1257 $object->set('auth' => $parsed->{authorization});
1258 $object->set('paybatch', '');
1259 my $error = $object->replace;
1260 warn "error parsing CARD/CHEK paybatch fields on $object #".
1261 $object->get($object->primary_key).":\n $error\n"
1266 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1276 =item process_batch_import
1280 sub process_batch_import {
1285 my $custnum = $hash{'custnum'};
1286 my $agentnum = $hash{'agentnum'};
1287 my $agent_custid = $hash{'agent_custid'};
1289 $hash{'_date'} = parse_datetime($hash{'_date'})
1290 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1291 #remove custnum_prefix
1292 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1293 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1296 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1297 && length($1) == $custnum_length
1301 # check agentnum against custnum and
1302 # translate agent_custid into regular custnum
1303 if ($custnum && $agent_custid) {
1304 die "can't specify both custnum and agent_custid\n";
1305 } elsif ($agentnum || $agent_custid) {
1306 # here is the agent virtualization
1307 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1309 $search{'agentnum'} = $agentnum
1311 $search{'agent_custid'} = $agent_custid
1313 $search{'custnum'} = $custnum
1315 my $cust_main = qsearchs({
1316 'table' => 'cust_main',
1317 'hashref' => \%search,
1318 'extra_sql' => $extra_sql,
1320 die "can't find customer with" .
1321 ($agentnum ? " agentnum $agentnum" : '') .
1322 ($custnum ? " custnum $custnum" : '') .
1323 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1325 die "mismatched customer number\n"
1326 if $custnum && ($custnum ne $cust_main->custnum);
1327 $custnum = $cust_main->custnum;
1329 $hash{'custnum'} = $custnum;
1330 delete($hash{'agent_custid'});
1335 'table' => 'cust_pay',
1336 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1337 #agent_custid isn't a cust_pay field, see hash callback
1338 'formats' => { 'simple' =>
1339 [ qw(custnum agent_custid paid payinfo invnum) ] },
1340 'format_types' => { 'simple' => '' }, #force infer from file extension
1341 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1342 'format_hash_callbacks' => { 'simple' => $hashcb },
1343 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1344 'postinsert_callback' => sub {
1345 my $cust_pay = shift;
1346 my $cust_main = $cust_pay->cust_main
1347 or return "can't find customer to which payments apply";
1348 my $error = $cust_main->apply_payments_and_credits;
1350 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1355 FS::Record::process_batch_import( $job, $opt, @_ );
1359 =item batch_import HASHREF
1361 Inserts new payments.
1368 my $fh = $param->{filehandle};
1369 my $format = $param->{'format'};
1371 my $agentnum = $param->{agentnum};
1372 my $_date = $param->{_date};
1373 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1374 my $paybatch = $param->{'paybatch'};
1376 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1377 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1379 # here is the agent virtualization
1380 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1384 if ( $format eq 'simple' ) {
1385 @fields = qw( custnum agent_custid paid payinfo invnum );
1387 } elsif ( $format eq 'extended' ) {
1388 die "unimplemented\n";
1392 die "unknown format $format";
1395 eval "use Text::CSV_XS;";
1398 my $csv = new Text::CSV_XS;
1402 local $SIG{HUP} = 'IGNORE';
1403 local $SIG{INT} = 'IGNORE';
1404 local $SIG{QUIT} = 'IGNORE';
1405 local $SIG{TERM} = 'IGNORE';
1406 local $SIG{TSTP} = 'IGNORE';
1407 local $SIG{PIPE} = 'IGNORE';
1409 my $oldAutoCommit = $FS::UID::AutoCommit;
1410 local $FS::UID::AutoCommit = 0;
1414 while ( defined($line=<$fh>) ) {
1416 $csv->parse($line) or do {
1417 $dbh->rollback if $oldAutoCommit;
1418 return "can't parse: ". $csv->error_input();
1421 my @columns = $csv->fields();
1425 paybatch => $paybatch,
1427 $cust_pay{_date} = $_date if $_date;
1430 foreach my $field ( @fields ) {
1432 if ( $field eq 'agent_custid'
1434 && $columns[0] =~ /\S+/ )
1437 my $agent_custid = $columns[0];
1438 my %hash = ( 'agent_custid' => $agent_custid,
1439 'agentnum' => $agentnum,
1442 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1443 $dbh->rollback if $oldAutoCommit;
1444 return "can't specify custnum with agent_custid $agent_custid";
1447 $cust_main = qsearchs({
1448 'table' => 'cust_main',
1449 'hashref' => \%hash,
1450 'extra_sql' => $extra_sql,
1453 unless ( $cust_main ) {
1454 $dbh->rollback if $oldAutoCommit;
1455 return "can't find customer with agent_custid $agent_custid";
1459 $columns[0] = $cust_main->custnum;
1462 $cust_pay{$field} = shift @columns;
1465 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1466 && length($1) == $custnum_length ) {
1467 $cust_pay{custnum} = $2;
1470 my $custnum = $cust_pay{custnum};
1472 my $cust_pay = new FS::cust_pay( \%cust_pay );
1473 my $error = $cust_pay->insert;
1475 if ( ! $error && $cust_pay->custnum != $custnum ) {
1476 #invnum was defined, and ->insert set custnum to the customer for that
1477 #invoice, but it wasn't the one the import specified.
1478 $dbh->rollback if $oldAutoCommit;
1479 $error = "specified invoice #". $cust_pay{invnum}.
1480 " is for custnum ". $cust_pay->custnum.
1481 ", not specified custnum $custnum";
1485 $dbh->rollback if $oldAutoCommit;
1486 return "can't insert payment for $line: $error";
1489 if ( $format eq 'simple' ) {
1490 # include agentnum for less surprise?
1491 $cust_main = qsearchs({
1492 'table' => 'cust_main',
1493 'hashref' => { 'custnum' => $cust_pay->custnum },
1494 'extra_sql' => $extra_sql,
1498 unless ( $cust_main ) {
1499 $dbh->rollback if $oldAutoCommit;
1500 return "can't find customer to which payments apply at line: $line";
1503 $error = $cust_main->apply_payments_and_credits;
1505 $dbh->rollback if $oldAutoCommit;
1506 return "can't apply payments to customer for $line: $error";
1514 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1516 return "Empty file!" unless $imported;
1526 Delete and replace methods.
1530 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1531 schema.html from the base documentation.