4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
6 use vars qw( $DEBUG $me $conf @encrypted_fields
7 $unsuspendauto $ignore_noapply
10 use Business::CreditCard;
12 use FS::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;
30 $me = '[FS::cust_pay]';
34 #ask FS::UID to run this stuff for us later
35 FS::UID->install_callback( sub {
37 $unsuspendauto = $conf->exists('unsuspendauto');
40 @encrypted_fields = ('payinfo');
41 sub nohistory_fields { ('payinfo'); }
45 FS::cust_pay - Object methods for cust_pay objects
51 $record = new FS::cust_pay \%hash;
52 $record = new FS::cust_pay { 'column' => 'value' };
54 $error = $record->insert;
56 $error = $new_record->replace($old_record);
58 $error = $record->delete;
60 $error = $record->check;
64 An FS::cust_pay object represents a payment; the transfer of money from a
65 customer. FS::cust_pay inherits from FS::Record. The following fields are
72 primary key (assigned automatically for new payments)
76 customer (see L<FS::cust_main>)
80 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
81 L<Time::Local> and L<Date::Parse> for conversion functions.
85 Amount of this payment
89 order taker (see L<FS::access_user>)
93 Payment Type (See L<FS::payinfo_Mixin> for valid values)
97 Payment Information (See L<FS::payinfo_Mixin> for data format)
101 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
105 obsolete text field for tracking card processing or other batch grouping
109 Optional unique identifer to prevent duplicate transactions.
113 books closed flag, empty or `Y'
117 Desired pkgnum when using experimental package balances.
121 Flag to only allow manual application of payment, empty or 'Y'
125 The bank where the payment was deposited.
129 The name of the depositor.
133 The deposit account number.
141 The number of the batch this payment came from (see L<FS::pay_batch>),
142 or null if it was processed through a realtime gateway or entered manually.
146 The number of the realtime or batch gateway L<FS::payment_gateway>) this
147 payment was processed through. Null if it was entered manually or processed
148 by the "system default" gateway, which doesn't have a number.
152 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
153 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
154 redundant with C<gatewaynum>.
158 The authorization number returned by the credit card network.
162 The transaction ID returned by the gateway, if any. This is usually what
163 you would use to initiate a void or refund of the payment.
173 Creates a new payment. To add the payment to the databse, see L<"insert">.
177 sub table { 'cust_pay'; }
178 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
179 sub cust_unlinked_msg {
181 "WARNING: can't find cust_main.custnum ". $self->custnum.
182 ' (cust_pay.paynum '. $self->paynum. ')';
185 =item insert [ OPTION => VALUE ... ]
187 Adds this payment to the database.
189 For backwards-compatibility and convenience, if the additional field invnum
190 is defined, an FS::cust_bill_pay record for the full amount of the payment
191 will be created. In this case, custnum is optional.
193 If the additional field discount_term is defined then a prepayment discount
194 is taken for that length of time. It is an error for the customer to owe
195 after this payment is made.
197 A hash of optional arguments may be passed. The following arguments are
204 If true, a payment receipt is sent instead of a statement when
205 'payment_receipt_email' configuration option is set.
207 About the "manual" flag: Normally, if the 'payment_receipt' config option
208 is set, and the customer has an invoice email address, inserting a payment
209 causes a I<statement> to be emailed to the customer. If the payment is
210 considered "manual" (or if the customer has no invoices), then it will
211 instead send a I<payment receipt>. "manual" should be true whenever a
212 payment is created directly from the web interface, from a user-initiated
213 realtime payment, or from a third-party payment via self-service. It should
214 be I<false> when creating a payment from a billing event or from a batch.
218 Don't send an email receipt. (Note: does not currently work when
219 payment_receipt-trigger is set to something other than default / cust_bill)
226 my($self, %options) = @_;
228 local $SIG{HUP} = 'IGNORE';
229 local $SIG{INT} = 'IGNORE';
230 local $SIG{QUIT} = 'IGNORE';
231 local $SIG{TERM} = 'IGNORE';
232 local $SIG{TSTP} = 'IGNORE';
233 local $SIG{PIPE} = 'IGNORE';
235 my $oldAutoCommit = $FS::UID::AutoCommit;
236 local $FS::UID::AutoCommit = 0;
240 if ( $self->invnum ) {
241 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
243 $dbh->rollback if $oldAutoCommit;
244 return "Unknown cust_bill.invnum: ". $self->invnum;
246 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
247 $dbh->rollback if $oldAutoCommit;
248 return "Invoice custnum ".$cust_bill->custnum
249 ." does not match specified custnum ".$self->custnum
250 ." for invoice ".$self->invnum;
252 $self->custnum($cust_bill->custnum );
255 my $error = $self->check;
256 return $error if $error;
258 my $cust_main = $self->cust_main;
259 my $old_balance = $cust_main->balance;
261 $error = $self->SUPER::insert;
263 $dbh->rollback if $oldAutoCommit;
264 return "error inserting cust_pay: $error";
267 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
268 if ( my $months = $self->discount_term ) {
269 # XXX this should be moved out somewhere, but discount_term_values
271 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
272 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
274 # %billing_pkgs contains this customer's active monthly packages.
275 # Recurring fees for those packages will be credited and then rebilled
276 # for the full discount term. Other packages on the last invoice
277 # (canceled, non-monthly recurring, or one-time charges) will be
279 my %billing_pkgs = map { $_->pkgnum => $_ }
280 grep { $_->part_pkg->freq eq '1' }
281 $cust_main->billing_pkgs;
282 my $credit = 0; # sum of recurring charges from that invoice
283 my $last_bill_date = 0; # the real bill date
284 foreach my $item ( $cust_bill->cust_bill_pkg ) {
285 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
286 $credit += $item->recur;
287 $last_bill_date = $item->cust_pkg->last_bill
288 if defined($item->cust_pkg)
289 and $item->cust_pkg->last_bill > $last_bill_date
292 my $cust_credit = new FS::cust_credit {
293 'custnum' => $self->custnum,
294 'amount' => sprintf('%.2f', $credit),
295 'reason' => 'customer chose to prepay for discount',
297 $error = $cust_credit->insert('reason_type' => $credit_type);
299 $dbh->rollback if $oldAutoCommit;
300 return "error inserting prepayment credit: $error";
304 # bill for the entire term
305 $_->bill($_->last_bill) foreach (values %billing_pkgs);
306 $error = $cust_main->bill(
307 # no recurring_only, we want unbilled packages with start dates to
309 'no_usage_reset' => 1,
310 'time' => $last_bill_date, # not $cust_bill->_date
311 'pkg_list' => [ values %billing_pkgs ],
312 'freq_override' => $months,
315 $dbh->rollback if $oldAutoCommit;
316 return "error inserting cust_pay: $error";
318 $error = $cust_main->apply_payments_and_credits;
320 $dbh->rollback if $oldAutoCommit;
321 return "error inserting cust_pay: $error";
323 my $new_balance = $cust_main->balance;
324 if ($new_balance > 0) {
325 $dbh->rollback if $oldAutoCommit;
326 return "balance after prepay discount attempt: $new_balance";
328 # user friendly: override the "apply only to this invoice" mode
335 if ( $self->invnum ) {
336 my $cust_bill_pay = new FS::cust_bill_pay {
337 'invnum' => $self->invnum,
338 'paynum' => $self->paynum,
339 'amount' => $self->paid,
340 '_date' => $self->_date,
342 $error = $cust_bill_pay->insert(%options);
344 if ( $ignore_noapply ) {
345 warn "warning: error inserting cust_bill_pay: $error ".
346 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
348 $dbh->rollback if $oldAutoCommit;
349 return "error inserting cust_bill_pay: $error";
354 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
356 #false laziness w/ cust_credit::insert
357 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
358 my @errors = $cust_main->unsuspend;
360 # side-fx with nested transactions? upstack rolls back?
361 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
367 #bill setup fees for voip_cdr bill_every_call packages
368 #some false laziness w/search in freeside-cdrd
370 'LEFT JOIN part_pkg USING ( pkgpart ) '.
371 "LEFT JOIN part_pkg_option
372 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
373 AND part_pkg_option.optionname = 'bill_every_call' )";
375 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
376 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
378 my @cust_pkg = qsearch({
379 'table' => 'cust_pkg',
380 'addl_from' => $addl_from,
381 'hashref' => { 'custnum' => $self->custnum,
385 'extra_sql' => $extra_sql,
389 warn "voip_cdr bill_every_call packages found; billing customer\n";
390 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
392 warn "WARNING: Error billing customer: $bill_error\n";
395 #end of billing setup fees for voip_cdr bill_every_call packages
397 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
400 my $trigger = $conf->config('payment_receipt-trigger',
401 $self->cust_main->agentnum) || 'cust_pay';
402 if ( $trigger eq 'cust_pay' ) {
403 my $error = $self->send_receipt(
404 'manual' => $options{'manual'},
405 'noemail' => $options{'noemail'},
406 'cust_bill' => $cust_bill,
407 'cust_main' => $cust_main,
409 warn "can't send payment receipt/statement: $error" if $error;
412 #run payment events immediately
413 my $due_cust_event = $self->cust_main->due_cust_event(
414 'eventtable' => 'cust_pay',
415 'objects' => [ $self ],
417 if ( !ref($due_cust_event) ) {
418 warn "Error searching for cust_pay billing events: $due_cust_event\n";
420 foreach my $cust_event (@$due_cust_event) {
421 next unless $cust_event->test_conditions;
422 if ( my $error = $cust_event->do_event() ) {
423 warn "Error running cust_pay billing event: $error\n";
432 =item void [ REASON ]
434 Voids this payment: deletes the payment and all associated applications and
435 adds a record of the voided payment to the FS::cust_pay_void table.
442 local $SIG{HUP} = 'IGNORE';
443 local $SIG{INT} = 'IGNORE';
444 local $SIG{QUIT} = 'IGNORE';
445 local $SIG{TERM} = 'IGNORE';
446 local $SIG{TSTP} = 'IGNORE';
447 local $SIG{PIPE} = 'IGNORE';
449 my $oldAutoCommit = $FS::UID::AutoCommit;
450 local $FS::UID::AutoCommit = 0;
453 my $cust_pay_void = new FS::cust_pay_void ( {
454 map { $_ => $self->get($_) } $self->fields
456 $cust_pay_void->reason(shift) if scalar(@_);
457 my $error = $cust_pay_void->insert;
459 my $cust_pay_pending =
460 qsearchs('cust_pay_pending', { paynum => $self->paynum });
461 if ( $cust_pay_pending ) {
462 $cust_pay_pending->set('void_paynum', $self->paynum);
463 $cust_pay_pending->set('paynum', '');
464 $error ||= $cust_pay_pending->replace;
467 $error ||= $self->delete;
470 $dbh->rollback if $oldAutoCommit;
474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
482 Unless the closed flag is set, deletes this payment and all associated
483 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
484 cases, you want to use the void method instead to leave a record of the
489 # very similar to FS::cust_credit::delete
492 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
494 local $SIG{HUP} = 'IGNORE';
495 local $SIG{INT} = 'IGNORE';
496 local $SIG{QUIT} = 'IGNORE';
497 local $SIG{TERM} = 'IGNORE';
498 local $SIG{TSTP} = 'IGNORE';
499 local $SIG{PIPE} = 'IGNORE';
501 my $oldAutoCommit = $FS::UID::AutoCommit;
502 local $FS::UID::AutoCommit = 0;
505 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
506 my $error = $app->delete;
508 $dbh->rollback if $oldAutoCommit;
513 my $error = $self->SUPER::delete(@_);
515 $dbh->rollback if $oldAutoCommit;
519 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
525 =item replace [ OLD_RECORD ]
527 You can, but probably shouldn't modify payments...
529 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
530 supplied, replaces this record. If there is an error, returns the error,
531 otherwise returns false.
537 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
538 $self->SUPER::replace(@_);
543 Checks all fields to make sure this is a valid payment. If there is an error,
544 returns the error, otherwise returns false. Called by the insert method.
551 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
554 $self->ut_numbern('paynum')
555 || $self->ut_numbern('custnum')
556 || $self->ut_numbern('_date')
557 || $self->ut_money('paid')
558 || $self->ut_alphan('otaker')
559 || $self->ut_textn('paybatch')
560 || $self->ut_textn('payunique')
561 || $self->ut_enum('closed', [ '', 'Y' ])
562 || $self->ut_flag('no_auto_apply')
563 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
564 || $self->ut_textn('bank')
565 || $self->ut_alphan('depositor')
566 || $self->ut_numbern('account')
567 || $self->ut_numbern('teller')
568 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
569 || $self->payinfo_check()
571 return $error if $error;
573 return "paid must be > 0 " if $self->paid <= 0;
575 return "unknown cust_main.custnum: ". $self->custnum
577 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
579 $self->_date(time) unless $self->_date;
581 return "invalid discount_term"
582 if ($self->discount_term && $self->discount_term < 2);
584 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
585 foreach (qw(bank depositor account teller)) {
586 return "$_ required" if $self->get($_) eq '';
590 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
591 # # UNIQUE index should catch this too, without race conditions, but this
592 # # should give a better error message the other 99.9% of the time...
593 # if ( length($self->payunique)
594 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
595 # #well, it *could* be a better error message
596 # return "duplicate transaction".
597 # " - a payment with unique identifer ". $self->payunique.
604 =item send_receipt HASHREF | OPTION => VALUE ...
606 Sends a payment receipt for this payment..
614 Flag indicating the payment is being made manually.
618 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
623 Customer (FS::cust_main) object (for efficiency).
627 Don't send an email receipt.
637 my $opt = ref($_[0]) ? shift : { @_ };
639 my $cust_bill = $opt->{'cust_bill'};
640 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
642 my $conf = new FS::Conf;
644 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
646 my @invoicing_list = $cust_main->invoicing_list_emailonly;
647 return '' unless @invoicing_list;
649 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
653 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
654 #|| ! $conf->exists('invoice_html_statement')
658 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
661 my %substitutions = ();
662 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
664 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
665 unless ($msg_template) {
666 warn "send_receipt could not load msg_template";
670 my $cust_msg = $msg_template->prepare(
671 'cust_main' => $cust_main,
673 'from_config' => 'payment_receipt_from',
674 'substitutions' => \%substitutions,
675 'msgtype' => 'receipt',
677 $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
679 warn "send_receipt: $error";
683 my $queue = new FS::queue {
684 'job' => 'FS::cust_msg::process_send',
685 'paynum' => $self->paynum,
686 'custnum' => $cust_main->custnum,
688 $error = $queue->insert( $cust_msg->custmsgnum );
692 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
696 #not manual and no noemail flag (here or on the customer)
697 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
699 my $queue = new FS::queue {
700 'job' => 'FS::cust_bill::queueable_email',
701 'paynum' => $self->paynum,
702 'custnum' => $cust_main->custnum,
706 'invnum' => $cust_bill->invnum,
710 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
711 $opt{'mode'} = $mode;
713 # backward compatibility, no good fix for this yet as some people may
714 # still have "invoice_latex_statement" and such options
715 $opt{'template'} = 'statement';
716 $opt{'notice_name'} = 'Statement';
719 $error = $queue->insert(%opt);
723 warn "send_receipt: $error\n" if $error;
728 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
735 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
736 sort { $a->_date <=> $b->_date
737 || $a->invnum <=> $b->invnum }
738 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
742 =item cust_pay_refund
744 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
749 sub cust_pay_refund {
751 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
752 sort { $a->_date <=> $b->_date }
753 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
760 Returns the amount of this payment that is still unapplied; which is
761 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
762 applications (see L<FS::cust_pay_refund>).
768 my $amount = $self->paid;
769 $amount -= $_->amount foreach ( $self->cust_bill_pay );
770 $amount -= $_->amount foreach ( $self->cust_pay_refund );
771 sprintf("%.2f", $amount );
776 Returns the amount of this payment that has not been refuned; which is
777 paid minus all refund applications (see L<FS::cust_pay_refund>).
783 my $amount = $self->paid;
784 $amount -= $_->amount foreach ( $self->cust_pay_refund );
785 sprintf("%.2f", $amount );
790 Returns the "paid" field.
799 =item delete_cust_bill_pay OPTIONS
801 Deletes all associated cust_bill_pay records.
803 If option 'unapplied' is a specified, only deletes until
804 this object's 'unapplied' value is >= the specified amount.
805 (Deletes in order returned by L</cust_bill_pay>.)
809 sub delete_cust_bill_pay {
813 local $SIG{HUP} = 'IGNORE';
814 local $SIG{INT} = 'IGNORE';
815 local $SIG{QUIT} = 'IGNORE';
816 local $SIG{TERM} = 'IGNORE';
817 local $SIG{TSTP} = 'IGNORE';
818 local $SIG{PIPE} = 'IGNORE';
820 my $oldAutoCommit = $FS::UID::AutoCommit;
821 local $FS::UID::AutoCommit = 0;
824 my $unapplied = $self->unapplied; #only need to look it up once
828 # Maybe we should reverse the order these get deleted in?
829 # ie delete newest first?
830 # keeping consistent with how bop refunds work, for now...
831 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
832 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
833 $unapplied += $cust_bill_pay->amount;
834 $error = $cust_bill_pay->delete;
839 $dbh->rollback if $oldAutoCommit;
843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
849 Accepts input for creating a new FS::cust_refund object.
850 Unapplies payment from invoices up to the amount of the refund,
851 creates the refund and applies payment to refund. Allows entire
852 process to be handled in one transaction.
854 Causes a fatal error if called on CARD or CHEK payments.
861 die "Cannot call cust_pay->refund on " . $self->payby
862 if grep { $_ eq $self->payby } qw(CARD CHEK);
864 local $SIG{HUP} = 'IGNORE';
865 local $SIG{INT} = 'IGNORE';
866 local $SIG{QUIT} = 'IGNORE';
867 local $SIG{TERM} = 'IGNORE';
868 local $SIG{TSTP} = 'IGNORE';
869 local $SIG{PIPE} = 'IGNORE';
871 my $oldAutoCommit = $FS::UID::AutoCommit;
872 local $FS::UID::AutoCommit = 0;
875 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
878 $dbh->rollback if $oldAutoCommit;
882 $hash->{'paynum'} = $self->paynum;
883 my $new = new FS::cust_refund ( $hash );
884 $error = $new->insert;
887 $dbh->rollback if $oldAutoCommit;
891 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
901 =item batch_insert CUST_PAY_OBJECT, ...
903 Class method which inserts multiple payments. Takes a list of FS::cust_pay
904 objects. Returns a list, each element representing the status of inserting the
905 corresponding payment - empty. If there is an error inserting any payment, the
906 entire transaction is rolled back, i.e. all payments are inserted or none are.
908 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
909 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
910 those objects will be inserted with the paynum of the payment, and for
911 each one, an error message or an empty string will be inserted into the
916 my @errors = FS::cust_pay->batch_insert(@cust_pay);
917 my $num_errors = scalar(grep $_, @errors);
918 if ( $num_errors == 0 ) {
919 #success; all payments were inserted
921 #failure; no payments were inserted.
927 my $self = shift; #class method
929 local $SIG{HUP} = 'IGNORE';
930 local $SIG{INT} = 'IGNORE';
931 local $SIG{QUIT} = 'IGNORE';
932 local $SIG{TERM} = 'IGNORE';
933 local $SIG{TSTP} = 'IGNORE';
934 local $SIG{PIPE} = 'IGNORE';
936 my $oldAutoCommit = $FS::UID::AutoCommit;
937 local $FS::UID::AutoCommit = 0;
943 foreach my $cust_pay (@_) {
944 my $error = $cust_pay->insert( 'manual' => 1 );
945 push @errors, $error;
946 $num_errors++ if $error;
948 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
950 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
951 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
955 $cust_bill_pay->set('paynum', $cust_pay->paynum);
956 my $apply_error = $cust_bill_pay->insert;
957 push @errors, $apply_error || '';
958 $num_errors++ if $apply_error;
962 } elsif ( !$error ) { #normal case: apply payments as usual
963 $cust_pay->cust_main->apply_payments;
969 $dbh->rollback if $oldAutoCommit;
971 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
980 Returns an SQL fragment to retreive the unapplied amount.
985 my ($class, $start, $end) = @_;
986 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
987 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
988 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
989 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
993 ( SELECT SUM(amount) FROM cust_bill_pay
994 WHERE cust_pay.paynum = cust_bill_pay.paynum
995 $bill_start $bill_end )
999 ( SELECT SUM(amount) FROM cust_pay_refund
1000 WHERE cust_pay.paynum = cust_pay_refund.paynum
1001 $refund_start $refund_end )
1010 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1011 +{ ( map { $_=>$self->$_ } @fields ),
1017 # Used by FS::Upgrade to migrate to a new database.
1021 sub _upgrade_data { #class method
1022 my ($class, %opt) = @_;
1024 warn "$me upgrading $class\n" if $DEBUG;
1026 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1029 # otaker/ivan upgrade
1032 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1034 #not the most efficient, but hey, it only has to run once
1036 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1038 AND EXISTS ( SELECT 1 FROM cust_main
1039 WHERE cust_main.custnum = cust_pay.custnum )
1042 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1044 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1045 $sth->execute or die $sth->errstr;
1046 my $total = $sth->fetchrow_arrayref->[0];
1047 #warn "$total cust_pay records to update\n"
1049 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1054 my @cust_pay = qsearch( {
1055 'table' => 'cust_pay',
1057 'extra_sql' => $where,
1058 'order_by' => 'ORDER BY paynum',
1061 foreach my $cust_pay (@cust_pay) {
1063 my $h_cust_pay = $cust_pay->h_search('insert');
1064 if ( $h_cust_pay ) {
1065 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1066 #$cust_pay->otaker($h_cust_pay->history_user);
1067 $cust_pay->set('otaker', $h_cust_pay->history_user);
1069 $cust_pay->set('otaker', 'legacy');
1072 my $error = $cust_pay->replace;
1075 warn " *** WARNING: Error updating order taker for payment paynum ".
1076 $cust_pay->paynun. ": $error\n";
1081 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1082 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1088 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1092 # payinfo N/A upgrade
1095 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1097 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1099 my @na_cust_pay = qsearch( {
1100 'table' => 'cust_pay',
1101 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1102 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1105 foreach my $na ( @na_cust_pay ) {
1107 next unless $na->payinfo eq 'N/A';
1109 my $cust_pay_pending =
1110 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1111 unless ( $cust_pay_pending ) {
1112 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1113 $na->paynum. " (no cust_pay_pending)\n";
1116 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1117 my $error = $na->replace;
1119 warn " *** WARNING: Error updating payinfo for payment paynum ".
1120 $na->paynun. ": $error\n";
1126 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1130 # otaker->usernum upgrade
1133 $class->_upgrade_otaker(%opt);
1135 # if we do this anywhere else, it should become an FS::Upgrade method
1136 my $num_to_upgrade = $class->count('paybatch is not null');
1137 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1138 if ( $num_to_upgrade > 0 ) {
1139 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1140 if ( $opt{queue} ) {
1141 if ( $num_jobs > 0 ) {
1142 warn "Upgrade already queued.\n";
1144 warn "Scheduling upgrade.\n";
1145 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1149 process_upgrade_paybatch();
1154 sub process_upgrade_paybatch {
1156 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1157 local $FS::UID::AutoCommit = 1;
1160 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1162 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1163 my $search = FS::Cursor->new( {
1164 'table' => 'cust_pay',
1165 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1167 while (my $cust_pay = $search->fetch) {
1168 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1169 $cust_pay->set('paybatch' => '');
1170 my $error = $cust_pay->replace;
1171 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1176 # migrate gateway info from the misused 'paybatch' field
1179 # not only cust_pay, but also voided and refunded payments
1180 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1181 local $FS::Record::nowarn_classload=1;
1182 # really inefficient, but again, only has to run once
1183 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1184 my $and_batchnum_is_null =
1185 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1186 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1187 my $search = FS::Cursor->new({
1189 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1190 "AND (paybatch IS NOT NULL ".
1191 "OR (paybatch IS NULL AND auth IS NULL
1192 $and_batchnum_is_null ) )
1193 ORDER BY $pkey DESC"
1195 while ( my $object = $search->fetch ) {
1196 if ( $object->paybatch eq '' ) {
1197 # repair for a previous upgrade that didn't save 'auth'
1198 my $pkey = $object->primary_key;
1199 # find the last history record that had a paybatch value
1201 table => "h_$table",
1203 $pkey => $object->$pkey,
1204 paybatch => { op=>'!=', value=>''},
1205 history_action => 'replace_old',
1207 order_by => 'ORDER BY history_date DESC LIMIT 1',
1210 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1213 # if the paybatch didn't have an auth string, then it's fine
1214 $h->paybatch =~ /:(\w+):/ or next;
1215 # set paybatch to what it was in that record
1216 $object->set('paybatch', $h->paybatch)
1217 # and then upgrade it like the old records
1220 my $parsed = $object->_parse_paybatch;
1221 if (keys %$parsed) {
1222 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1223 $object->set('auth' => $parsed->{authorization});
1224 $object->set('paybatch', '');
1225 my $error = $object->replace;
1226 warn "error parsing CARD/CHEK paybatch fields on $object #".
1227 $object->get($object->primary_key).":\n $error\n"
1232 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1242 =item process_batch_import
1246 sub process_batch_import {
1251 my $custnum = $hash{'custnum'};
1252 my $agentnum = $hash{'agentnum'};
1253 my $agent_custid = $hash{'agent_custid'};
1255 $hash{'_date'} = parse_datetime($hash{'_date'})
1256 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1257 #remove custnum_prefix
1258 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1259 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1262 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1263 && length($1) == $custnum_length
1267 # check agentnum against custnum and
1268 # translate agent_custid into regular custnum
1269 if ($custnum && $agent_custid) {
1270 die "can't specify both custnum and agent_custid\n";
1271 } elsif ($agentnum || $agent_custid) {
1272 # here is the agent virtualization
1273 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1275 $search{'agentnum'} = $agentnum
1277 $search{'agent_custid'} = $agent_custid
1279 $search{'custnum'} = $custnum
1281 my $cust_main = qsearchs({
1282 'table' => 'cust_main',
1283 'hashref' => \%search,
1284 'extra_sql' => $extra_sql,
1286 die "can't find customer with" .
1287 ($agentnum ? " agentnum $agentnum" : '') .
1288 ($custnum ? " custnum $custnum" : '') .
1289 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1291 die "mismatched customer number\n"
1292 if $custnum && ($custnum ne $cust_main->custnum);
1293 $custnum = $cust_main->custnum;
1295 $hash{'custnum'} = $custnum;
1296 delete($hash{'agent_custid'});
1301 'table' => 'cust_pay',
1302 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1303 #agent_custid isn't a cust_pay field, see hash callback
1304 'formats' => { 'simple' =>
1305 [ qw(custnum agent_custid paid payinfo invnum) ] },
1306 'format_types' => { 'simple' => '' }, #force infer from file extension
1307 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1308 'format_hash_callbacks' => { 'simple' => $hashcb },
1309 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1310 'postinsert_callback' => sub {
1311 my $cust_pay = shift;
1312 my $cust_main = $cust_pay->cust_main
1313 or return "can't find customer to which payments apply";
1314 my $error = $cust_main->apply_payments_and_credits;
1316 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1321 FS::Record::process_batch_import( $job, $opt, @_ );
1325 =item batch_import HASHREF
1327 Inserts new payments.
1334 my $fh = $param->{filehandle};
1335 my $format = $param->{'format'};
1337 my $agentnum = $param->{agentnum};
1338 my $_date = $param->{_date};
1339 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1340 my $paybatch = $param->{'paybatch'};
1342 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1343 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1345 # here is the agent virtualization
1346 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1350 if ( $format eq 'simple' ) {
1351 @fields = qw( custnum agent_custid paid payinfo invnum );
1353 } elsif ( $format eq 'extended' ) {
1354 die "unimplemented\n";
1358 die "unknown format $format";
1361 eval "use Text::CSV_XS;";
1364 my $csv = new Text::CSV_XS;
1368 local $SIG{HUP} = 'IGNORE';
1369 local $SIG{INT} = 'IGNORE';
1370 local $SIG{QUIT} = 'IGNORE';
1371 local $SIG{TERM} = 'IGNORE';
1372 local $SIG{TSTP} = 'IGNORE';
1373 local $SIG{PIPE} = 'IGNORE';
1375 my $oldAutoCommit = $FS::UID::AutoCommit;
1376 local $FS::UID::AutoCommit = 0;
1380 while ( defined($line=<$fh>) ) {
1382 $csv->parse($line) or do {
1383 $dbh->rollback if $oldAutoCommit;
1384 return "can't parse: ". $csv->error_input();
1387 my @columns = $csv->fields();
1391 paybatch => $paybatch,
1393 $cust_pay{_date} = $_date if $_date;
1396 foreach my $field ( @fields ) {
1398 if ( $field eq 'agent_custid'
1400 && $columns[0] =~ /\S+/ )
1403 my $agent_custid = $columns[0];
1404 my %hash = ( 'agent_custid' => $agent_custid,
1405 'agentnum' => $agentnum,
1408 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1409 $dbh->rollback if $oldAutoCommit;
1410 return "can't specify custnum with agent_custid $agent_custid";
1413 $cust_main = qsearchs({
1414 'table' => 'cust_main',
1415 'hashref' => \%hash,
1416 'extra_sql' => $extra_sql,
1419 unless ( $cust_main ) {
1420 $dbh->rollback if $oldAutoCommit;
1421 return "can't find customer with agent_custid $agent_custid";
1425 $columns[0] = $cust_main->custnum;
1428 $cust_pay{$field} = shift @columns;
1431 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1432 && length($1) == $custnum_length ) {
1433 $cust_pay{custnum} = $2;
1436 my $custnum = $cust_pay{custnum};
1438 my $cust_pay = new FS::cust_pay( \%cust_pay );
1439 my $error = $cust_pay->insert;
1441 if ( ! $error && $cust_pay->custnum != $custnum ) {
1442 #invnum was defined, and ->insert set custnum to the customer for that
1443 #invoice, but it wasn't the one the import specified.
1444 $dbh->rollback if $oldAutoCommit;
1445 $error = "specified invoice #". $cust_pay{invnum}.
1446 " is for custnum ". $cust_pay->custnum.
1447 ", not specified custnum $custnum";
1451 $dbh->rollback if $oldAutoCommit;
1452 return "can't insert payment for $line: $error";
1455 if ( $format eq 'simple' ) {
1456 # include agentnum for less surprise?
1457 $cust_main = qsearchs({
1458 'table' => 'cust_main',
1459 'hashref' => { 'custnum' => $cust_pay->custnum },
1460 'extra_sql' => $extra_sql,
1464 unless ( $cust_main ) {
1465 $dbh->rollback if $oldAutoCommit;
1466 return "can't find customer to which payments apply at line: $line";
1469 $error = $cust_main->apply_payments_and_credits;
1471 $dbh->rollback if $oldAutoCommit;
1472 return "can't apply payments to customer for $line: $error";
1480 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1482 return "Empty file!" unless $imported;
1492 Delete and replace methods.
1496 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1497 schema.html from the base documentation.