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 $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
676 unless ($msg_template) {
677 warn "send_receipt could not load msg_template";
681 my $cust_msg = $msg_template->prepare(
682 'cust_main' => $cust_main,
684 'from_config' => 'payment_receipt_from',
685 'substitutions' => \%substitutions,
686 'msgtype' => 'receipt',
688 $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
690 warn "send_receipt: $error";
694 my $queue = new FS::queue {
695 'job' => 'FS::cust_msg::process_send',
696 'paynum' => $self->paynum,
697 'custnum' => $cust_main->custnum,
699 $error = $queue->insert( $cust_msg->custmsgnum );
703 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
707 #not manual and no noemail flag (here or on the customer)
708 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
710 my $queue = new FS::queue {
711 'job' => 'FS::cust_bill::queueable_email',
712 'paynum' => $self->paynum,
713 'custnum' => $cust_main->custnum,
717 'invnum' => $cust_bill->invnum,
721 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
722 $opt{'mode'} = $mode;
724 # backward compatibility, no good fix for this yet as some people may
725 # still have "invoice_latex_statement" and such options
726 $opt{'template'} = 'statement';
727 $opt{'notice_name'} = 'Statement';
730 $error = $queue->insert(%opt);
734 warn "send_receipt: $error\n" if $error;
739 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
746 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
747 sort { $a->_date <=> $b->_date
748 || $a->invnum <=> $b->invnum }
749 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
753 =item cust_pay_refund
755 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
760 sub cust_pay_refund {
762 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
763 sort { $a->_date <=> $b->_date }
764 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
771 Returns the amount of this payment that is still unapplied; which is
772 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
773 applications (see L<FS::cust_pay_refund>).
779 my $amount = $self->paid;
780 $amount -= $_->amount foreach ( $self->cust_bill_pay );
781 $amount -= $_->amount foreach ( $self->cust_pay_refund );
782 sprintf("%.2f", $amount );
787 Returns the amount of this payment that has not been refuned; which is
788 paid minus all refund applications (see L<FS::cust_pay_refund>).
794 my $amount = $self->paid;
795 $amount -= $_->amount foreach ( $self->cust_pay_refund );
796 sprintf("%.2f", $amount );
801 Returns the "paid" field.
810 =item delete_cust_bill_pay OPTIONS
812 Deletes all associated cust_bill_pay records.
814 If option 'unapplied' is a specified, only deletes until
815 this object's 'unapplied' value is >= the specified amount.
816 (Deletes in order returned by L</cust_bill_pay>.)
820 sub delete_cust_bill_pay {
824 local $SIG{HUP} = 'IGNORE';
825 local $SIG{INT} = 'IGNORE';
826 local $SIG{QUIT} = 'IGNORE';
827 local $SIG{TERM} = 'IGNORE';
828 local $SIG{TSTP} = 'IGNORE';
829 local $SIG{PIPE} = 'IGNORE';
831 my $oldAutoCommit = $FS::UID::AutoCommit;
832 local $FS::UID::AutoCommit = 0;
835 my $unapplied = $self->unapplied; #only need to look it up once
839 # Maybe we should reverse the order these get deleted in?
840 # ie delete newest first?
841 # keeping consistent with how bop refunds work, for now...
842 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
843 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
844 $unapplied += $cust_bill_pay->amount;
845 $error = $cust_bill_pay->delete;
850 $dbh->rollback if $oldAutoCommit;
854 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
860 Accepts input for creating a new FS::cust_refund object.
861 Unapplies payment from invoices up to the amount of the refund,
862 creates the refund and applies payment to refund. Allows entire
863 process to be handled in one transaction.
865 Causes a fatal error if called on CARD or CHEK payments.
872 die "Cannot call cust_pay->refund on " . $self->payby
873 if grep { $_ eq $self->payby } qw(CARD CHEK);
875 local $SIG{HUP} = 'IGNORE';
876 local $SIG{INT} = 'IGNORE';
877 local $SIG{QUIT} = 'IGNORE';
878 local $SIG{TERM} = 'IGNORE';
879 local $SIG{TSTP} = 'IGNORE';
880 local $SIG{PIPE} = 'IGNORE';
882 my $oldAutoCommit = $FS::UID::AutoCommit;
883 local $FS::UID::AutoCommit = 0;
886 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
889 $dbh->rollback if $oldAutoCommit;
893 $hash->{'paynum'} = $self->paynum;
894 my $new = new FS::cust_refund ( $hash );
895 $error = $new->insert;
898 $dbh->rollback if $oldAutoCommit;
902 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
908 =item refund_to_unapply
910 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
911 (all currently applied refunds that aren't closed.)
912 Returns empty list if payment itself is closed.
916 sub refund_to_unapply {
918 return () if $self->closed;
920 'table' => 'cust_pay_refund',
921 'hashref' => { 'paynum' => $self->paynum },
922 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
923 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
929 Deletes all objects returned by L</refund_to_unapply>.
936 local $SIG{HUP} = 'IGNORE';
937 local $SIG{INT} = 'IGNORE';
938 local $SIG{QUIT} = 'IGNORE';
939 local $SIG{TERM} = 'IGNORE';
940 local $SIG{TSTP} = 'IGNORE';
941 local $SIG{PIPE} = 'IGNORE';
943 my $oldAutoCommit = $FS::UID::AutoCommit;
944 local $FS::UID::AutoCommit = 0;
946 foreach my $cust_pay_refund ($self->refund_to_unapply) {
947 my $error = $cust_pay_refund->delete;
949 dbh->rollback if $oldAutoCommit;
954 dbh->commit or die dbh->errstr if $oldAutoCommit;
964 =item batch_insert CUST_PAY_OBJECT, ...
966 Class method which inserts multiple payments. Takes a list of FS::cust_pay
967 objects. Returns a list, each element representing the status of inserting the
968 corresponding payment - empty. If there is an error inserting any payment, the
969 entire transaction is rolled back, i.e. all payments are inserted or none are.
971 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
972 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
973 those objects will be inserted with the paynum of the payment, and for
974 each one, an error message or an empty string will be inserted into the
979 my @errors = FS::cust_pay->batch_insert(@cust_pay);
980 my $num_errors = scalar(grep $_, @errors);
981 if ( $num_errors == 0 ) {
982 #success; all payments were inserted
984 #failure; no payments were inserted.
990 my $self = shift; #class method
992 local $SIG{HUP} = 'IGNORE';
993 local $SIG{INT} = 'IGNORE';
994 local $SIG{QUIT} = 'IGNORE';
995 local $SIG{TERM} = 'IGNORE';
996 local $SIG{TSTP} = 'IGNORE';
997 local $SIG{PIPE} = 'IGNORE';
999 my $oldAutoCommit = $FS::UID::AutoCommit;
1000 local $FS::UID::AutoCommit = 0;
1006 foreach my $cust_pay (@_) {
1007 my $error = $cust_pay->insert( 'manual' => 1 );
1008 push @errors, $error;
1009 $num_errors++ if $error;
1011 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1013 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1014 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1018 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1019 my $apply_error = $cust_bill_pay->insert;
1020 push @errors, $apply_error || '';
1021 $num_errors++ if $apply_error;
1025 } elsif ( !$error ) { #normal case: apply payments as usual
1026 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1031 if ( $num_errors ) {
1032 $dbh->rollback if $oldAutoCommit;
1034 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1043 Returns an SQL fragment to retreive the unapplied amount.
1048 my ($class, $start, $end) = @_;
1049 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1050 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1051 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1052 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1056 ( SELECT SUM(amount) FROM cust_bill_pay
1057 WHERE cust_pay.paynum = cust_bill_pay.paynum
1058 $bill_start $bill_end )
1062 ( SELECT SUM(amount) FROM cust_pay_refund
1063 WHERE cust_pay.paynum = cust_pay_refund.paynum
1064 $refund_start $refund_end )
1073 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1074 +{ ( map { $_=>$self->$_ } @fields ),
1080 # Used by FS::Upgrade to migrate to a new database.
1084 sub _upgrade_data { #class method
1085 my ($class, %opt) = @_;
1087 warn "$me upgrading $class\n" if $DEBUG;
1089 $class->_upgrade_reasonnum(%opt);
1091 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1094 # otaker/ivan upgrade
1097 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1099 #not the most efficient, but hey, it only has to run once
1101 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1103 AND EXISTS ( SELECT 1 FROM cust_main
1104 WHERE cust_main.custnum = cust_pay.custnum )
1107 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1109 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1110 $sth->execute or die $sth->errstr;
1111 my $total = $sth->fetchrow_arrayref->[0];
1112 #warn "$total cust_pay records to update\n"
1114 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1119 my @cust_pay = qsearch( {
1120 'table' => 'cust_pay',
1122 'extra_sql' => $where,
1123 'order_by' => 'ORDER BY paynum',
1126 foreach my $cust_pay (@cust_pay) {
1128 my $h_cust_pay = $cust_pay->h_search('insert');
1129 if ( $h_cust_pay ) {
1130 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1131 #$cust_pay->otaker($h_cust_pay->history_user);
1132 $cust_pay->set('otaker', $h_cust_pay->history_user);
1134 $cust_pay->set('otaker', 'legacy');
1137 my $error = $cust_pay->replace;
1140 warn " *** WARNING: Error updating order taker for payment paynum ".
1141 $cust_pay->paynun. ": $error\n";
1146 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1147 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1153 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1157 # payinfo N/A upgrade
1160 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1162 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1164 my @na_cust_pay = qsearch( {
1165 'table' => 'cust_pay',
1166 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1167 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1170 foreach my $na ( @na_cust_pay ) {
1172 next unless $na->payinfo eq 'N/A';
1174 my $cust_pay_pending =
1175 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1176 unless ( $cust_pay_pending ) {
1177 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1178 $na->paynum. " (no cust_pay_pending)\n";
1181 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1182 my $error = $na->replace;
1184 warn " *** WARNING: Error updating payinfo for payment paynum ".
1185 $na->paynun. ": $error\n";
1191 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1195 # otaker->usernum upgrade
1198 $class->_upgrade_otaker(%opt);
1200 # if we do this anywhere else, it should become an FS::Upgrade method
1201 my $num_to_upgrade = $class->count('paybatch is not null');
1202 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1203 if ( $num_to_upgrade > 0 ) {
1204 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1205 if ( $opt{queue} ) {
1206 if ( $num_jobs > 0 ) {
1207 warn "Upgrade already queued.\n";
1209 warn "Scheduling upgrade.\n";
1210 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1214 process_upgrade_paybatch();
1219 sub process_upgrade_paybatch {
1221 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1222 local $FS::UID::AutoCommit = 1;
1225 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1227 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1228 my $search = FS::Cursor->new( {
1229 'table' => 'cust_pay',
1230 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1232 while (my $cust_pay = $search->fetch) {
1233 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1234 $cust_pay->set('paybatch' => '');
1235 my $error = $cust_pay->replace;
1236 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1241 # migrate gateway info from the misused 'paybatch' field
1244 # not only cust_pay, but also voided and refunded payments
1245 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1246 local $FS::Record::nowarn_classload=1;
1247 # really inefficient, but again, only has to run once
1248 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1249 my $and_batchnum_is_null =
1250 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1251 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1252 my $search = FS::Cursor->new({
1254 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1255 "AND (paybatch IS NOT NULL ".
1256 "OR (paybatch IS NULL AND auth IS NULL
1257 $and_batchnum_is_null ) )
1258 ORDER BY $pkey DESC"
1260 while ( my $object = $search->fetch ) {
1261 if ( $object->paybatch eq '' ) {
1262 # repair for a previous upgrade that didn't save 'auth'
1263 my $pkey = $object->primary_key;
1264 # find the last history record that had a paybatch value
1266 table => "h_$table",
1268 $pkey => $object->$pkey,
1269 paybatch => { op=>'!=', value=>''},
1270 history_action => 'replace_old',
1272 order_by => 'ORDER BY history_date DESC LIMIT 1',
1275 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1278 # if the paybatch didn't have an auth string, then it's fine
1279 $h->paybatch =~ /:(\w+):/ or next;
1280 # set paybatch to what it was in that record
1281 $object->set('paybatch', $h->paybatch)
1282 # and then upgrade it like the old records
1285 my $parsed = $object->_parse_paybatch;
1286 if (keys %$parsed) {
1287 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1288 $object->set('auth' => $parsed->{authorization});
1289 $object->set('paybatch', '');
1290 my $error = $object->replace;
1291 warn "error parsing CARD/CHEK paybatch fields on $object #".
1292 $object->get($object->primary_key).":\n $error\n"
1297 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1307 =item process_batch_import
1311 sub process_batch_import {
1316 my $custnum = $hash{'custnum'};
1317 my $agentnum = $hash{'agentnum'};
1318 my $agent_custid = $hash{'agent_custid'};
1320 $hash{'_date'} = parse_datetime($hash{'_date'})
1321 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1322 #remove custnum_prefix
1323 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1324 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1327 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1328 && length($1) == $custnum_length
1332 # check agentnum against custnum and
1333 # translate agent_custid into regular custnum
1334 if ($custnum && $agent_custid) {
1335 die "can't specify both custnum and agent_custid\n";
1336 } elsif ($agentnum || $agent_custid) {
1337 # here is the agent virtualization
1338 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1340 $search{'agentnum'} = $agentnum
1342 $search{'agent_custid'} = $agent_custid
1344 $search{'custnum'} = $custnum
1346 my $cust_main = qsearchs({
1347 'table' => 'cust_main',
1348 'hashref' => \%search,
1349 'extra_sql' => $extra_sql,
1351 die "can't find customer with" .
1352 ($agentnum ? " agentnum $agentnum" : '') .
1353 ($custnum ? " custnum $custnum" : '') .
1354 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1356 die "mismatched customer number\n"
1357 if $custnum && ($custnum ne $cust_main->custnum);
1358 $custnum = $cust_main->custnum;
1360 $hash{'custnum'} = $custnum;
1361 delete($hash{'agent_custid'});
1366 'table' => 'cust_pay',
1367 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1368 #agent_custid isn't a cust_pay field, see hash callback
1369 'formats' => { 'simple' =>
1370 [ qw(custnum agent_custid paid payinfo invnum) ] },
1371 'format_types' => { 'simple' => '' }, #force infer from file extension
1372 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1373 'format_hash_callbacks' => { 'simple' => $hashcb },
1374 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1375 'postinsert_callback' => sub {
1376 my $cust_pay = shift;
1377 my $cust_main = $cust_pay->cust_main
1378 or return "can't find customer to which payments apply";
1379 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1381 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1386 FS::Record::process_batch_import( $job, $opt, @_ );
1390 =item batch_import HASHREF
1392 Inserts new payments.
1399 my $fh = $param->{filehandle};
1400 my $format = $param->{'format'};
1402 my $agentnum = $param->{agentnum};
1403 my $_date = $param->{_date};
1404 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1405 my $paybatch = $param->{'paybatch'};
1407 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1408 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1410 # here is the agent virtualization
1411 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1415 if ( $format eq 'simple' ) {
1416 @fields = qw( custnum agent_custid paid payinfo invnum );
1418 } elsif ( $format eq 'extended' ) {
1419 die "unimplemented\n";
1423 die "unknown format $format";
1426 eval "use Text::CSV_XS;";
1429 my $csv = new Text::CSV_XS;
1433 local $SIG{HUP} = 'IGNORE';
1434 local $SIG{INT} = 'IGNORE';
1435 local $SIG{QUIT} = 'IGNORE';
1436 local $SIG{TERM} = 'IGNORE';
1437 local $SIG{TSTP} = 'IGNORE';
1438 local $SIG{PIPE} = 'IGNORE';
1440 my $oldAutoCommit = $FS::UID::AutoCommit;
1441 local $FS::UID::AutoCommit = 0;
1445 while ( defined($line=<$fh>) ) {
1447 $csv->parse($line) or do {
1448 $dbh->rollback if $oldAutoCommit;
1449 return "can't parse: ". $csv->error_input();
1452 my @columns = $csv->fields();
1456 paybatch => $paybatch,
1458 $cust_pay{_date} = $_date if $_date;
1461 foreach my $field ( @fields ) {
1463 if ( $field eq 'agent_custid'
1465 && $columns[0] =~ /\S+/ )
1468 my $agent_custid = $columns[0];
1469 my %hash = ( 'agent_custid' => $agent_custid,
1470 'agentnum' => $agentnum,
1473 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1474 $dbh->rollback if $oldAutoCommit;
1475 return "can't specify custnum with agent_custid $agent_custid";
1478 $cust_main = qsearchs({
1479 'table' => 'cust_main',
1480 'hashref' => \%hash,
1481 'extra_sql' => $extra_sql,
1484 unless ( $cust_main ) {
1485 $dbh->rollback if $oldAutoCommit;
1486 return "can't find customer with agent_custid $agent_custid";
1490 $columns[0] = $cust_main->custnum;
1493 $cust_pay{$field} = shift @columns;
1496 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1497 && length($1) == $custnum_length ) {
1498 $cust_pay{custnum} = $2;
1501 my $custnum = $cust_pay{custnum};
1503 my $cust_pay = new FS::cust_pay( \%cust_pay );
1504 my $error = $cust_pay->insert;
1506 if ( ! $error && $cust_pay->custnum != $custnum ) {
1507 #invnum was defined, and ->insert set custnum to the customer for that
1508 #invoice, but it wasn't the one the import specified.
1509 $dbh->rollback if $oldAutoCommit;
1510 $error = "specified invoice #". $cust_pay{invnum}.
1511 " is for custnum ". $cust_pay->custnum.
1512 ", not specified custnum $custnum";
1516 $dbh->rollback if $oldAutoCommit;
1517 return "can't insert payment for $line: $error";
1520 if ( $format eq 'simple' ) {
1521 # include agentnum for less surprise?
1522 $cust_main = qsearchs({
1523 'table' => 'cust_main',
1524 'hashref' => { 'custnum' => $cust_pay->custnum },
1525 'extra_sql' => $extra_sql,
1529 unless ( $cust_main ) {
1530 $dbh->rollback if $oldAutoCommit;
1531 return "can't find customer to which payments apply at line: $line";
1534 $error = $cust_main->apply_payments_and_credits;
1536 $dbh->rollback if $oldAutoCommit;
1537 return "can't apply payments to customer for $line: $error";
1545 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1547 return "Empty file!" unless $imported;
1557 Delete and replace methods.
1561 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1562 schema.html from the base documentation.