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;
912 =item batch_insert CUST_PAY_OBJECT, ...
914 Class method which inserts multiple payments. Takes a list of FS::cust_pay
915 objects. Returns a list, each element representing the status of inserting the
916 corresponding payment - empty. If there is an error inserting any payment, the
917 entire transaction is rolled back, i.e. all payments are inserted or none are.
919 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
920 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
921 those objects will be inserted with the paynum of the payment, and for
922 each one, an error message or an empty string will be inserted into the
927 my @errors = FS::cust_pay->batch_insert(@cust_pay);
928 my $num_errors = scalar(grep $_, @errors);
929 if ( $num_errors == 0 ) {
930 #success; all payments were inserted
932 #failure; no payments were inserted.
938 my $self = shift; #class method
940 local $SIG{HUP} = 'IGNORE';
941 local $SIG{INT} = 'IGNORE';
942 local $SIG{QUIT} = 'IGNORE';
943 local $SIG{TERM} = 'IGNORE';
944 local $SIG{TSTP} = 'IGNORE';
945 local $SIG{PIPE} = 'IGNORE';
947 my $oldAutoCommit = $FS::UID::AutoCommit;
948 local $FS::UID::AutoCommit = 0;
954 foreach my $cust_pay (@_) {
955 my $error = $cust_pay->insert( 'manual' => 1 );
956 push @errors, $error;
957 $num_errors++ if $error;
959 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
961 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
962 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
966 $cust_bill_pay->set('paynum', $cust_pay->paynum);
967 my $apply_error = $cust_bill_pay->insert;
968 push @errors, $apply_error || '';
969 $num_errors++ if $apply_error;
973 } elsif ( !$error ) { #normal case: apply payments as usual
974 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
980 $dbh->rollback if $oldAutoCommit;
982 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
991 Returns an SQL fragment to retreive the unapplied amount.
996 my ($class, $start, $end) = @_;
997 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
998 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
999 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1000 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1004 ( SELECT SUM(amount) FROM cust_bill_pay
1005 WHERE cust_pay.paynum = cust_bill_pay.paynum
1006 $bill_start $bill_end )
1010 ( SELECT SUM(amount) FROM cust_pay_refund
1011 WHERE cust_pay.paynum = cust_pay_refund.paynum
1012 $refund_start $refund_end )
1021 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1022 +{ ( map { $_=>$self->$_ } @fields ),
1028 # Used by FS::Upgrade to migrate to a new database.
1032 sub _upgrade_data { #class method
1033 my ($class, %opt) = @_;
1035 warn "$me upgrading $class\n" if $DEBUG;
1037 $class->_upgrade_reasonnum(%opt);
1039 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1042 # otaker/ivan upgrade
1045 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1047 #not the most efficient, but hey, it only has to run once
1049 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1051 AND EXISTS ( SELECT 1 FROM cust_main
1052 WHERE cust_main.custnum = cust_pay.custnum )
1055 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1057 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1058 $sth->execute or die $sth->errstr;
1059 my $total = $sth->fetchrow_arrayref->[0];
1060 #warn "$total cust_pay records to update\n"
1062 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1067 my @cust_pay = qsearch( {
1068 'table' => 'cust_pay',
1070 'extra_sql' => $where,
1071 'order_by' => 'ORDER BY paynum',
1074 foreach my $cust_pay (@cust_pay) {
1076 my $h_cust_pay = $cust_pay->h_search('insert');
1077 if ( $h_cust_pay ) {
1078 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1079 #$cust_pay->otaker($h_cust_pay->history_user);
1080 $cust_pay->set('otaker', $h_cust_pay->history_user);
1082 $cust_pay->set('otaker', 'legacy');
1085 my $error = $cust_pay->replace;
1088 warn " *** WARNING: Error updating order taker for payment paynum ".
1089 $cust_pay->paynun. ": $error\n";
1094 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1095 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1101 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1105 # payinfo N/A upgrade
1108 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1110 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1112 my @na_cust_pay = qsearch( {
1113 'table' => 'cust_pay',
1114 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1115 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1118 foreach my $na ( @na_cust_pay ) {
1120 next unless $na->payinfo eq 'N/A';
1122 my $cust_pay_pending =
1123 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1124 unless ( $cust_pay_pending ) {
1125 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1126 $na->paynum. " (no cust_pay_pending)\n";
1129 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1130 my $error = $na->replace;
1132 warn " *** WARNING: Error updating payinfo for payment paynum ".
1133 $na->paynun. ": $error\n";
1139 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1143 # otaker->usernum upgrade
1146 $class->_upgrade_otaker(%opt);
1148 # if we do this anywhere else, it should become an FS::Upgrade method
1149 my $num_to_upgrade = $class->count('paybatch is not null');
1150 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1151 if ( $num_to_upgrade > 0 ) {
1152 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1153 if ( $opt{queue} ) {
1154 if ( $num_jobs > 0 ) {
1155 warn "Upgrade already queued.\n";
1157 warn "Scheduling upgrade.\n";
1158 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1162 process_upgrade_paybatch();
1167 sub process_upgrade_paybatch {
1169 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1170 local $FS::UID::AutoCommit = 1;
1173 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1175 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1176 my $search = FS::Cursor->new( {
1177 'table' => 'cust_pay',
1178 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1180 while (my $cust_pay = $search->fetch) {
1181 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1182 $cust_pay->set('paybatch' => '');
1183 my $error = $cust_pay->replace;
1184 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1189 # migrate gateway info from the misused 'paybatch' field
1192 # not only cust_pay, but also voided and refunded payments
1193 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1194 local $FS::Record::nowarn_classload=1;
1195 # really inefficient, but again, only has to run once
1196 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1197 my $and_batchnum_is_null =
1198 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1199 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1200 my $search = FS::Cursor->new({
1202 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1203 "AND (paybatch IS NOT NULL ".
1204 "OR (paybatch IS NULL AND auth IS NULL
1205 $and_batchnum_is_null ) )
1206 ORDER BY $pkey DESC"
1208 while ( my $object = $search->fetch ) {
1209 if ( $object->paybatch eq '' ) {
1210 # repair for a previous upgrade that didn't save 'auth'
1211 my $pkey = $object->primary_key;
1212 # find the last history record that had a paybatch value
1214 table => "h_$table",
1216 $pkey => $object->$pkey,
1217 paybatch => { op=>'!=', value=>''},
1218 history_action => 'replace_old',
1220 order_by => 'ORDER BY history_date DESC LIMIT 1',
1223 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1226 # if the paybatch didn't have an auth string, then it's fine
1227 $h->paybatch =~ /:(\w+):/ or next;
1228 # set paybatch to what it was in that record
1229 $object->set('paybatch', $h->paybatch)
1230 # and then upgrade it like the old records
1233 my $parsed = $object->_parse_paybatch;
1234 if (keys %$parsed) {
1235 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1236 $object->set('auth' => $parsed->{authorization});
1237 $object->set('paybatch', '');
1238 my $error = $object->replace;
1239 warn "error parsing CARD/CHEK paybatch fields on $object #".
1240 $object->get($object->primary_key).":\n $error\n"
1245 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1255 =item process_batch_import
1259 sub process_batch_import {
1264 my $custnum = $hash{'custnum'};
1265 my $agentnum = $hash{'agentnum'};
1266 my $agent_custid = $hash{'agent_custid'};
1268 $hash{'_date'} = parse_datetime($hash{'_date'})
1269 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1270 #remove custnum_prefix
1271 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1272 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1275 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1276 && length($1) == $custnum_length
1280 # check agentnum against custnum and
1281 # translate agent_custid into regular custnum
1282 if ($custnum && $agent_custid) {
1283 die "can't specify both custnum and agent_custid\n";
1284 } elsif ($agentnum || $agent_custid) {
1285 # here is the agent virtualization
1286 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1288 $search{'agentnum'} = $agentnum
1290 $search{'agent_custid'} = $agent_custid
1292 $search{'custnum'} = $custnum
1294 my $cust_main = qsearchs({
1295 'table' => 'cust_main',
1296 'hashref' => \%search,
1297 'extra_sql' => $extra_sql,
1299 die "can't find customer with" .
1300 ($agentnum ? " agentnum $agentnum" : '') .
1301 ($custnum ? " custnum $custnum" : '') .
1302 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1304 die "mismatched customer number\n"
1305 if $custnum && ($custnum ne $cust_main->custnum);
1306 $custnum = $cust_main->custnum;
1308 $hash{'custnum'} = $custnum;
1309 delete($hash{'agent_custid'});
1314 'table' => 'cust_pay',
1315 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1316 #agent_custid isn't a cust_pay field, see hash callback
1317 'formats' => { 'simple' =>
1318 [ qw(custnum agent_custid paid payinfo invnum) ] },
1319 'format_types' => { 'simple' => '' }, #force infer from file extension
1320 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1321 'format_hash_callbacks' => { 'simple' => $hashcb },
1322 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1323 'postinsert_callback' => sub {
1324 my $cust_pay = shift;
1325 my $cust_main = $cust_pay->cust_main
1326 or return "can't find customer to which payments apply";
1327 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1329 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1334 FS::Record::process_batch_import( $job, $opt, @_ );
1338 =item batch_import HASHREF
1340 Inserts new payments.
1347 my $fh = $param->{filehandle};
1348 my $format = $param->{'format'};
1350 my $agentnum = $param->{agentnum};
1351 my $_date = $param->{_date};
1352 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1353 my $paybatch = $param->{'paybatch'};
1355 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1356 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1358 # here is the agent virtualization
1359 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1363 if ( $format eq 'simple' ) {
1364 @fields = qw( custnum agent_custid paid payinfo invnum );
1366 } elsif ( $format eq 'extended' ) {
1367 die "unimplemented\n";
1371 die "unknown format $format";
1374 eval "use Text::CSV_XS;";
1377 my $csv = new Text::CSV_XS;
1381 local $SIG{HUP} = 'IGNORE';
1382 local $SIG{INT} = 'IGNORE';
1383 local $SIG{QUIT} = 'IGNORE';
1384 local $SIG{TERM} = 'IGNORE';
1385 local $SIG{TSTP} = 'IGNORE';
1386 local $SIG{PIPE} = 'IGNORE';
1388 my $oldAutoCommit = $FS::UID::AutoCommit;
1389 local $FS::UID::AutoCommit = 0;
1393 while ( defined($line=<$fh>) ) {
1395 $csv->parse($line) or do {
1396 $dbh->rollback if $oldAutoCommit;
1397 return "can't parse: ". $csv->error_input();
1400 my @columns = $csv->fields();
1404 paybatch => $paybatch,
1406 $cust_pay{_date} = $_date if $_date;
1409 foreach my $field ( @fields ) {
1411 if ( $field eq 'agent_custid'
1413 && $columns[0] =~ /\S+/ )
1416 my $agent_custid = $columns[0];
1417 my %hash = ( 'agent_custid' => $agent_custid,
1418 'agentnum' => $agentnum,
1421 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1422 $dbh->rollback if $oldAutoCommit;
1423 return "can't specify custnum with agent_custid $agent_custid";
1426 $cust_main = qsearchs({
1427 'table' => 'cust_main',
1428 'hashref' => \%hash,
1429 'extra_sql' => $extra_sql,
1432 unless ( $cust_main ) {
1433 $dbh->rollback if $oldAutoCommit;
1434 return "can't find customer with agent_custid $agent_custid";
1438 $columns[0] = $cust_main->custnum;
1441 $cust_pay{$field} = shift @columns;
1444 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1445 && length($1) == $custnum_length ) {
1446 $cust_pay{custnum} = $2;
1449 my $custnum = $cust_pay{custnum};
1451 my $cust_pay = new FS::cust_pay( \%cust_pay );
1452 my $error = $cust_pay->insert;
1454 if ( ! $error && $cust_pay->custnum != $custnum ) {
1455 #invnum was defined, and ->insert set custnum to the customer for that
1456 #invoice, but it wasn't the one the import specified.
1457 $dbh->rollback if $oldAutoCommit;
1458 $error = "specified invoice #". $cust_pay{invnum}.
1459 " is for custnum ". $cust_pay->custnum.
1460 ", not specified custnum $custnum";
1464 $dbh->rollback if $oldAutoCommit;
1465 return "can't insert payment for $line: $error";
1468 if ( $format eq 'simple' ) {
1469 # include agentnum for less surprise?
1470 $cust_main = qsearchs({
1471 'table' => 'cust_main',
1472 'hashref' => { 'custnum' => $cust_pay->custnum },
1473 'extra_sql' => $extra_sql,
1477 unless ( $cust_main ) {
1478 $dbh->rollback if $oldAutoCommit;
1479 return "can't find customer to which payments apply at line: $line";
1482 $error = $cust_main->apply_payments_and_credits;
1484 $dbh->rollback if $oldAutoCommit;
1485 return "can't apply payments to customer for $line: $error";
1493 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1495 return "Empty file!" unless $imported;
1505 Delete and replace methods.
1509 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1510 schema.html from the base documentation.