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 Flag to only allow manual application of payment, empty or 'Y'
126 The bank where the payment was deposited.
130 The name of the depositor.
134 The deposit account number.
142 The number of the batch this payment came from (see L<FS::pay_batch>),
143 or null if it was processed through a realtime gateway or entered manually.
147 The number of the realtime or batch gateway L<FS::payment_gateway>) this
148 payment was processed through. Null if it was entered manually or processed
149 by the "system default" gateway, which doesn't have a number.
153 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
154 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
155 redundant with C<gatewaynum>.
159 The authorization number returned by the credit card network.
163 The transaction ID returned by the gateway, if any. This is usually what
164 you would use to initiate a void or refund of the payment.
174 Creates a new payment. To add the payment to the databse, see L<"insert">.
178 sub table { 'cust_pay'; }
179 sub cust_linked { $_[0]->cust_main_custnum; }
180 sub cust_unlinked_msg {
182 "WARNING: can't find cust_main.custnum ". $self->custnum.
183 ' (cust_pay.paynum '. $self->paynum. ')';
186 =item insert [ OPTION => VALUE ... ]
188 Adds this payment to the database.
190 For backwards-compatibility and convenience, if the additional field invnum
191 is defined, an FS::cust_bill_pay record for the full amount of the payment
192 will be created. In this case, custnum is optional.
194 If the additional field discount_term is defined then a prepayment discount
195 is taken for that length of time. It is an error for the customer to owe
196 after this payment is made.
198 A hash of optional arguments may be passed. Currently "manual" is supported.
199 If true, a payment receipt is sent instead of a statement when
200 'payment_receipt_email' configuration option is set.
202 About the "manual" flag: Normally, if the 'payment_receipt' config option
203 is set, and the customer has an invoice email address, inserting a payment
204 causes a I<statement> to be emailed to the customer. If the payment is
205 considered "manual" (or if the customer has no invoices), then it will
206 instead send a I<payment receipt>. "manual" should be true whenever a
207 payment is created directly from the web interface, from a user-initiated
208 realtime payment, or from a third-party payment via self-service. It should
209 be I<false> when creating a payment from a billing event or from a batch.
214 my($self, %options) = @_;
216 local $SIG{HUP} = 'IGNORE';
217 local $SIG{INT} = 'IGNORE';
218 local $SIG{QUIT} = 'IGNORE';
219 local $SIG{TERM} = 'IGNORE';
220 local $SIG{TSTP} = 'IGNORE';
221 local $SIG{PIPE} = 'IGNORE';
223 my $oldAutoCommit = $FS::UID::AutoCommit;
224 local $FS::UID::AutoCommit = 0;
228 if ( $self->invnum ) {
229 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
231 $dbh->rollback if $oldAutoCommit;
232 return "Unknown cust_bill.invnum: ". $self->invnum;
234 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
235 $dbh->rollback if $oldAutoCommit;
236 return "Invoice custnum ".$cust_bill->custnum
237 ." does not match specified custnum ".$self->custnum
238 ." for invoice ".$self->invnum;
240 $self->custnum($cust_bill->custnum );
243 my $error = $self->check;
244 return $error if $error;
246 my $cust_main = $self->cust_main;
247 my $old_balance = $cust_main->balance;
249 $error = $self->SUPER::insert;
251 $dbh->rollback if $oldAutoCommit;
252 return "error inserting cust_pay: $error";
255 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
256 if ( my $months = $self->discount_term ) {
257 # XXX this should be moved out somewhere, but discount_term_values
259 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
260 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
262 # %billing_pkgs contains this customer's active monthly packages.
263 # Recurring fees for those packages will be credited and then rebilled
264 # for the full discount term. Other packages on the last invoice
265 # (canceled, non-monthly recurring, or one-time charges) will be
267 my %billing_pkgs = map { $_->pkgnum => $_ }
268 grep { $_->part_pkg->freq eq '1' }
269 $cust_main->billing_pkgs;
270 my $credit = 0; # sum of recurring charges from that invoice
271 my $last_bill_date = 0; # the real bill date
272 foreach my $item ( $cust_bill->cust_bill_pkg ) {
273 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
274 $credit += $item->recur;
275 $last_bill_date = $item->cust_pkg->last_bill
276 if defined($item->cust_pkg)
277 and $item->cust_pkg->last_bill > $last_bill_date
280 my $cust_credit = new FS::cust_credit {
281 'custnum' => $self->custnum,
282 'amount' => sprintf('%.2f', $credit),
283 'reason' => 'customer chose to prepay for discount',
285 $error = $cust_credit->insert('reason_type' => $credit_type);
287 $dbh->rollback if $oldAutoCommit;
288 return "error inserting prepayment credit: $error";
292 # bill for the entire term
293 $_->bill($_->last_bill) foreach (values %billing_pkgs);
294 $error = $cust_main->bill(
295 # no recurring_only, we want unbilled packages with start dates to
297 'no_usage_reset' => 1,
298 'time' => $last_bill_date, # not $cust_bill->_date
299 'pkg_list' => [ values %billing_pkgs ],
300 'freq_override' => $months,
303 $dbh->rollback if $oldAutoCommit;
304 return "error inserting cust_pay: $error";
306 $error = $cust_main->apply_payments_and_credits;
308 $dbh->rollback if $oldAutoCommit;
309 return "error inserting cust_pay: $error";
311 my $new_balance = $cust_main->balance;
312 if ($new_balance > 0) {
313 $dbh->rollback if $oldAutoCommit;
314 return "balance after prepay discount attempt: $new_balance";
316 # user friendly: override the "apply only to this invoice" mode
323 if ( $self->invnum ) {
324 my $cust_bill_pay = new FS::cust_bill_pay {
325 'invnum' => $self->invnum,
326 'paynum' => $self->paynum,
327 'amount' => $self->paid,
328 '_date' => $self->_date,
330 $error = $cust_bill_pay->insert(%options);
332 if ( $ignore_noapply ) {
333 warn "warning: error inserting cust_bill_pay: $error ".
334 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
336 $dbh->rollback if $oldAutoCommit;
337 return "error inserting cust_bill_pay: $error";
342 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 #false laziness w/ cust_credit::insert
345 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
346 my @errors = $cust_main->unsuspend;
348 # side-fx with nested transactions? upstack rolls back?
349 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
355 #bill setup fees for voip_cdr bill_every_call packages
356 #some false laziness w/search in freeside-cdrd
358 'LEFT JOIN part_pkg USING ( pkgpart ) '.
359 "LEFT JOIN part_pkg_option
360 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
361 AND part_pkg_option.optionname = 'bill_every_call' )";
363 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
364 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
366 my @cust_pkg = qsearch({
367 'table' => 'cust_pkg',
368 'addl_from' => $addl_from,
369 'hashref' => { 'custnum' => $self->custnum,
373 'extra_sql' => $extra_sql,
377 warn "voip_cdr bill_every_call packages found; billing customer\n";
378 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
380 warn "WARNING: Error billing customer: $bill_error\n";
383 #end of billing setup fees for voip_cdr bill_every_call packages
385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
388 my $trigger = $conf->config('payment_receipt-trigger',
389 $self->cust_main->agentnum) || 'cust_pay';
390 if ( $trigger eq 'cust_pay' ) {
391 my $error = $self->send_receipt(
392 'manual' => $options{'manual'},
393 'cust_bill' => $cust_bill,
394 'cust_main' => $cust_main,
396 warn "can't send payment receipt/statement: $error" if $error;
403 =item void [ REASON ]
405 Voids this payment: deletes the payment and all associated applications and
406 adds a record of the voided payment to the FS::cust_pay_void table.
413 local $SIG{HUP} = 'IGNORE';
414 local $SIG{INT} = 'IGNORE';
415 local $SIG{QUIT} = 'IGNORE';
416 local $SIG{TERM} = 'IGNORE';
417 local $SIG{TSTP} = 'IGNORE';
418 local $SIG{PIPE} = 'IGNORE';
420 my $oldAutoCommit = $FS::UID::AutoCommit;
421 local $FS::UID::AutoCommit = 0;
424 my $cust_pay_void = new FS::cust_pay_void ( {
425 map { $_ => $self->get($_) } $self->fields
427 $cust_pay_void->reason(shift) if scalar(@_);
428 my $error = $cust_pay_void->insert;
430 my $cust_pay_pending =
431 qsearchs('cust_pay_pending', { paynum => $self->paynum });
432 if ( $cust_pay_pending ) {
433 $cust_pay_pending->set('void_paynum', $self->paynum);
434 $cust_pay_pending->set('paynum', '');
435 $error ||= $cust_pay_pending->replace;
438 $error ||= $self->delete;
441 $dbh->rollback if $oldAutoCommit;
445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
453 Unless the closed flag is set, deletes this payment and all associated
454 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
455 cases, you want to use the void method instead to leave a record of the
460 # very similar to FS::cust_credit::delete
463 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
465 local $SIG{HUP} = 'IGNORE';
466 local $SIG{INT} = 'IGNORE';
467 local $SIG{QUIT} = 'IGNORE';
468 local $SIG{TERM} = 'IGNORE';
469 local $SIG{TSTP} = 'IGNORE';
470 local $SIG{PIPE} = 'IGNORE';
472 my $oldAutoCommit = $FS::UID::AutoCommit;
473 local $FS::UID::AutoCommit = 0;
476 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
477 my $error = $app->delete;
479 $dbh->rollback if $oldAutoCommit;
484 my $error = $self->SUPER::delete(@_);
486 $dbh->rollback if $oldAutoCommit;
490 if ( $conf->exists('deletepayments')
491 && $conf->config('deletepayments') ne '' ) {
493 my $cust_main = $self->cust_main;
495 my $error = send_email(
496 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
497 #invoice_from??? well as good as any
498 'to' => $conf->config('deletepayments'),
499 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
501 "This is an automatic message from your Freeside installation\n",
502 "informing you that the following payment has been deleted:\n",
504 'paynum: '. $self->paynum. "\n",
505 'custnum: '. $self->custnum.
506 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
507 'paid: $'. sprintf("%.2f", $self->paid). "\n",
508 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
509 'payby: '. $self->payby. "\n",
510 'payinfo: '. $self->paymask. "\n",
511 'paybatch: '. $self->paybatch. "\n",
516 $dbh->rollback if $oldAutoCommit;
517 return "can't send payment deletion notification: $error";
522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
528 =item replace [ OLD_RECORD ]
530 You can, but probably shouldn't modify payments...
532 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
533 supplied, replaces this record. If there is an error, returns the error,
534 otherwise returns false.
540 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
541 $self->SUPER::replace(@_);
546 Checks all fields to make sure this is a valid payment. If there is an error,
547 returns the error, otherwise returns false. Called by the insert method.
554 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
557 $self->ut_numbern('paynum')
558 || $self->ut_numbern('custnum')
559 || $self->ut_numbern('_date')
560 || $self->ut_money('paid')
561 || $self->ut_alphan('otaker')
562 || $self->ut_textn('paybatch')
563 || $self->ut_textn('payunique')
564 || $self->ut_enum('closed', [ '', 'Y' ])
565 || $self->ut_flag('no_auto_apply')
566 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
567 || $self->ut_textn('bank')
568 || $self->ut_alphan('depositor')
569 || $self->ut_numbern('account')
570 || $self->ut_numbern('teller')
571 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
572 || $self->payinfo_check()
574 return $error if $error;
576 return "paid must be > 0 " if $self->paid <= 0;
578 return "unknown cust_main.custnum: ". $self->custnum
580 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
582 $self->_date(time) unless $self->_date;
584 return "invalid discount_term"
585 if ($self->discount_term && $self->discount_term < 2);
587 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
588 foreach (qw(bank depositor account teller)) {
589 return "$_ required" if $self->get($_) eq '';
593 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
594 # # UNIQUE index should catch this too, without race conditions, but this
595 # # should give a better error message the other 99.9% of the time...
596 # if ( length($self->payunique)
597 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
598 # #well, it *could* be a better error message
599 # return "duplicate transaction".
600 # " - a payment with unique identifer ". $self->payunique.
607 =item send_receipt HASHREF | OPTION => VALUE ...
609 Sends a payment receipt for this payment..
617 Flag indicating the payment is being made manually.
621 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
626 Customer (FS::cust_main) object (for efficiency).
634 my $opt = ref($_[0]) ? shift : { @_ };
636 my $cust_bill = $opt->{'cust_bill'};
637 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
639 my $conf = new FS::Conf;
641 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
643 my @invoicing_list = $cust_main->invoicing_list_emailonly;
644 return '' unless @invoicing_list;
646 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
650 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
651 #|| ! $conf->exists('invoice_html_statement')
655 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
658 my %substitutions = ();
659 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
661 my $queue = new FS::queue {
662 'job' => 'FS::Misc::process_send_email',
663 'paynum' => $self->paynum,
664 'custnum' => $cust_main->custnum,
666 $error = $queue->insert(
667 FS::msg_template->by_key($msgnum)->prepare(
668 'cust_main' => $cust_main,
670 'from_config' => 'payment_receipt_from',
671 'substitutions' => \%substitutions,
673 'msgtype' => 'receipt', # override msg_template's default
676 } elsif ( $conf->exists('payment_receipt_email') ) {
678 my $receipt_template = new Text::Template (
680 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
682 warn "can't create payment receipt template: $Text::Template::ERROR";
686 my $payby = $self->payby;
687 my $payinfo = $self->payinfo;
688 $payby =~ s/^BILL$/Check/ if $payinfo;
689 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
690 $payinfo = $self->paymask
692 $payinfo = $self->decrypt($payinfo);
694 $payby =~ s/^CHEK$/Electronic check/;
697 'date' => time2str("%a %B %o, %Y", $self->_date),
698 'name' => $cust_main->name,
699 'paynum' => $self->paynum,
700 'paid' => sprintf("%.2f", $self->paid),
701 'payby' => ucfirst(lc($payby)),
702 'payinfo' => $payinfo,
703 'balance' => $cust_main->balance,
704 'company_name' => $conf->config('company_name', $cust_main->agentnum),
707 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
709 if ( $opt->{'cust_pkg'} ) {
710 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
711 #setup date, other things?
714 my $queue = new FS::queue {
715 'job' => 'FS::Misc::process_send_generated_email',
716 'paynum' => $self->paynum,
717 'custnum' => $cust_main->custnum,
718 'msgtype' => 'receipt',
720 $error = $queue->insert(
721 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
722 #invoice_from??? well as good as any
723 'to' => \@invoicing_list,
724 'subject' => 'Payment receipt',
725 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
730 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
734 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
736 my $queue = new FS::queue {
737 'job' => 'FS::cust_bill::queueable_email',
738 'paynum' => $self->paynum,
739 'custnum' => $cust_main->custnum,
743 'invnum' => $cust_bill->invnum,
747 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
748 $opt{'mode'} = $mode;
750 # backward compatibility, no good fix for this yet as some people may
751 # still have "invoice_latex_statement" and such options
752 $opt{'template'} = 'statement';
753 $opt{'notice_name'} = 'Statement';
756 $error = $queue->insert(%opt);
760 warn "send_receipt: $error\n" if $error;
765 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
772 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
773 sort { $a->_date <=> $b->_date
774 || $a->invnum <=> $b->invnum }
775 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
779 =item cust_pay_refund
781 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
786 sub cust_pay_refund {
788 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
789 sort { $a->_date <=> $b->_date }
790 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
797 Returns the amount of this payment that is still unapplied; which is
798 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
799 applications (see L<FS::cust_pay_refund>).
805 my $amount = $self->paid;
806 $amount -= $_->amount foreach ( $self->cust_bill_pay );
807 $amount -= $_->amount foreach ( $self->cust_pay_refund );
808 sprintf("%.2f", $amount );
813 Returns the amount of this payment that has not been refuned; which is
814 paid minus all refund applications (see L<FS::cust_pay_refund>).
820 my $amount = $self->paid;
821 $amount -= $_->amount foreach ( $self->cust_pay_refund );
822 sprintf("%.2f", $amount );
827 Returns the "paid" field.
842 =item batch_insert CUST_PAY_OBJECT, ...
844 Class method which inserts multiple payments. Takes a list of FS::cust_pay
845 objects. Returns a list, each element representing the status of inserting the
846 corresponding payment - empty. If there is an error inserting any payment, the
847 entire transaction is rolled back, i.e. all payments are inserted or none are.
849 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
850 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
851 those objects will be inserted with the paynum of the payment, and for
852 each one, an error message or an empty string will be inserted into the
857 my @errors = FS::cust_pay->batch_insert(@cust_pay);
858 my $num_errors = scalar(grep $_, @errors);
859 if ( $num_errors == 0 ) {
860 #success; all payments were inserted
862 #failure; no payments were inserted.
868 my $self = shift; #class method
870 local $SIG{HUP} = 'IGNORE';
871 local $SIG{INT} = 'IGNORE';
872 local $SIG{QUIT} = 'IGNORE';
873 local $SIG{TERM} = 'IGNORE';
874 local $SIG{TSTP} = 'IGNORE';
875 local $SIG{PIPE} = 'IGNORE';
877 my $oldAutoCommit = $FS::UID::AutoCommit;
878 local $FS::UID::AutoCommit = 0;
884 foreach my $cust_pay (@_) {
885 my $error = $cust_pay->insert( 'manual' => 1 );
886 push @errors, $error;
887 $num_errors++ if $error;
889 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
891 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
892 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
896 $cust_bill_pay->set('paynum', $cust_pay->paynum);
897 my $apply_error = $cust_bill_pay->insert;
898 push @errors, $apply_error || '';
899 $num_errors++ if $apply_error;
903 } elsif ( !$error ) { #normal case: apply payments as usual
904 $cust_pay->cust_main->apply_payments;
910 $dbh->rollback if $oldAutoCommit;
912 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
921 Returns an SQL fragment to retreive the unapplied amount.
926 my ($class, $start, $end) = @_;
927 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
928 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
929 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
930 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
934 ( SELECT SUM(amount) FROM cust_bill_pay
935 WHERE cust_pay.paynum = cust_bill_pay.paynum
936 $bill_start $bill_end )
940 ( SELECT SUM(amount) FROM cust_pay_refund
941 WHERE cust_pay.paynum = cust_pay_refund.paynum
942 $refund_start $refund_end )
951 # Used by FS::Upgrade to migrate to a new database.
955 sub _upgrade_data { #class method
956 my ($class, %opt) = @_;
958 warn "$me upgrading $class\n" if $DEBUG;
960 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
963 # otaker/ivan upgrade
966 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
968 #not the most efficient, but hey, it only has to run once
970 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
971 " AND usernum IS NULL ".
972 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
973 " WHERE cust_main.custnum = cust_pay.custnum ) ";
975 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
977 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
978 $sth->execute or die $sth->errstr;
979 my $total = $sth->fetchrow_arrayref->[0];
980 #warn "$total cust_pay records to update\n"
982 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
987 my @cust_pay = qsearch( {
988 'table' => 'cust_pay',
990 'extra_sql' => $where,
991 'order_by' => 'ORDER BY paynum',
994 foreach my $cust_pay (@cust_pay) {
996 my $h_cust_pay = $cust_pay->h_search('insert');
998 next if $cust_pay->otaker eq $h_cust_pay->history_user;
999 #$cust_pay->otaker($h_cust_pay->history_user);
1000 $cust_pay->set('otaker', $h_cust_pay->history_user);
1002 $cust_pay->set('otaker', 'legacy');
1005 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1006 my $error = $cust_pay->replace;
1009 warn " *** WARNING: Error updating order taker for payment paynum ".
1010 $cust_pay->paynun. ": $error\n";
1014 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1017 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1018 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1024 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1028 # payinfo N/A upgrade
1031 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1033 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1035 my @na_cust_pay = qsearch( {
1036 'table' => 'cust_pay',
1037 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1038 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1041 foreach my $na ( @na_cust_pay ) {
1043 next unless $na->payinfo eq 'N/A';
1045 my $cust_pay_pending =
1046 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1047 unless ( $cust_pay_pending ) {
1048 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1049 $na->paynum. " (no cust_pay_pending)\n";
1052 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1053 my $error = $na->replace;
1055 warn " *** WARNING: Error updating payinfo for payment paynum ".
1056 $na->paynun. ": $error\n";
1062 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1066 # otaker->usernum upgrade
1069 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1070 $class->_upgrade_otaker(%opt);
1071 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1073 # if we do this anywhere else, it should become an FS::Upgrade method
1074 my $num_to_upgrade = $class->count('paybatch is not null');
1075 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1076 if ( $num_to_upgrade > 0 ) {
1077 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1078 if ( $opt{queue} ) {
1079 if ( $num_jobs > 0 ) {
1080 warn "Upgrade already queued.\n";
1082 warn "Scheduling upgrade.\n";
1083 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1087 process_upgrade_paybatch();
1092 sub process_upgrade_paybatch {
1094 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1095 local $FS::UID::AutoCommit = 1;
1098 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1100 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1101 my $search = FS::Cursor->new( {
1102 'table' => 'cust_pay',
1103 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1105 while (my $cust_pay = $search->fetch) {
1106 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1107 $cust_pay->set('paybatch' => '');
1108 my $error = $cust_pay->replace;
1109 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1114 # migrate gateway info from the misused 'paybatch' field
1117 # not only cust_pay, but also voided and refunded payments
1118 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1119 local $FS::Record::nowarn_classload=1;
1120 # really inefficient, but again, only has to run once
1121 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1122 my $and_batchnum_is_null =
1123 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1124 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1125 my $search = FS::Cursor->new({
1127 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1128 "AND (paybatch IS NOT NULL ".
1129 "OR (paybatch IS NULL AND auth IS NULL
1130 $and_batchnum_is_null ) )
1131 ORDER BY $pkey DESC"
1133 while ( my $object = $search->fetch ) {
1134 if ( $object->paybatch eq '' ) {
1135 # repair for a previous upgrade that didn't save 'auth'
1136 my $pkey = $object->primary_key;
1137 # find the last history record that had a paybatch value
1139 table => "h_$table",
1141 $pkey => $object->$pkey,
1142 paybatch => { op=>'!=', value=>''},
1143 history_action => 'replace_old',
1145 order_by => 'ORDER BY history_date DESC LIMIT 1',
1148 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1151 # if the paybatch didn't have an auth string, then it's fine
1152 $h->paybatch =~ /:(\w+):/ or next;
1153 # set paybatch to what it was in that record
1154 $object->set('paybatch', $h->paybatch)
1155 # and then upgrade it like the old records
1158 my $parsed = $object->_parse_paybatch;
1159 if (keys %$parsed) {
1160 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1161 $object->set('auth' => $parsed->{authorization});
1162 $object->set('paybatch', '');
1163 my $error = $object->replace;
1164 warn "error parsing CARD/CHEK paybatch fields on $object #".
1165 $object->get($object->primary_key).":\n $error\n"
1170 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1180 =item process_batch_import
1184 sub process_batch_import {
1189 my $custnum = $hash{'custnum'};
1190 my $agentnum = $hash{'agentnum'};
1191 my $agent_custid = $hash{'agent_custid'};
1193 $hash{'_date'} = parse_datetime($hash{'_date'})
1194 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1195 #remove custnum_prefix
1196 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1197 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1200 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1201 && length($1) == $custnum_length
1205 # check agentnum against custnum and
1206 # translate agent_custid into regular custnum
1207 if ($custnum && $agent_custid) {
1208 die "can't specify both custnum and agent_custid\n";
1209 } elsif ($agentnum || $agent_custid) {
1210 # here is the agent virtualization
1211 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1213 $search{'agentnum'} = $agentnum
1215 $search{'agent_custid'} = $agent_custid
1217 $search{'custnum'} = $custnum
1219 my $cust_main = qsearchs({
1220 'table' => 'cust_main',
1221 'hashref' => \%search,
1222 'extra_sql' => $extra_sql,
1224 die "can't find customer with" .
1225 ($agentnum ? " agentnum $agentnum" : '') .
1226 ($custnum ? " custnum $custnum" : '') .
1227 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1229 die "mismatched customer number\n"
1230 if $custnum && ($custnum ne $cust_main->custnum);
1231 $custnum = $cust_main->custnum;
1233 $hash{'custnum'} = $custnum;
1234 delete($hash{'agent_custid'});
1239 'table' => 'cust_pay',
1240 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1241 #agent_custid isn't a cust_pay field, see hash callback
1242 'formats' => { 'simple' =>
1243 [ qw(custnum agent_custid paid payinfo invnum) ] },
1244 'format_types' => { 'simple' => '' }, #force infer from file extension
1245 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1246 'format_hash_callbacks' => { 'simple' => $hashcb },
1247 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1248 'postinsert_callback' => sub {
1249 my $cust_pay = shift;
1250 my $cust_main = $cust_pay->cust_main
1251 or return "can't find customer to which payments apply";
1252 my $error = $cust_main->apply_payments_and_credits;
1254 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1259 FS::Record::process_batch_import( $job, $opt, @_ );
1263 =item batch_import HASHREF
1265 Inserts new payments.
1272 my $fh = $param->{filehandle};
1273 my $format = $param->{'format'};
1275 my $agentnum = $param->{agentnum};
1276 my $_date = $param->{_date};
1277 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1278 my $paybatch = $param->{'paybatch'};
1280 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1281 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1283 # here is the agent virtualization
1284 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1288 if ( $format eq 'simple' ) {
1289 @fields = qw( custnum agent_custid paid payinfo invnum );
1291 } elsif ( $format eq 'extended' ) {
1292 die "unimplemented\n";
1296 die "unknown format $format";
1299 eval "use Text::CSV_XS;";
1302 my $csv = new Text::CSV_XS;
1306 local $SIG{HUP} = 'IGNORE';
1307 local $SIG{INT} = 'IGNORE';
1308 local $SIG{QUIT} = 'IGNORE';
1309 local $SIG{TERM} = 'IGNORE';
1310 local $SIG{TSTP} = 'IGNORE';
1311 local $SIG{PIPE} = 'IGNORE';
1313 my $oldAutoCommit = $FS::UID::AutoCommit;
1314 local $FS::UID::AutoCommit = 0;
1318 while ( defined($line=<$fh>) ) {
1320 $csv->parse($line) or do {
1321 $dbh->rollback if $oldAutoCommit;
1322 return "can't parse: ". $csv->error_input();
1325 my @columns = $csv->fields();
1329 paybatch => $paybatch,
1331 $cust_pay{_date} = $_date if $_date;
1334 foreach my $field ( @fields ) {
1336 if ( $field eq 'agent_custid'
1338 && $columns[0] =~ /\S+/ )
1341 my $agent_custid = $columns[0];
1342 my %hash = ( 'agent_custid' => $agent_custid,
1343 'agentnum' => $agentnum,
1346 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1347 $dbh->rollback if $oldAutoCommit;
1348 return "can't specify custnum with agent_custid $agent_custid";
1351 $cust_main = qsearchs({
1352 'table' => 'cust_main',
1353 'hashref' => \%hash,
1354 'extra_sql' => $extra_sql,
1357 unless ( $cust_main ) {
1358 $dbh->rollback if $oldAutoCommit;
1359 return "can't find customer with agent_custid $agent_custid";
1363 $columns[0] = $cust_main->custnum;
1366 $cust_pay{$field} = shift @columns;
1369 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1370 && length($1) == $custnum_length ) {
1371 $cust_pay{custnum} = $2;
1374 my $custnum = $cust_pay{custnum};
1376 my $cust_pay = new FS::cust_pay( \%cust_pay );
1377 my $error = $cust_pay->insert;
1379 if ( ! $error && $cust_pay->custnum != $custnum ) {
1380 #invnum was defined, and ->insert set custnum to the customer for that
1381 #invoice, but it wasn't the one the import specified.
1382 $dbh->rollback if $oldAutoCommit;
1383 $error = "specified invoice #". $cust_pay{invnum}.
1384 " is for custnum ". $cust_pay->custnum.
1385 ", not specified custnum $custnum";
1389 $dbh->rollback if $oldAutoCommit;
1390 return "can't insert payment for $line: $error";
1393 if ( $format eq 'simple' ) {
1394 # include agentnum for less surprise?
1395 $cust_main = qsearchs({
1396 'table' => 'cust_main',
1397 'hashref' => { 'custnum' => $cust_pay->custnum },
1398 'extra_sql' => $extra_sql,
1402 unless ( $cust_main ) {
1403 $dbh->rollback if $oldAutoCommit;
1404 return "can't find customer to which payments apply at line: $line";
1407 $error = $cust_main->apply_payments_and_credits;
1409 $dbh->rollback if $oldAutoCommit;
1410 return "can't apply payments to customer for $line: $error";
1418 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1420 return "Empty file!" unless $imported;
1430 Delete and replace methods.
1434 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1435 schema.html from the base documentation.