4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
5 FS::reason_Mixin FS::Record);
6 use vars qw( $DEBUG $me $conf @encrypted_fields
7 $unsuspendauto $ignore_noapply
10 use Business::CreditCard;
12 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
13 use FS::Record qw( dbh qsearch qsearchs );
14 use FS::UID qw( driver_name );
17 use FS::cust_main_Mixin;
18 use FS::payinfo_transaction_Mixin;
20 use FS::cust_bill_pay;
21 use FS::cust_pay_refund;
24 use FS::cust_pay_void;
25 use FS::upgrade_journal;
32 $me = '[FS::cust_pay]';
36 #ask FS::UID to run this stuff for us later
37 FS::UID->install_callback( sub {
39 $unsuspendauto = $conf->exists('unsuspendauto');
42 @encrypted_fields = ('payinfo');
43 sub nohistory_fields { ('payinfo'); }
47 FS::cust_pay - Object methods for cust_pay objects
53 $record = new FS::cust_pay \%hash;
54 $record = new FS::cust_pay { 'column' => 'value' };
56 $error = $record->insert;
58 $error = $new_record->replace($old_record);
60 $error = $record->delete;
62 $error = $record->check;
66 An FS::cust_pay object represents a payment; the transfer of money from a
67 customer. FS::cust_pay inherits from FS::Record. The following fields are
74 primary key (assigned automatically for new payments)
78 customer (see L<FS::cust_main>)
82 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
83 L<Time::Local> and L<Date::Parse> for conversion functions.
87 Amount of this payment
91 order taker (see L<FS::access_user>)
95 Payment Type (See L<FS::payinfo_Mixin> for valid values)
99 Payment Information (See L<FS::payinfo_Mixin> for data format)
103 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
107 obsolete text field for tracking card processing or other batch grouping
111 Optional unique identifer to prevent duplicate transactions.
115 books closed flag, empty or `Y'
119 Desired pkgnum when using experimental package balances.
123 Flag to only allow manual application of payment, empty or 'Y'
127 The bank where the payment was deposited.
131 The name of the depositor.
135 The deposit account number.
143 The number of the batch this payment came from (see L<FS::pay_batch>),
144 or null if it was processed through a realtime gateway or entered manually.
148 The number of the realtime or batch gateway L<FS::payment_gateway>) this
149 payment was processed through. Null if it was entered manually or processed
150 by the "system default" gateway, which doesn't have a number.
154 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
155 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
156 redundant with C<gatewaynum>.
160 The authorization number returned by the credit card network.
164 The transaction ID returned by the gateway, if any. This is usually what
165 you would use to initiate a void or refund of the payment.
175 Creates a new payment. To add the payment to the databse, see L<"insert">.
179 sub table { 'cust_pay'; }
180 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
181 sub cust_unlinked_msg {
183 "WARNING: can't find cust_main.custnum ". $self->custnum.
184 ' (cust_pay.paynum '. $self->paynum. ')';
187 =item insert [ OPTION => VALUE ... ]
189 Adds this payment to the database.
191 For backwards-compatibility and convenience, if the additional field invnum
192 is defined, an FS::cust_bill_pay record for the full amount of the payment
193 will be created. In this case, custnum is optional.
195 If the additional field discount_term is defined then a prepayment discount
196 is taken for that length of time. It is an error for the customer to owe
197 after this payment is made.
199 A hash of optional arguments may be passed. The following arguments are
206 If true, a payment receipt is sent instead of a statement when
207 'payment_receipt_email' configuration option is set.
209 About the "manual" flag: Normally, if the 'payment_receipt' config option
210 is set, and the customer has an invoice email address, inserting a payment
211 causes a I<statement> to be emailed to the customer. If the payment is
212 considered "manual" (or if the customer has no invoices), then it will
213 instead send a I<payment receipt>. "manual" should be true whenever a
214 payment is created directly from the web interface, from a user-initiated
215 realtime payment, or from a third-party payment via self-service. It should
216 be I<false> when creating a payment from a billing event or from a batch.
220 Don't send an email receipt. (Note: does not currently work when
221 payment_receipt-trigger is set to something other than default / cust_bill)
228 my($self, %options) = @_;
230 local $SIG{HUP} = 'IGNORE';
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
242 if ( $self->invnum ) {
243 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
245 $dbh->rollback if $oldAutoCommit;
246 return "Unknown cust_bill.invnum: ". $self->invnum;
248 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
249 $dbh->rollback if $oldAutoCommit;
250 return "Invoice custnum ".$cust_bill->custnum
251 ." does not match specified custnum ".$self->custnum
252 ." for invoice ".$self->invnum;
254 $self->custnum($cust_bill->custnum );
257 my $error = $self->check;
258 return $error if $error;
260 my $cust_main = $self->cust_main;
261 my $old_balance = $cust_main->balance;
263 $error = $self->SUPER::insert;
265 $dbh->rollback if $oldAutoCommit;
266 return "error inserting cust_pay: $error";
269 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
270 if ( my $months = $self->discount_term ) {
271 # XXX this should be moved out somewhere, but discount_term_values
273 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
274 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
276 # %billing_pkgs contains this customer's active monthly packages.
277 # Recurring fees for those packages will be credited and then rebilled
278 # for the full discount term. Other packages on the last invoice
279 # (canceled, non-monthly recurring, or one-time charges) will be
281 my %billing_pkgs = map { $_->pkgnum => $_ }
282 grep { $_->part_pkg->freq eq '1' }
283 $cust_main->billing_pkgs;
284 my $credit = 0; # sum of recurring charges from that invoice
285 my $last_bill_date = 0; # the real bill date
286 foreach my $item ( $cust_bill->cust_bill_pkg ) {
287 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
288 $credit += $item->recur;
289 $last_bill_date = $item->cust_pkg->last_bill
290 if defined($item->cust_pkg)
291 and $item->cust_pkg->last_bill > $last_bill_date
294 my $cust_credit = new FS::cust_credit {
295 'custnum' => $self->custnum,
296 'amount' => sprintf('%.2f', $credit),
297 'reason' => 'customer chose to prepay for discount',
299 $error = $cust_credit->insert('reason_type' => $credit_type);
301 $dbh->rollback if $oldAutoCommit;
302 return "error inserting prepayment credit: $error";
306 # bill for the entire term
307 $_->bill($_->last_bill) foreach (values %billing_pkgs);
308 $error = $cust_main->bill(
309 # no recurring_only, we want unbilled packages with start dates to
311 'no_usage_reset' => 1,
312 'time' => $last_bill_date, # not $cust_bill->_date
313 'pkg_list' => [ values %billing_pkgs ],
314 'freq_override' => $months,
317 $dbh->rollback if $oldAutoCommit;
318 return "error inserting cust_pay: $error";
320 $error = $cust_main->apply_payments_and_credits;
322 $dbh->rollback if $oldAutoCommit;
323 return "error inserting cust_pay: $error";
325 my $new_balance = $cust_main->balance;
326 if ($new_balance > 0) {
327 $dbh->rollback if $oldAutoCommit;
328 return "balance after prepay discount attempt: $new_balance";
330 # user friendly: override the "apply only to this invoice" mode
337 if ( $self->invnum ) {
338 my $cust_bill_pay = new FS::cust_bill_pay {
339 'invnum' => $self->invnum,
340 'paynum' => $self->paynum,
341 'amount' => $self->paid,
342 '_date' => $self->_date,
344 $error = $cust_bill_pay->insert(%options);
346 if ( $ignore_noapply ) {
347 warn "warning: error inserting cust_bill_pay: $error ".
348 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
350 $dbh->rollback if $oldAutoCommit;
351 return "error inserting cust_bill_pay: $error";
356 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
358 #false laziness w/ cust_credit::insert
359 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
360 my @errors = $cust_main->unsuspend;
362 # side-fx with nested transactions? upstack rolls back?
363 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
369 #bill setup fees for voip_cdr bill_every_call packages
370 #some false laziness w/search in freeside-cdrd
372 'LEFT JOIN part_pkg USING ( pkgpart ) '.
373 "LEFT JOIN part_pkg_option
374 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
375 AND part_pkg_option.optionname = 'bill_every_call' )";
377 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
378 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
380 my @cust_pkg = qsearch({
381 'table' => 'cust_pkg',
382 'addl_from' => $addl_from,
383 'hashref' => { 'custnum' => $self->custnum,
387 'extra_sql' => $extra_sql,
391 warn "voip_cdr bill_every_call packages found; billing customer\n";
392 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
394 warn "WARNING: Error billing customer: $bill_error\n";
397 #end of billing setup fees for voip_cdr bill_every_call packages
399 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
402 my $trigger = $conf->config('payment_receipt-trigger',
403 $self->cust_main->agentnum) || 'cust_pay';
404 if ( $trigger eq 'cust_pay' ) {
405 my $error = $self->send_receipt(
406 'manual' => $options{'manual'},
407 'noemail' => $options{'noemail'},
408 'cust_bill' => $cust_bill,
409 'cust_main' => $cust_main,
411 warn "can't send payment receipt/statement: $error" if $error;
414 #run payment events immediately
415 my $due_cust_event = $self->cust_main->due_cust_event(
416 'eventtable' => 'cust_pay',
417 'objects' => [ $self ],
419 if ( !ref($due_cust_event) ) {
420 warn "Error searching for cust_pay billing events: $due_cust_event\n";
422 foreach my $cust_event (@$due_cust_event) {
423 next unless $cust_event->test_conditions;
424 if ( my $error = $cust_event->do_event() ) {
425 warn "Error running cust_pay billing event: $error\n";
434 =item void [ REASON ]
436 Voids this payment: deletes the payment and all associated applications and
437 adds a record of the voided payment to the FS::cust_pay_void table.
445 unless (ref($reason) || !$reason) {
446 $reason = FS::reason->new_or_existing(
448 'type' => 'Void payment',
453 local $SIG{HUP} = 'IGNORE';
454 local $SIG{INT} = 'IGNORE';
455 local $SIG{QUIT} = 'IGNORE';
456 local $SIG{TERM} = 'IGNORE';
457 local $SIG{TSTP} = 'IGNORE';
458 local $SIG{PIPE} = 'IGNORE';
460 my $oldAutoCommit = $FS::UID::AutoCommit;
461 local $FS::UID::AutoCommit = 0;
464 my $cust_pay_void = new FS::cust_pay_void ( {
465 map { $_ => $self->get($_) } $self->fields
467 $cust_pay_void->reasonnum($reason->reasonnum) if $reason;
468 my $error = $cust_pay_void->insert;
470 my $cust_pay_pending =
471 qsearchs('cust_pay_pending', { paynum => $self->paynum });
472 if ( $cust_pay_pending ) {
473 $cust_pay_pending->set('void_paynum', $self->paynum);
474 $cust_pay_pending->set('paynum', '');
475 $error ||= $cust_pay_pending->replace;
478 $error ||= $self->delete;
481 $dbh->rollback if $oldAutoCommit;
485 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
493 Unless the closed flag is set, deletes this payment and all associated
494 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
495 cases, you want to use the void method instead to leave a record of the
500 # very similar to FS::cust_credit::delete
503 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
505 local $SIG{HUP} = 'IGNORE';
506 local $SIG{INT} = 'IGNORE';
507 local $SIG{QUIT} = 'IGNORE';
508 local $SIG{TERM} = 'IGNORE';
509 local $SIG{TSTP} = 'IGNORE';
510 local $SIG{PIPE} = 'IGNORE';
512 my $oldAutoCommit = $FS::UID::AutoCommit;
513 local $FS::UID::AutoCommit = 0;
516 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
517 my $error = $app->delete;
519 $dbh->rollback if $oldAutoCommit;
524 my $error = $self->SUPER::delete(@_);
526 $dbh->rollback if $oldAutoCommit;
530 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
536 =item replace [ OLD_RECORD ]
538 You can, but probably shouldn't modify payments...
540 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
541 supplied, replaces this record. If there is an error, returns the error,
542 otherwise returns false.
548 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
549 $self->SUPER::replace(@_);
554 Checks all fields to make sure this is a valid payment. If there is an error,
555 returns the error, otherwise returns false. Called by the insert method.
562 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
565 $self->ut_numbern('paynum')
566 || $self->ut_numbern('custnum')
567 || $self->ut_numbern('_date')
568 || $self->ut_money('paid')
569 || $self->ut_alphan('otaker')
570 || $self->ut_textn('paybatch')
571 || $self->ut_textn('payunique')
572 || $self->ut_enum('closed', [ '', 'Y' ])
573 || $self->ut_flag('no_auto_apply')
574 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
575 || $self->ut_textn('bank')
576 || $self->ut_alphan('depositor')
577 || $self->ut_numbern('account')
578 || $self->ut_numbern('teller')
579 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
580 || $self->payinfo_check()
582 return $error if $error;
584 return "paid must be > 0 " if $self->paid <= 0;
586 return "unknown cust_main.custnum: ". $self->custnum
588 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
590 $self->_date(time) unless $self->_date;
592 return "invalid discount_term"
593 if ($self->discount_term && $self->discount_term < 2);
595 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
596 foreach (qw(bank depositor account teller)) {
597 return "$_ required" if $self->get($_) eq '';
601 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
602 # # UNIQUE index should catch this too, without race conditions, but this
603 # # should give a better error message the other 99.9% of the time...
604 # if ( length($self->payunique)
605 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
606 # #well, it *could* be a better error message
607 # return "duplicate transaction".
608 # " - a payment with unique identifer ". $self->payunique.
615 =item send_receipt HASHREF | OPTION => VALUE ...
617 Sends a payment receipt for this payment..
625 Flag indicating the payment is being made manually.
629 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
634 Customer (FS::cust_main) object (for efficiency).
638 Don't send an email receipt.
648 my $opt = ref($_[0]) ? shift : { @_ };
650 my $cust_bill = $opt->{'cust_bill'};
651 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
653 my $conf = new FS::Conf;
655 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
657 my @invoicing_list = $cust_main->invoicing_list_emailonly;
658 return '' unless @invoicing_list;
660 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
664 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
665 #|| ! $conf->exists('invoice_html_statement')
669 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
672 my %substitutions = ();
673 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
675 my $queue = new FS::queue {
676 'job' => 'FS::Misc::process_send_email',
677 'paynum' => $self->paynum,
678 'custnum' => $cust_main->custnum,
680 $error = $queue->insert(
681 FS::msg_template->by_key($msgnum)->prepare(
682 'cust_main' => $cust_main,
684 'from_config' => 'payment_receipt_from',
685 'substitutions' => \%substitutions,
687 'msgtype' => 'receipt', # override msg_template's default
690 } elsif ( $conf->exists('payment_receipt_email') ) {
692 my $receipt_template = new Text::Template (
694 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
696 warn "can't create payment receipt template: $Text::Template::ERROR";
700 my $payby = $self->payby;
701 my $payinfo = $self->payinfo;
702 $payby =~ s/^BILL$/Check/ if $payinfo;
703 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
704 $payinfo = $self->paymask
706 $payinfo = $self->decrypt($payinfo);
708 $payby =~ s/^CHEK$/Electronic check/;
711 'date' => time2str("%a %B %o, %Y", $self->_date),
712 'name' => $cust_main->name,
713 'paynum' => $self->paynum,
714 'paid' => sprintf("%.2f", $self->paid),
715 'payby' => ucfirst(lc($payby)),
716 'payinfo' => $payinfo,
717 'balance' => $cust_main->balance,
718 'company_name' => $conf->config('company_name', $cust_main->agentnum),
721 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
723 if ( $opt->{'cust_pkg'} ) {
724 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
725 #setup date, other things?
728 my $queue = new FS::queue {
729 'job' => 'FS::Misc::process_send_generated_email',
730 'paynum' => $self->paynum,
731 'custnum' => $cust_main->custnum,
732 'msgtype' => 'receipt',
734 $error = $queue->insert(
735 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
736 #invoice_from??? well as good as any
737 'to' => \@invoicing_list,
738 'subject' => 'Payment receipt',
739 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
744 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
748 #not manual and no noemail flag (here or on the customer)
749 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
751 my $queue = new FS::queue {
752 'job' => 'FS::cust_bill::queueable_email',
753 'paynum' => $self->paynum,
754 'custnum' => $cust_main->custnum,
758 'invnum' => $cust_bill->invnum,
762 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
763 $opt{'mode'} = $mode;
765 # backward compatibility, no good fix for this yet as some people may
766 # still have "invoice_latex_statement" and such options
767 $opt{'template'} = 'statement';
768 $opt{'notice_name'} = 'Statement';
771 $error = $queue->insert(%opt);
775 warn "send_receipt: $error\n" if $error;
780 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
787 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
788 sort { $a->_date <=> $b->_date
789 || $a->invnum <=> $b->invnum }
790 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
794 =item cust_pay_refund
796 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
801 sub cust_pay_refund {
803 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
804 sort { $a->_date <=> $b->_date }
805 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
812 Returns the amount of this payment that is still unapplied; which is
813 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
814 applications (see L<FS::cust_pay_refund>).
820 my $amount = $self->paid;
821 $amount -= $_->amount foreach ( $self->cust_bill_pay );
822 $amount -= $_->amount foreach ( $self->cust_pay_refund );
823 sprintf("%.2f", $amount );
828 Returns the amount of this payment that has not been refuned; which is
829 paid minus all refund applications (see L<FS::cust_pay_refund>).
835 my $amount = $self->paid;
836 $amount -= $_->amount foreach ( $self->cust_pay_refund );
837 sprintf("%.2f", $amount );
842 Returns the "paid" field.
851 =item delete_cust_bill_pay OPTIONS
853 Deletes all associated cust_bill_pay records.
855 If option 'unapplied' is a specified, only deletes until
856 this object's 'unapplied' value is >= the specified amount.
857 (Deletes in order returned by L</cust_bill_pay>.)
861 sub delete_cust_bill_pay {
865 local $SIG{HUP} = 'IGNORE';
866 local $SIG{INT} = 'IGNORE';
867 local $SIG{QUIT} = 'IGNORE';
868 local $SIG{TERM} = 'IGNORE';
869 local $SIG{TSTP} = 'IGNORE';
870 local $SIG{PIPE} = 'IGNORE';
872 my $oldAutoCommit = $FS::UID::AutoCommit;
873 local $FS::UID::AutoCommit = 0;
876 my $unapplied = $self->unapplied; #only need to look it up once
880 # Maybe we should reverse the order these get deleted in?
881 # ie delete newest first?
882 # keeping consistent with how bop refunds work, for now...
883 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
884 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
885 $unapplied += $cust_bill_pay->amount;
886 $error = $cust_bill_pay->delete;
891 $dbh->rollback if $oldAutoCommit;
895 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
901 Accepts input for creating a new FS::cust_refund object.
902 Unapplies payment from invoices up to the amount of the refund,
903 creates the refund and applies payment to refund. Allows entire
904 process to be handled in one transaction.
906 Causes a fatal error if called on CARD or CHEK payments.
913 die "Cannot call cust_pay->refund on " . $self->payby
914 if grep { $_ eq $self->payby } qw(CARD CHEK);
916 local $SIG{HUP} = 'IGNORE';
917 local $SIG{INT} = 'IGNORE';
918 local $SIG{QUIT} = 'IGNORE';
919 local $SIG{TERM} = 'IGNORE';
920 local $SIG{TSTP} = 'IGNORE';
921 local $SIG{PIPE} = 'IGNORE';
923 my $oldAutoCommit = $FS::UID::AutoCommit;
924 local $FS::UID::AutoCommit = 0;
927 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
930 $dbh->rollback if $oldAutoCommit;
934 $hash->{'paynum'} = $self->paynum;
935 my $new = new FS::cust_refund ( $hash );
936 $error = $new->insert;
939 $dbh->rollback if $oldAutoCommit;
943 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
953 =item batch_insert CUST_PAY_OBJECT, ...
955 Class method which inserts multiple payments. Takes a list of FS::cust_pay
956 objects. Returns a list, each element representing the status of inserting the
957 corresponding payment - empty. If there is an error inserting any payment, the
958 entire transaction is rolled back, i.e. all payments are inserted or none are.
960 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
961 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
962 those objects will be inserted with the paynum of the payment, and for
963 each one, an error message or an empty string will be inserted into the
968 my @errors = FS::cust_pay->batch_insert(@cust_pay);
969 my $num_errors = scalar(grep $_, @errors);
970 if ( $num_errors == 0 ) {
971 #success; all payments were inserted
973 #failure; no payments were inserted.
979 my $self = shift; #class method
981 local $SIG{HUP} = 'IGNORE';
982 local $SIG{INT} = 'IGNORE';
983 local $SIG{QUIT} = 'IGNORE';
984 local $SIG{TERM} = 'IGNORE';
985 local $SIG{TSTP} = 'IGNORE';
986 local $SIG{PIPE} = 'IGNORE';
988 my $oldAutoCommit = $FS::UID::AutoCommit;
989 local $FS::UID::AutoCommit = 0;
995 foreach my $cust_pay (@_) {
996 my $error = $cust_pay->insert( 'manual' => 1 );
997 push @errors, $error;
998 $num_errors++ if $error;
1000 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1002 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1003 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1007 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1008 my $apply_error = $cust_bill_pay->insert;
1009 push @errors, $apply_error || '';
1010 $num_errors++ if $apply_error;
1014 } elsif ( !$error ) { #normal case: apply payments as usual
1015 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1020 if ( $num_errors ) {
1021 $dbh->rollback if $oldAutoCommit;
1023 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1032 Returns an SQL fragment to retreive the unapplied amount.
1037 my ($class, $start, $end) = @_;
1038 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1039 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1040 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1041 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1045 ( SELECT SUM(amount) FROM cust_bill_pay
1046 WHERE cust_pay.paynum = cust_bill_pay.paynum
1047 $bill_start $bill_end )
1051 ( SELECT SUM(amount) FROM cust_pay_refund
1052 WHERE cust_pay.paynum = cust_pay_refund.paynum
1053 $refund_start $refund_end )
1062 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1063 +{ ( map { $_=>$self->$_ } @fields ),
1069 # Used by FS::Upgrade to migrate to a new database.
1073 sub _upgrade_data { #class method
1074 my ($class, %opt) = @_;
1076 warn "$me upgrading $class\n" if $DEBUG;
1078 $class->_upgrade_reasonnum(%opt);
1080 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1083 # otaker/ivan upgrade
1086 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1088 #not the most efficient, but hey, it only has to run once
1090 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1092 AND EXISTS ( SELECT 1 FROM cust_main
1093 WHERE cust_main.custnum = cust_pay.custnum )
1096 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1098 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1099 $sth->execute or die $sth->errstr;
1100 my $total = $sth->fetchrow_arrayref->[0];
1101 #warn "$total cust_pay records to update\n"
1103 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1108 my @cust_pay = qsearch( {
1109 'table' => 'cust_pay',
1111 'extra_sql' => $where,
1112 'order_by' => 'ORDER BY paynum',
1115 foreach my $cust_pay (@cust_pay) {
1117 my $h_cust_pay = $cust_pay->h_search('insert');
1118 if ( $h_cust_pay ) {
1119 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1120 #$cust_pay->otaker($h_cust_pay->history_user);
1121 $cust_pay->set('otaker', $h_cust_pay->history_user);
1123 $cust_pay->set('otaker', 'legacy');
1126 my $error = $cust_pay->replace;
1129 warn " *** WARNING: Error updating order taker for payment paynum ".
1130 $cust_pay->paynun. ": $error\n";
1135 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1136 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1142 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1146 # payinfo N/A upgrade
1149 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1151 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1153 my @na_cust_pay = qsearch( {
1154 'table' => 'cust_pay',
1155 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1156 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1159 foreach my $na ( @na_cust_pay ) {
1161 next unless $na->payinfo eq 'N/A';
1163 my $cust_pay_pending =
1164 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1165 unless ( $cust_pay_pending ) {
1166 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1167 $na->paynum. " (no cust_pay_pending)\n";
1170 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1171 my $error = $na->replace;
1173 warn " *** WARNING: Error updating payinfo for payment paynum ".
1174 $na->paynun. ": $error\n";
1180 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1184 # otaker->usernum upgrade
1187 $class->_upgrade_otaker(%opt);
1189 # if we do this anywhere else, it should become an FS::Upgrade method
1190 my $num_to_upgrade = $class->count('paybatch is not null');
1191 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1192 if ( $num_to_upgrade > 0 ) {
1193 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1194 if ( $opt{queue} ) {
1195 if ( $num_jobs > 0 ) {
1196 warn "Upgrade already queued.\n";
1198 warn "Scheduling upgrade.\n";
1199 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1203 process_upgrade_paybatch();
1208 sub process_upgrade_paybatch {
1210 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1211 local $FS::UID::AutoCommit = 1;
1214 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1216 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1217 my $search = FS::Cursor->new( {
1218 'table' => 'cust_pay',
1219 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1221 while (my $cust_pay = $search->fetch) {
1222 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1223 $cust_pay->set('paybatch' => '');
1224 my $error = $cust_pay->replace;
1225 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1230 # migrate gateway info from the misused 'paybatch' field
1233 # not only cust_pay, but also voided and refunded payments
1234 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1235 local $FS::Record::nowarn_classload=1;
1236 # really inefficient, but again, only has to run once
1237 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1238 my $and_batchnum_is_null =
1239 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1240 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1241 my $search = FS::Cursor->new({
1243 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1244 "AND (paybatch IS NOT NULL ".
1245 "OR (paybatch IS NULL AND auth IS NULL
1246 $and_batchnum_is_null ) )
1247 ORDER BY $pkey DESC"
1249 while ( my $object = $search->fetch ) {
1250 if ( $object->paybatch eq '' ) {
1251 # repair for a previous upgrade that didn't save 'auth'
1252 my $pkey = $object->primary_key;
1253 # find the last history record that had a paybatch value
1255 table => "h_$table",
1257 $pkey => $object->$pkey,
1258 paybatch => { op=>'!=', value=>''},
1259 history_action => 'replace_old',
1261 order_by => 'ORDER BY history_date DESC LIMIT 1',
1264 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1267 # if the paybatch didn't have an auth string, then it's fine
1268 $h->paybatch =~ /:(\w+):/ or next;
1269 # set paybatch to what it was in that record
1270 $object->set('paybatch', $h->paybatch)
1271 # and then upgrade it like the old records
1274 my $parsed = $object->_parse_paybatch;
1275 if (keys %$parsed) {
1276 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1277 $object->set('auth' => $parsed->{authorization});
1278 $object->set('paybatch', '');
1279 my $error = $object->replace;
1280 warn "error parsing CARD/CHEK paybatch fields on $object #".
1281 $object->get($object->primary_key).":\n $error\n"
1286 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1296 =item process_batch_import
1300 sub process_batch_import {
1305 my $custnum = $hash{'custnum'};
1306 my $agentnum = $hash{'agentnum'};
1307 my $agent_custid = $hash{'agent_custid'};
1309 $hash{'_date'} = parse_datetime($hash{'_date'})
1310 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1311 #remove custnum_prefix
1312 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1313 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1316 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1317 && length($1) == $custnum_length
1321 # check agentnum against custnum and
1322 # translate agent_custid into regular custnum
1323 if ($custnum && $agent_custid) {
1324 die "can't specify both custnum and agent_custid\n";
1325 } elsif ($agentnum || $agent_custid) {
1326 # here is the agent virtualization
1327 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1329 $search{'agentnum'} = $agentnum
1331 $search{'agent_custid'} = $agent_custid
1333 $search{'custnum'} = $custnum
1335 my $cust_main = qsearchs({
1336 'table' => 'cust_main',
1337 'hashref' => \%search,
1338 'extra_sql' => $extra_sql,
1340 die "can't find customer with" .
1341 ($agentnum ? " agentnum $agentnum" : '') .
1342 ($custnum ? " custnum $custnum" : '') .
1343 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1345 die "mismatched customer number\n"
1346 if $custnum && ($custnum ne $cust_main->custnum);
1347 $custnum = $cust_main->custnum;
1349 $hash{'custnum'} = $custnum;
1350 delete($hash{'agent_custid'});
1355 'table' => 'cust_pay',
1356 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1357 #agent_custid isn't a cust_pay field, see hash callback
1358 'formats' => { 'simple' =>
1359 [ qw(custnum agent_custid paid payinfo invnum) ] },
1360 'format_types' => { 'simple' => '' }, #force infer from file extension
1361 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1362 'format_hash_callbacks' => { 'simple' => $hashcb },
1363 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1364 'postinsert_callback' => sub {
1365 my $cust_pay = shift;
1366 my $cust_main = $cust_pay->cust_main
1367 or return "can't find customer to which payments apply";
1368 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1370 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1375 FS::Record::process_batch_import( $job, $opt, @_ );
1379 =item batch_import HASHREF
1381 Inserts new payments.
1388 my $fh = $param->{filehandle};
1389 my $format = $param->{'format'};
1391 my $agentnum = $param->{agentnum};
1392 my $_date = $param->{_date};
1393 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1394 my $paybatch = $param->{'paybatch'};
1396 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1397 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1399 # here is the agent virtualization
1400 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1404 if ( $format eq 'simple' ) {
1405 @fields = qw( custnum agent_custid paid payinfo invnum );
1407 } elsif ( $format eq 'extended' ) {
1408 die "unimplemented\n";
1412 die "unknown format $format";
1415 eval "use Text::CSV_XS;";
1418 my $csv = new Text::CSV_XS;
1422 local $SIG{HUP} = 'IGNORE';
1423 local $SIG{INT} = 'IGNORE';
1424 local $SIG{QUIT} = 'IGNORE';
1425 local $SIG{TERM} = 'IGNORE';
1426 local $SIG{TSTP} = 'IGNORE';
1427 local $SIG{PIPE} = 'IGNORE';
1429 my $oldAutoCommit = $FS::UID::AutoCommit;
1430 local $FS::UID::AutoCommit = 0;
1434 while ( defined($line=<$fh>) ) {
1436 $csv->parse($line) or do {
1437 $dbh->rollback if $oldAutoCommit;
1438 return "can't parse: ". $csv->error_input();
1441 my @columns = $csv->fields();
1445 paybatch => $paybatch,
1447 $cust_pay{_date} = $_date if $_date;
1450 foreach my $field ( @fields ) {
1452 if ( $field eq 'agent_custid'
1454 && $columns[0] =~ /\S+/ )
1457 my $agent_custid = $columns[0];
1458 my %hash = ( 'agent_custid' => $agent_custid,
1459 'agentnum' => $agentnum,
1462 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1463 $dbh->rollback if $oldAutoCommit;
1464 return "can't specify custnum with agent_custid $agent_custid";
1467 $cust_main = qsearchs({
1468 'table' => 'cust_main',
1469 'hashref' => \%hash,
1470 'extra_sql' => $extra_sql,
1473 unless ( $cust_main ) {
1474 $dbh->rollback if $oldAutoCommit;
1475 return "can't find customer with agent_custid $agent_custid";
1479 $columns[0] = $cust_main->custnum;
1482 $cust_pay{$field} = shift @columns;
1485 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1486 && length($1) == $custnum_length ) {
1487 $cust_pay{custnum} = $2;
1490 my $custnum = $cust_pay{custnum};
1492 my $cust_pay = new FS::cust_pay( \%cust_pay );
1493 my $error = $cust_pay->insert;
1495 if ( ! $error && $cust_pay->custnum != $custnum ) {
1496 #invnum was defined, and ->insert set custnum to the customer for that
1497 #invoice, but it wasn't the one the import specified.
1498 $dbh->rollback if $oldAutoCommit;
1499 $error = "specified invoice #". $cust_pay{invnum}.
1500 " is for custnum ". $cust_pay->custnum.
1501 ", not specified custnum $custnum";
1505 $dbh->rollback if $oldAutoCommit;
1506 return "can't insert payment for $line: $error";
1509 if ( $format eq 'simple' ) {
1510 # include agentnum for less surprise?
1511 $cust_main = qsearchs({
1512 'table' => 'cust_main',
1513 'hashref' => { 'custnum' => $cust_pay->custnum },
1514 'extra_sql' => $extra_sql,
1518 unless ( $cust_main ) {
1519 $dbh->rollback if $oldAutoCommit;
1520 return "can't find customer to which payments apply at line: $line";
1523 $error = $cust_main->apply_payments_and_credits;
1525 $dbh->rollback if $oldAutoCommit;
1526 return "can't apply payments to customer for $line: $error";
1534 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1536 return "Empty file!" unless $imported;
1546 Delete and replace methods.
1550 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1551 schema.html from the base documentation.