4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
6 use vars qw( $DEBUG $me $conf @encrypted_fields
7 $unsuspendauto $ignore_noapply
10 use Business::CreditCard;
12 use FS::UID qw( getotaker driver_name );
13 use FS::Misc qw( send_email );
14 use FS::Misc::DateTime qw( parse_datetime ); #for batch_import
15 use FS::Record qw( dbh qsearch qsearchs );
18 use FS::cust_main_Mixin;
19 use FS::payinfo_transaction_Mixin;
21 use FS::cust_bill_pay;
22 use FS::cust_pay_refund;
25 use FS::cust_pay_void;
26 use FS::upgrade_journal;
31 $me = '[FS::cust_pay]';
35 #ask FS::UID to run this stuff for us later
36 FS::UID->install_callback( sub {
38 $unsuspendauto = $conf->exists('unsuspendauto');
41 @encrypted_fields = ('payinfo');
42 sub nohistory_fields { ('payinfo'); }
46 FS::cust_pay - Object methods for cust_pay objects
52 $record = new FS::cust_pay \%hash;
53 $record = new FS::cust_pay { 'column' => 'value' };
55 $error = $record->insert;
57 $error = $new_record->replace($old_record);
59 $error = $record->delete;
61 $error = $record->check;
65 An FS::cust_pay object represents a payment; the transfer of money from a
66 customer. FS::cust_pay inherits from FS::Record. The following fields are
73 primary key (assigned automatically for new payments)
77 customer (see L<FS::cust_main>)
81 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
82 L<Time::Local> and L<Date::Parse> for conversion functions.
86 Amount of this payment
90 order taker (see L<FS::access_user>)
94 Payment Type (See L<FS::payinfo_Mixin> for valid values)
98 Payment Information (See L<FS::payinfo_Mixin> for data format)
102 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
106 obsolete text field for tracking card processing or other batch grouping
110 Optional unique identifer to prevent duplicate transactions.
114 books closed flag, empty or `Y'
118 Desired pkgnum when using experimental package balances.
122 The bank where the payment was deposited.
126 The name of the depositor.
130 The deposit account number.
138 The number of the batch this payment came from (see L<FS::pay_batch>),
139 or null if it was processed through a realtime gateway or entered manually.
143 The number of the realtime or batch gateway L<FS::payment_gateway>) this
144 payment was processed through. Null if it was entered manually or processed
145 by the "system default" gateway, which doesn't have a number.
149 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
150 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
151 redundant with C<gatewaynum>.
155 The authorization number returned by the credit card network.
159 The transaction ID returned by the gateway, if any. This is usually what
160 you would use to initiate a void or refund of the payment.
170 Creates a new payment. To add the payment to the databse, see L<"insert">.
174 sub table { 'cust_pay'; }
175 sub cust_linked { $_[0]->cust_main_custnum; }
176 sub cust_unlinked_msg {
178 "WARNING: can't find cust_main.custnum ". $self->custnum.
179 ' (cust_pay.paynum '. $self->paynum. ')';
182 =item insert [ OPTION => VALUE ... ]
184 Adds this payment to the database.
186 For backwards-compatibility and convenience, if the additional field invnum
187 is defined, an FS::cust_bill_pay record for the full amount of the payment
188 will be created. In this case, custnum is optional.
190 If the additional field discount_term is defined then a prepayment discount
191 is taken for that length of time. It is an error for the customer to owe
192 after this payment is made.
194 A hash of optional arguments may be passed. Currently "manual" is supported.
195 If true, a payment receipt is sent instead of a statement when
196 'payment_receipt_email' configuration option is set.
198 About the "manual" flag: Normally, if the 'payment_receipt' config option
199 is set, and the customer has an invoice email address, inserting a payment
200 causes a I<statement> to be emailed to the customer. If the payment is
201 considered "manual" (or if the customer has no invoices), then it will
202 instead send a I<payment receipt>. "manual" should be true whenever a
203 payment is created directly from the web interface, from a user-initiated
204 realtime payment, or from a third-party payment via self-service. It should
205 be I<false> when creating a payment from a billing event or from a batch.
210 my($self, %options) = @_;
212 local $SIG{HUP} = 'IGNORE';
213 local $SIG{INT} = 'IGNORE';
214 local $SIG{QUIT} = 'IGNORE';
215 local $SIG{TERM} = 'IGNORE';
216 local $SIG{TSTP} = 'IGNORE';
217 local $SIG{PIPE} = 'IGNORE';
219 my $oldAutoCommit = $FS::UID::AutoCommit;
220 local $FS::UID::AutoCommit = 0;
224 if ( $self->invnum ) {
225 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
227 $dbh->rollback if $oldAutoCommit;
228 return "Unknown cust_bill.invnum: ". $self->invnum;
230 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
231 $dbh->rollback if $oldAutoCommit;
232 return "Invoice custnum ".$cust_bill->custnum
233 ." does not match specified custnum ".$self->custnum
234 ." for invoice ".$self->invnum;
236 $self->custnum($cust_bill->custnum );
239 my $error = $self->check;
240 return $error if $error;
242 my $cust_main = $self->cust_main;
243 my $old_balance = $cust_main->balance;
245 $error = $self->SUPER::insert;
247 $dbh->rollback if $oldAutoCommit;
248 return "error inserting cust_pay: $error";
251 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
252 if ( my $months = $self->discount_term ) {
253 # XXX this should be moved out somewhere, but discount_term_values
255 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
256 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
258 # %billing_pkgs contains this customer's active monthly packages.
259 # Recurring fees for those packages will be credited and then rebilled
260 # for the full discount term. Other packages on the last invoice
261 # (canceled, non-monthly recurring, or one-time charges) will be
263 my %billing_pkgs = map { $_->pkgnum => $_ }
264 grep { $_->part_pkg->freq eq '1' }
265 $cust_main->billing_pkgs;
266 my $credit = 0; # sum of recurring charges from that invoice
267 my $last_bill_date = 0; # the real bill date
268 foreach my $item ( $cust_bill->cust_bill_pkg ) {
269 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
270 $credit += $item->recur;
271 $last_bill_date = $item->cust_pkg->last_bill
272 if defined($item->cust_pkg)
273 and $item->cust_pkg->last_bill > $last_bill_date
276 my $cust_credit = new FS::cust_credit {
277 'custnum' => $self->custnum,
278 'amount' => sprintf('%.2f', $credit),
279 'reason' => 'customer chose to prepay for discount',
281 $error = $cust_credit->insert('reason_type' => $credit_type);
283 $dbh->rollback if $oldAutoCommit;
284 return "error inserting prepayment credit: $error";
288 # bill for the entire term
289 $_->bill($_->last_bill) foreach (values %billing_pkgs);
290 $error = $cust_main->bill(
291 # no recurring_only, we want unbilled packages with start dates to
293 'no_usage_reset' => 1,
294 'time' => $last_bill_date, # not $cust_bill->_date
295 'pkg_list' => [ values %billing_pkgs ],
296 'freq_override' => $months,
299 $dbh->rollback if $oldAutoCommit;
300 return "error inserting cust_pay: $error";
302 $error = $cust_main->apply_payments_and_credits;
304 $dbh->rollback if $oldAutoCommit;
305 return "error inserting cust_pay: $error";
307 my $new_balance = $cust_main->balance;
308 if ($new_balance > 0) {
309 $dbh->rollback if $oldAutoCommit;
310 return "balance after prepay discount attempt: $new_balance";
312 # user friendly: override the "apply only to this invoice" mode
319 if ( $self->invnum ) {
320 my $cust_bill_pay = new FS::cust_bill_pay {
321 'invnum' => $self->invnum,
322 'paynum' => $self->paynum,
323 'amount' => $self->paid,
324 '_date' => $self->_date,
326 $error = $cust_bill_pay->insert(%options);
328 if ( $ignore_noapply ) {
329 warn "warning: error inserting cust_bill_pay: $error ".
330 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
332 $dbh->rollback if $oldAutoCommit;
333 return "error inserting cust_bill_pay: $error";
338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
340 #false laziness w/ cust_credit::insert
341 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
342 my @errors = $cust_main->unsuspend;
344 # side-fx with nested transactions? upstack rolls back?
345 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
351 #bill setup fees for voip_cdr bill_every_call packages
352 #some false laziness w/search in freeside-cdrd
354 'LEFT JOIN part_pkg USING ( pkgpart ) '.
355 "LEFT JOIN part_pkg_option
356 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
357 AND part_pkg_option.optionname = 'bill_every_call' )";
359 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
360 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
362 my @cust_pkg = qsearch({
363 'table' => 'cust_pkg',
364 'addl_from' => $addl_from,
365 'hashref' => { 'custnum' => $self->custnum,
369 'extra_sql' => $extra_sql,
373 warn "voip_cdr bill_every_call packages found; billing customer\n";
374 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
376 warn "WARNING: Error billing customer: $bill_error\n";
379 #end of billing setup fees for voip_cdr bill_every_call packages
381 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
384 my $trigger = $conf->config('payment_receipt-trigger',
385 $self->cust_main->agentnum) || 'cust_pay';
386 if ( $trigger eq 'cust_pay' ) {
387 my $error = $self->send_receipt(
388 'manual' => $options{'manual'},
389 'cust_bill' => $cust_bill,
390 'cust_main' => $cust_main,
392 warn "can't send payment receipt/statement: $error" if $error;
399 =item void [ REASON ]
401 Voids this payment: deletes the payment and all associated applications and
402 adds a record of the voided payment to the FS::cust_pay_void table.
409 local $SIG{HUP} = 'IGNORE';
410 local $SIG{INT} = 'IGNORE';
411 local $SIG{QUIT} = 'IGNORE';
412 local $SIG{TERM} = 'IGNORE';
413 local $SIG{TSTP} = 'IGNORE';
414 local $SIG{PIPE} = 'IGNORE';
416 my $oldAutoCommit = $FS::UID::AutoCommit;
417 local $FS::UID::AutoCommit = 0;
420 my $cust_pay_void = new FS::cust_pay_void ( {
421 map { $_ => $self->get($_) } $self->fields
423 $cust_pay_void->reason(shift) if scalar(@_);
424 my $error = $cust_pay_void->insert;
426 my $cust_pay_pending =
427 qsearchs('cust_pay_pending', { paynum => $self->paynum });
428 if ( $cust_pay_pending ) {
429 $cust_pay_pending->set('void_paynum', $self->paynum);
430 $cust_pay_pending->set('paynum', '');
431 $error ||= $cust_pay_pending->replace;
434 $error ||= $self->delete;
437 $dbh->rollback if $oldAutoCommit;
441 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
449 Unless the closed flag is set, deletes this payment and all associated
450 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
451 cases, you want to use the void method instead to leave a record of the
456 # very similar to FS::cust_credit::delete
459 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
461 local $SIG{HUP} = 'IGNORE';
462 local $SIG{INT} = 'IGNORE';
463 local $SIG{QUIT} = 'IGNORE';
464 local $SIG{TERM} = 'IGNORE';
465 local $SIG{TSTP} = 'IGNORE';
466 local $SIG{PIPE} = 'IGNORE';
468 my $oldAutoCommit = $FS::UID::AutoCommit;
469 local $FS::UID::AutoCommit = 0;
472 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
473 my $error = $app->delete;
475 $dbh->rollback if $oldAutoCommit;
480 my $error = $self->SUPER::delete(@_);
482 $dbh->rollback if $oldAutoCommit;
486 if ( $conf->exists('deletepayments')
487 && $conf->config('deletepayments') ne '' ) {
489 my $cust_main = $self->cust_main;
491 my $error = send_email(
492 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
493 #invoice_from??? well as good as any
494 'to' => $conf->config('deletepayments'),
495 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
497 "This is an automatic message from your Freeside installation\n",
498 "informing you that the following payment has been deleted:\n",
500 'paynum: '. $self->paynum. "\n",
501 'custnum: '. $self->custnum.
502 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
503 'paid: $'. sprintf("%.2f", $self->paid). "\n",
504 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
505 'payby: '. $self->payby. "\n",
506 'payinfo: '. $self->paymask. "\n",
507 'paybatch: '. $self->paybatch. "\n",
512 $dbh->rollback if $oldAutoCommit;
513 return "can't send payment deletion notification: $error";
518 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
524 =item replace [ OLD_RECORD ]
526 You can, but probably shouldn't modify payments...
528 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
529 supplied, replaces this record. If there is an error, returns the error,
530 otherwise returns false.
536 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
537 $self->SUPER::replace(@_);
542 Checks all fields to make sure this is a valid payment. If there is an error,
543 returns the error, otherwise returns false. Called by the insert method.
550 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
553 $self->ut_numbern('paynum')
554 || $self->ut_numbern('custnum')
555 || $self->ut_numbern('_date')
556 || $self->ut_money('paid')
557 || $self->ut_alphan('otaker')
558 || $self->ut_textn('paybatch')
559 || $self->ut_textn('payunique')
560 || $self->ut_enum('closed', [ '', 'Y' ])
561 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
562 || $self->ut_textn('bank')
563 || $self->ut_alphan('depositor')
564 || $self->ut_numbern('account')
565 || $self->ut_numbern('teller')
566 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
567 || $self->payinfo_check()
569 return $error if $error;
571 return "paid must be > 0 " if $self->paid <= 0;
573 return "unknown cust_main.custnum: ". $self->custnum
575 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
577 $self->_date(time) unless $self->_date;
579 return "invalid discount_term"
580 if ($self->discount_term && $self->discount_term < 2);
582 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
583 foreach (qw(bank depositor account teller)) {
584 return "$_ required" if $self->get($_) eq '';
588 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
589 # # UNIQUE index should catch this too, without race conditions, but this
590 # # should give a better error message the other 99.9% of the time...
591 # if ( length($self->payunique)
592 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
593 # #well, it *could* be a better error message
594 # return "duplicate transaction".
595 # " - a payment with unique identifer ". $self->payunique.
602 =item send_receipt HASHREF | OPTION => VALUE ...
604 Sends a payment receipt for this payment..
612 Flag indicating the payment is being made manually.
616 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
621 Customer (FS::cust_main) object (for efficiency).
629 my $opt = ref($_[0]) ? shift : { @_ };
631 my $cust_bill = $opt->{'cust_bill'};
632 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
634 my $conf = new FS::Conf;
636 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
638 my @invoicing_list = $cust_main->invoicing_list_emailonly;
639 return '' unless @invoicing_list;
641 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
645 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
646 #|| ! $conf->exists('invoice_html_statement')
650 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
653 my %substitutions = ();
654 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
656 my $queue = new FS::queue {
657 'job' => 'FS::Misc::process_send_email',
658 'paynum' => $self->paynum,
659 'custnum' => $cust_main->custnum,
661 $error = $queue->insert(
662 FS::msg_template->by_key($msgnum)->prepare(
663 'cust_main' => $cust_main,
665 'from_config' => 'payment_receipt_from',
666 'substitutions' => \%substitutions,
668 'msgtype' => 'receipt', # override msg_template's default
671 } elsif ( $conf->exists('payment_receipt_email') ) {
673 my $receipt_template = new Text::Template (
675 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
677 warn "can't create payment receipt template: $Text::Template::ERROR";
681 my $payby = $self->payby;
682 my $payinfo = $self->payinfo;
683 $payby =~ s/^BILL$/Check/ if $payinfo;
684 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
685 $payinfo = $self->paymask
687 $payinfo = $self->decrypt($payinfo);
689 $payby =~ s/^CHEK$/Electronic check/;
692 'date' => time2str("%a %B %o, %Y", $self->_date),
693 'name' => $cust_main->name,
694 'paynum' => $self->paynum,
695 'paid' => sprintf("%.2f", $self->paid),
696 'payby' => ucfirst(lc($payby)),
697 'payinfo' => $payinfo,
698 'balance' => $cust_main->balance,
699 'company_name' => $conf->config('company_name', $cust_main->agentnum),
702 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
704 if ( $opt->{'cust_pkg'} ) {
705 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
706 #setup date, other things?
709 my $queue = new FS::queue {
710 'job' => 'FS::Misc::process_send_generated_email',
711 'paynum' => $self->paynum,
712 'custnum' => $cust_main->custnum,
713 'msgtype' => 'receipt',
715 $error = $queue->insert(
716 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
717 #invoice_from??? well as good as any
718 'to' => \@invoicing_list,
719 'subject' => 'Payment receipt',
720 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
725 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
729 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
731 my $queue = new FS::queue {
732 'job' => 'FS::cust_bill::queueable_email',
733 'paynum' => $self->paynum,
734 'custnum' => $cust_main->custnum,
738 'invnum' => $cust_bill->invnum,
742 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
743 $opt{'mode'} = $mode;
745 # backward compatibility, no good fix for this yet as some people may
746 # still have "invoice_latex_statement" and such options
747 $opt{'template'} = 'statement';
748 $opt{'notice_name'} = 'Statement';
751 $error = $queue->insert(%opt);
755 warn "send_receipt: $error\n" if $error;
760 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
767 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
768 sort { $a->_date <=> $b->_date
769 || $a->invnum <=> $b->invnum }
770 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
774 =item cust_pay_refund
776 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
781 sub cust_pay_refund {
783 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
784 sort { $a->_date <=> $b->_date }
785 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
792 Returns the amount of this payment that is still unapplied; which is
793 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
794 applications (see L<FS::cust_pay_refund>).
800 my $amount = $self->paid;
801 $amount -= $_->amount foreach ( $self->cust_bill_pay );
802 $amount -= $_->amount foreach ( $self->cust_pay_refund );
803 sprintf("%.2f", $amount );
808 Returns the amount of this payment that has not been refuned; which is
809 paid minus all refund applications (see L<FS::cust_pay_refund>).
815 my $amount = $self->paid;
816 $amount -= $_->amount foreach ( $self->cust_pay_refund );
817 sprintf("%.2f", $amount );
822 Returns the "paid" field.
837 =item batch_insert CUST_PAY_OBJECT, ...
839 Class method which inserts multiple payments. Takes a list of FS::cust_pay
840 objects. Returns a list, each element representing the status of inserting the
841 corresponding payment - empty. If there is an error inserting any payment, the
842 entire transaction is rolled back, i.e. all payments are inserted or none are.
844 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
845 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
846 those objects will be inserted with the paynum of the payment, and for
847 each one, an error message or an empty string will be inserted into the
852 my @errors = FS::cust_pay->batch_insert(@cust_pay);
853 my $num_errors = scalar(grep $_, @errors);
854 if ( $num_errors == 0 ) {
855 #success; all payments were inserted
857 #failure; no payments were inserted.
863 my $self = shift; #class method
865 local $SIG{HUP} = 'IGNORE';
866 local $SIG{INT} = 'IGNORE';
867 local $SIG{QUIT} = 'IGNORE';
868 local $SIG{TERM} = 'IGNORE';
869 local $SIG{TSTP} = 'IGNORE';
870 local $SIG{PIPE} = 'IGNORE';
872 my $oldAutoCommit = $FS::UID::AutoCommit;
873 local $FS::UID::AutoCommit = 0;
879 foreach my $cust_pay (@_) {
880 my $error = $cust_pay->insert( 'manual' => 1 );
881 push @errors, $error;
882 $num_errors++ if $error;
884 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
886 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
887 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
891 $cust_bill_pay->set('paynum', $cust_pay->paynum);
892 my $apply_error = $cust_bill_pay->insert;
893 push @errors, $apply_error || '';
894 $num_errors++ if $apply_error;
898 } elsif ( !$error ) { #normal case: apply payments as usual
899 $cust_pay->cust_main->apply_payments;
905 $dbh->rollback if $oldAutoCommit;
907 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
916 Returns an SQL fragment to retreive the unapplied amount.
921 my ($class, $start, $end) = @_;
922 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
923 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
924 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
925 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
929 ( SELECT SUM(amount) FROM cust_bill_pay
930 WHERE cust_pay.paynum = cust_bill_pay.paynum
931 $bill_start $bill_end )
935 ( SELECT SUM(amount) FROM cust_pay_refund
936 WHERE cust_pay.paynum = cust_pay_refund.paynum
937 $refund_start $refund_end )
946 # Used by FS::Upgrade to migrate to a new database.
950 sub _upgrade_data { #class method
951 my ($class, %opt) = @_;
953 warn "$me upgrading $class\n" if $DEBUG;
955 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
958 # otaker/ivan upgrade
961 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
963 #not the most efficient, but hey, it only has to run once
965 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
966 " AND usernum IS NULL ".
967 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
968 " WHERE cust_main.custnum = cust_pay.custnum ) ";
970 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
972 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
973 $sth->execute or die $sth->errstr;
974 my $total = $sth->fetchrow_arrayref->[0];
975 #warn "$total cust_pay records to update\n"
977 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
982 my @cust_pay = qsearch( {
983 'table' => 'cust_pay',
985 'extra_sql' => $where,
986 'order_by' => 'ORDER BY paynum',
989 foreach my $cust_pay (@cust_pay) {
991 my $h_cust_pay = $cust_pay->h_search('insert');
993 next if $cust_pay->otaker eq $h_cust_pay->history_user;
994 #$cust_pay->otaker($h_cust_pay->history_user);
995 $cust_pay->set('otaker', $h_cust_pay->history_user);
997 $cust_pay->set('otaker', 'legacy');
1000 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1001 my $error = $cust_pay->replace;
1004 warn " *** WARNING: Error updating order taker for payment paynum ".
1005 $cust_pay->paynun. ": $error\n";
1009 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1012 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1013 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1019 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1023 # payinfo N/A upgrade
1026 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1028 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1030 my @na_cust_pay = qsearch( {
1031 'table' => 'cust_pay',
1032 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1033 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1036 foreach my $na ( @na_cust_pay ) {
1038 next unless $na->payinfo eq 'N/A';
1040 my $cust_pay_pending =
1041 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1042 unless ( $cust_pay_pending ) {
1043 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1044 $na->paynum. " (no cust_pay_pending)\n";
1047 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1048 my $error = $na->replace;
1050 warn " *** WARNING: Error updating payinfo for payment paynum ".
1051 $na->paynun. ": $error\n";
1057 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1061 # otaker->usernum upgrade
1064 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1065 $class->_upgrade_otaker(%opt);
1066 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1068 # if we do this anywhere else, it should become an FS::Upgrade method
1069 my $num_to_upgrade = $class->count('paybatch is not null');
1070 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1071 if ( $num_to_upgrade > 0 ) {
1072 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1073 if ( $opt{queue} ) {
1074 if ( $num_jobs > 0 ) {
1075 warn "Upgrade already queued.\n";
1077 warn "Scheduling upgrade.\n";
1078 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1082 process_upgrade_paybatch();
1087 sub process_upgrade_paybatch {
1089 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1090 local $FS::UID::AutoCommit = 1;
1093 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1095 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1096 my $search = FS::Cursor->new( {
1097 'table' => 'cust_pay',
1098 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1100 while (my $cust_pay = $search->fetch) {
1101 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1102 $cust_pay->set('paybatch' => '');
1103 my $error = $cust_pay->replace;
1104 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1109 # migrate gateway info from the misused 'paybatch' field
1112 # not only cust_pay, but also voided and refunded payments
1113 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1114 local $FS::Record::nowarn_classload=1;
1115 # really inefficient, but again, only has to run once
1116 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1117 my $and_batchnum_is_null =
1118 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1119 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1120 my $search = FS::Cursor->new({
1122 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1123 "AND (paybatch IS NOT NULL ".
1124 "OR (paybatch IS NULL AND auth IS NULL
1125 $and_batchnum_is_null ) )
1126 ORDER BY $pkey DESC"
1128 while ( my $object = $search->fetch ) {
1129 if ( $object->paybatch eq '' ) {
1130 # repair for a previous upgrade that didn't save 'auth'
1131 my $pkey = $object->primary_key;
1132 # find the last history record that had a paybatch value
1134 table => "h_$table",
1136 $pkey => $object->$pkey,
1137 paybatch => { op=>'!=', value=>''},
1138 history_action => 'replace_old',
1140 order_by => 'ORDER BY history_date DESC LIMIT 1',
1143 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1146 # if the paybatch didn't have an auth string, then it's fine
1147 $h->paybatch =~ /:(\w+):/ or next;
1148 # set paybatch to what it was in that record
1149 $object->set('paybatch', $h->paybatch)
1150 # and then upgrade it like the old records
1153 my $parsed = $object->_parse_paybatch;
1154 if (keys %$parsed) {
1155 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1156 $object->set('auth' => $parsed->{authorization});
1157 $object->set('paybatch', '');
1158 my $error = $object->replace;
1159 warn "error parsing CARD/CHEK paybatch fields on $object #".
1160 $object->get($object->primary_key).":\n $error\n"
1165 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1175 =item process_batch_import
1179 sub process_batch_import {
1184 my $custnum = $hash{'custnum'};
1185 my $agentnum = $hash{'agentnum'};
1186 my $agent_custid = $hash{'agent_custid'};
1188 $hash{'_date'} = parse_datetime($hash{'_date'})
1189 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1190 #remove custnum_prefix
1191 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1192 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1195 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1196 && length($1) == $custnum_length
1200 # check agentnum against custnum and
1201 # translate agent_custid into regular custnum
1202 if ($custnum && $agent_custid) {
1203 die "can't specify both custnum and agent_custid\n";
1204 } elsif ($agentnum || $agent_custid) {
1205 # here is the agent virtualization
1206 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1208 $search{'agentnum'} = $agentnum
1210 $search{'agent_custid'} = $agent_custid
1212 $search{'custnum'} = $custnum
1214 my $cust_main = qsearchs({
1215 'table' => 'cust_main',
1216 'hashref' => \%search,
1217 'extra_sql' => $extra_sql,
1219 die "can't find customer with" .
1220 ($agentnum ? " agentnum $agentnum" : '') .
1221 ($custnum ? " custnum $custnum" : '') .
1222 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1224 die "mismatched customer number\n"
1225 if $custnum && ($custnum ne $cust_main->custnum);
1226 $custnum = $cust_main->custnum;
1228 $hash{'custnum'} = $custnum;
1229 delete($hash{'agent_custid'});
1233 my $opt = { 'table' => 'cust_pay',
1234 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1235 #agent_custid isn't a cust_pay field, see hash callback
1236 'formats' => { 'simple' => [ qw(custnum agent_custid paid payinfo invnum) ] },
1237 'format_types' => { 'simple' => '' }, #force infer from file extension
1238 'default_csv' => 1, #if it's not .xls, it'll read as csv, regardless of extension
1239 'format_hash_callbacks' => { 'simple' => $hashcb },
1240 'postinsert_callback' => sub {
1241 my $cust_pay = shift;
1242 my $cust_main = $cust_pay->cust_main ||
1243 return "can't find customer to which payments apply";
1244 my $error = $cust_main->apply_payments_and_credits;
1246 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1251 FS::Record::process_batch_import( $job, $opt, @_ );
1255 =item batch_import HASHREF
1257 Inserts new payments.
1264 my $fh = $param->{filehandle};
1265 my $format = $param->{'format'};
1267 my $agentnum = $param->{agentnum};
1268 my $_date = $param->{_date};
1269 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1270 my $paybatch = $param->{'paybatch'};
1272 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1273 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1275 # here is the agent virtualization
1276 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1280 if ( $format eq 'simple' ) {
1281 @fields = qw( custnum agent_custid paid payinfo invnum );
1283 } elsif ( $format eq 'extended' ) {
1284 die "unimplemented\n";
1288 die "unknown format $format";
1291 eval "use Text::CSV_XS;";
1294 my $csv = new Text::CSV_XS;
1298 local $SIG{HUP} = 'IGNORE';
1299 local $SIG{INT} = 'IGNORE';
1300 local $SIG{QUIT} = 'IGNORE';
1301 local $SIG{TERM} = 'IGNORE';
1302 local $SIG{TSTP} = 'IGNORE';
1303 local $SIG{PIPE} = 'IGNORE';
1305 my $oldAutoCommit = $FS::UID::AutoCommit;
1306 local $FS::UID::AutoCommit = 0;
1310 while ( defined($line=<$fh>) ) {
1312 $csv->parse($line) or do {
1313 $dbh->rollback if $oldAutoCommit;
1314 return "can't parse: ". $csv->error_input();
1317 my @columns = $csv->fields();
1321 paybatch => $paybatch,
1323 $cust_pay{_date} = $_date if $_date;
1326 foreach my $field ( @fields ) {
1328 if ( $field eq 'agent_custid'
1330 && $columns[0] =~ /\S+/ )
1333 my $agent_custid = $columns[0];
1334 my %hash = ( 'agent_custid' => $agent_custid,
1335 'agentnum' => $agentnum,
1338 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1339 $dbh->rollback if $oldAutoCommit;
1340 return "can't specify custnum with agent_custid $agent_custid";
1343 $cust_main = qsearchs({
1344 'table' => 'cust_main',
1345 'hashref' => \%hash,
1346 'extra_sql' => $extra_sql,
1349 unless ( $cust_main ) {
1350 $dbh->rollback if $oldAutoCommit;
1351 return "can't find customer with agent_custid $agent_custid";
1355 $columns[0] = $cust_main->custnum;
1358 $cust_pay{$field} = shift @columns;
1361 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1362 && length($1) == $custnum_length ) {
1363 $cust_pay{custnum} = $2;
1366 my $custnum = $cust_pay{custnum};
1368 my $cust_pay = new FS::cust_pay( \%cust_pay );
1369 my $error = $cust_pay->insert;
1371 if ( ! $error && $cust_pay->custnum != $custnum ) {
1372 #invnum was defined, and ->insert set custnum to the customer for that
1373 #invoice, but it wasn't the one the import specified.
1374 $dbh->rollback if $oldAutoCommit;
1375 $error = "specified invoice #". $cust_pay{invnum}.
1376 " is for custnum ". $cust_pay->custnum.
1377 ", not specified custnum $custnum";
1381 $dbh->rollback if $oldAutoCommit;
1382 return "can't insert payment for $line: $error";
1385 if ( $format eq 'simple' ) {
1386 # include agentnum for less surprise?
1387 $cust_main = qsearchs({
1388 'table' => 'cust_main',
1389 'hashref' => { 'custnum' => $cust_pay->custnum },
1390 'extra_sql' => $extra_sql,
1394 unless ( $cust_main ) {
1395 $dbh->rollback if $oldAutoCommit;
1396 return "can't find customer to which payments apply at line: $line";
1399 $error = $cust_main->apply_payments_and_credits;
1401 $dbh->rollback if $oldAutoCommit;
1402 return "can't apply payments to customer for $line: $error";
1410 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1412 return "Empty file!" unless $imported;
1422 Delete and replace methods.
1426 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1427 schema.html from the base documentation.