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 The bank where the payment was deposited.
125 The name of the depositor.
129 The deposit account number.
137 The number of the batch this payment came from (see L<FS::pay_batch>),
138 or null if it was processed through a realtime gateway or entered manually.
142 The number of the realtime or batch gateway L<FS::payment_gateway>) this
143 payment was processed through. Null if it was entered manually or processed
144 by the "system default" gateway, which doesn't have a number.
148 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
149 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
150 redundant with C<gatewaynum>.
154 The authorization number returned by the credit card network.
158 The transaction ID returned by the gateway, if any. This is usually what
159 you would use to initiate a void or refund of the payment.
169 Creates a new payment. To add the payment to the databse, see L<"insert">.
173 sub table { 'cust_pay'; }
174 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum; }
175 sub cust_unlinked_msg {
177 "WARNING: can't find cust_main.custnum ". $self->custnum.
178 ' (cust_pay.paynum '. $self->paynum. ')';
181 =item insert [ OPTION => VALUE ... ]
183 Adds this payment to the database.
185 For backwards-compatibility and convenience, if the additional field invnum
186 is defined, an FS::cust_bill_pay record for the full amount of the payment
187 will be created. In this case, custnum is optional.
189 If the additional field discount_term is defined then a prepayment discount
190 is taken for that length of time. It is an error for the customer to owe
191 after this payment is made.
193 A hash of optional arguments may be passed. The following arguments are
200 If true, a payment receipt is sent instead of a statement when
201 'payment_receipt_email' configuration option is set.
203 About the "manual" flag: Normally, if the 'payment_receipt' config option
204 is set, and the customer has an invoice email address, inserting a payment
205 causes a I<statement> to be emailed to the customer. If the payment is
206 considered "manual" (or if the customer has no invoices), then it will
207 instead send a I<payment receipt>. "manual" should be true whenever a
208 payment is created directly from the web interface, from a user-initiated
209 realtime payment, or from a third-party payment via self-service. It should
210 be I<false> when creating a payment from a billing event or from a batch.
214 Don't send an email receipt. (Note: does not currently work when
215 payment_receipt-trigger is set to something other than default / cust_bill)
222 my($self, %options) = @_;
224 local $SIG{HUP} = 'IGNORE';
225 local $SIG{INT} = 'IGNORE';
226 local $SIG{QUIT} = 'IGNORE';
227 local $SIG{TERM} = 'IGNORE';
228 local $SIG{TSTP} = 'IGNORE';
229 local $SIG{PIPE} = 'IGNORE';
231 my $oldAutoCommit = $FS::UID::AutoCommit;
232 local $FS::UID::AutoCommit = 0;
236 if ( $self->invnum ) {
237 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
239 $dbh->rollback if $oldAutoCommit;
240 return "Unknown cust_bill.invnum: ". $self->invnum;
242 $self->custnum($cust_bill->custnum );
245 my $error = $self->check;
246 return $error if $error;
248 my $cust_main = $self->cust_main;
249 my $old_balance = $cust_main->balance;
251 $error = $self->SUPER::insert;
253 $dbh->rollback if $oldAutoCommit;
254 return "error inserting cust_pay: $error";
257 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
258 if ( my $months = $self->discount_term ) {
259 # XXX this should be moved out somewhere, but discount_term_values
261 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
262 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
264 # %billing_pkgs contains this customer's active monthly packages.
265 # Recurring fees for those packages will be credited and then rebilled
266 # for the full discount term. Other packages on the last invoice
267 # (canceled, non-monthly recurring, or one-time charges) will be
269 my %billing_pkgs = map { $_->pkgnum => $_ }
270 grep { $_->part_pkg->freq eq '1' }
271 $cust_main->billing_pkgs;
272 my $credit = 0; # sum of recurring charges from that invoice
273 my $last_bill_date = 0; # the real bill date
274 foreach my $item ( $cust_bill->cust_bill_pkg ) {
275 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
276 $credit += $item->recur;
277 $last_bill_date = $item->cust_pkg->last_bill
278 if defined($item->cust_pkg)
279 and $item->cust_pkg->last_bill > $last_bill_date
282 my $cust_credit = new FS::cust_credit {
283 'custnum' => $self->custnum,
284 'amount' => sprintf('%.2f', $credit),
285 'reason' => 'customer chose to prepay for discount',
287 $error = $cust_credit->insert('reason_type' => $credit_type);
289 $dbh->rollback if $oldAutoCommit;
290 return "error inserting prepayment credit: $error";
294 # bill for the entire term
295 $_->bill($_->last_bill) foreach (values %billing_pkgs);
296 $error = $cust_main->bill(
297 # no recurring_only, we want unbilled packages with start dates to
299 'no_usage_reset' => 1,
300 'time' => $last_bill_date, # not $cust_bill->_date
301 'pkg_list' => [ values %billing_pkgs ],
302 'freq_override' => $months,
305 $dbh->rollback if $oldAutoCommit;
306 return "error inserting cust_pay: $error";
308 $error = $cust_main->apply_payments_and_credits;
310 $dbh->rollback if $oldAutoCommit;
311 return "error inserting cust_pay: $error";
313 my $new_balance = $cust_main->balance;
314 if ($new_balance > 0) {
315 $dbh->rollback if $oldAutoCommit;
316 return "balance after prepay discount attempt: $new_balance";
318 # user friendly: override the "apply only to this invoice" mode
325 if ( $self->invnum ) {
326 my $cust_bill_pay = new FS::cust_bill_pay {
327 'invnum' => $self->invnum,
328 'paynum' => $self->paynum,
329 'amount' => $self->paid,
330 '_date' => $self->_date,
332 $error = $cust_bill_pay->insert(%options);
334 if ( $ignore_noapply ) {
335 warn "warning: error inserting cust_bill_pay: $error ".
336 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
338 $dbh->rollback if $oldAutoCommit;
339 return "error inserting cust_bill_pay: $error";
344 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
346 #false laziness w/ cust_credit::insert
347 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
348 my @errors = $cust_main->unsuspend;
350 # side-fx with nested transactions? upstack rolls back?
351 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
357 #bill setup fees for voip_cdr bill_every_call packages
358 #some false laziness w/search in freeside-cdrd
360 'LEFT JOIN part_pkg USING ( pkgpart ) '.
361 "LEFT JOIN part_pkg_option
362 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
363 AND part_pkg_option.optionname = 'bill_every_call' )";
365 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
366 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
368 my @cust_pkg = qsearch({
369 'table' => 'cust_pkg',
370 'addl_from' => $addl_from,
371 'hashref' => { 'custnum' => $self->custnum,
375 'extra_sql' => $extra_sql,
379 warn "voip_cdr bill_every_call packages found; billing customer\n";
380 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
382 warn "WARNING: Error billing customer: $bill_error\n";
385 #end of billing setup fees for voip_cdr bill_every_call packages
387 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
390 my $trigger = $conf->config('payment_receipt-trigger',
391 $self->cust_main->agentnum) || 'cust_pay';
392 if ( $trigger eq 'cust_pay' ) {
393 my $error = $self->send_receipt(
394 'manual' => $options{'manual'},
395 'noemail' => $options{'noemail'},
396 'cust_bill' => $cust_bill,
397 'cust_main' => $cust_main,
399 warn "can't send payment receipt/statement: $error" if $error;
406 =item void [ REASON ]
408 Voids this payment: deletes the payment and all associated applications and
409 adds a record of the voided payment to the FS::cust_pay_void table.
416 local $SIG{HUP} = 'IGNORE';
417 local $SIG{INT} = 'IGNORE';
418 local $SIG{QUIT} = 'IGNORE';
419 local $SIG{TERM} = 'IGNORE';
420 local $SIG{TSTP} = 'IGNORE';
421 local $SIG{PIPE} = 'IGNORE';
423 my $oldAutoCommit = $FS::UID::AutoCommit;
424 local $FS::UID::AutoCommit = 0;
427 my $cust_pay_void = new FS::cust_pay_void ( {
428 map { $_ => $self->get($_) } $self->fields
430 $cust_pay_void->reason(shift) if scalar(@_);
431 my $error = $cust_pay_void->insert;
433 my $cust_pay_pending =
434 qsearchs('cust_pay_pending', { paynum => $self->paynum });
435 if ( $cust_pay_pending ) {
436 $cust_pay_pending->set('void_paynum', $self->paynum);
437 $cust_pay_pending->set('paynum', '');
438 $error ||= $cust_pay_pending->replace;
441 $error ||= $self->delete;
444 $dbh->rollback if $oldAutoCommit;
448 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
456 Unless the closed flag is set, deletes this payment and all associated
457 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
458 cases, you want to use the void method instead to leave a record of the
463 # very similar to FS::cust_credit::delete
466 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
468 local $SIG{HUP} = 'IGNORE';
469 local $SIG{INT} = 'IGNORE';
470 local $SIG{QUIT} = 'IGNORE';
471 local $SIG{TERM} = 'IGNORE';
472 local $SIG{TSTP} = 'IGNORE';
473 local $SIG{PIPE} = 'IGNORE';
475 my $oldAutoCommit = $FS::UID::AutoCommit;
476 local $FS::UID::AutoCommit = 0;
479 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
480 my $error = $app->delete;
482 $dbh->rollback if $oldAutoCommit;
487 my $error = $self->SUPER::delete(@_);
489 $dbh->rollback if $oldAutoCommit;
493 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
499 =item replace [ OLD_RECORD ]
501 You can, but probably shouldn't modify payments...
503 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
504 supplied, replaces this record. If there is an error, returns the error,
505 otherwise returns false.
511 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
512 $self->SUPER::replace(@_);
517 Checks all fields to make sure this is a valid payment. If there is an error,
518 returns the error, otherwise returns false. Called by the insert method.
525 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
528 $self->ut_numbern('paynum')
529 || $self->ut_numbern('custnum')
530 || $self->ut_numbern('_date')
531 || $self->ut_money('paid')
532 || $self->ut_alphan('otaker')
533 || $self->ut_textn('paybatch')
534 || $self->ut_textn('payunique')
535 || $self->ut_enum('closed', [ '', 'Y' ])
536 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
537 || $self->ut_textn('bank')
538 || $self->ut_alphan('depositor')
539 || $self->ut_numbern('account')
540 || $self->ut_numbern('teller')
541 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
542 || $self->payinfo_check()
544 return $error if $error;
546 return "paid must be > 0 " if $self->paid <= 0;
548 return "unknown cust_main.custnum: ". $self->custnum
550 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
552 $self->_date(time) unless $self->_date;
554 return "invalid discount_term"
555 if ($self->discount_term && $self->discount_term < 2);
557 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
558 foreach (qw(bank depositor account teller)) {
559 return "$_ required" if $self->get($_) eq '';
563 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
564 # # UNIQUE index should catch this too, without race conditions, but this
565 # # should give a better error message the other 99.9% of the time...
566 # if ( length($self->payunique)
567 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
568 # #well, it *could* be a better error message
569 # return "duplicate transaction".
570 # " - a payment with unique identifer ". $self->payunique.
577 =item send_receipt HASHREF | OPTION => VALUE ...
579 Sends a payment receipt for this payment..
587 Flag indicating the payment is being made manually.
591 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
596 Customer (FS::cust_main) object (for efficiency).
600 Don't send an email receipt.
610 my $opt = ref($_[0]) ? shift : { @_ };
612 my $cust_bill = $opt->{'cust_bill'};
613 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
615 my $conf = new FS::Conf;
617 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
619 my @invoicing_list = $cust_main->invoicing_list_emailonly;
620 return '' unless @invoicing_list;
622 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
626 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
627 #|| ! $conf->exists('invoice_html_statement')
631 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
634 my %substitutions = ();
635 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
637 my $queue = new FS::queue {
638 'job' => 'FS::Misc::process_send_email',
639 'paynum' => $self->paynum,
640 'custnum' => $cust_main->custnum,
642 $error = $queue->insert(
643 FS::msg_template->by_key($msgnum)->prepare(
644 'cust_main' => $cust_main,
646 'from_config' => 'payment_receipt_from',
647 'substitutions' => \%substitutions,
649 'msgtype' => 'receipt', # override msg_template's default
652 } elsif ( $conf->exists('payment_receipt_email') ) {
654 my $receipt_template = new Text::Template (
656 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
658 warn "can't create payment receipt template: $Text::Template::ERROR";
662 my $payby = $self->payby;
663 my $payinfo = $self->payinfo;
664 $payby =~ s/^BILL$/Check/ if $payinfo;
665 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
666 $payinfo = $self->paymask
668 $payinfo = $self->decrypt($payinfo);
670 $payby =~ s/^CHEK$/Electronic check/;
673 'date' => time2str("%a %B %o, %Y", $self->_date),
674 'name' => $cust_main->name,
675 'paynum' => $self->paynum,
676 'paid' => sprintf("%.2f", $self->paid),
677 'payby' => ucfirst(lc($payby)),
678 'payinfo' => $payinfo,
679 'balance' => $cust_main->balance,
680 'company_name' => $conf->config('company_name', $cust_main->agentnum),
683 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
685 if ( $opt->{'cust_pkg'} ) {
686 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
687 #setup date, other things?
690 my $queue = new FS::queue {
691 'job' => 'FS::Misc::process_send_generated_email',
692 'paynum' => $self->paynum,
693 'custnum' => $cust_main->custnum,
694 'msgtype' => 'receipt',
696 $error = $queue->insert(
697 'from' => $conf->config('invoice_from', $cust_main->agentnum),
698 #invoice_from??? well as good as any
699 'to' => \@invoicing_list,
700 'subject' => 'Payment receipt',
701 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
706 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
710 #not manual and no noemail flag (here or on the customer)
711 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
713 my $queue = new FS::queue {
714 'job' => 'FS::cust_bill::queueable_email',
715 'paynum' => $self->paynum,
716 'custnum' => $cust_main->custnum,
719 $error = $queue->insert(
720 'invnum' => $cust_bill->invnum,
721 'template' => 'statement',
722 'notice_name' => 'Statement',
728 warn "send_receipt: $error\n" if $error;
733 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
740 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
741 sort { $a->_date <=> $b->_date
742 || $a->invnum <=> $b->invnum }
743 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
747 =item cust_pay_refund
749 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
754 sub cust_pay_refund {
756 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
757 sort { $a->_date <=> $b->_date }
758 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
765 Returns the amount of this payment that is still unapplied; which is
766 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
767 applications (see L<FS::cust_pay_refund>).
773 my $amount = $self->paid;
774 $amount -= $_->amount foreach ( $self->cust_bill_pay );
775 $amount -= $_->amount foreach ( $self->cust_pay_refund );
776 sprintf("%.2f", $amount );
781 Returns the amount of this payment that has not been refuned; which is
782 paid minus all refund applications (see L<FS::cust_pay_refund>).
788 my $amount = $self->paid;
789 $amount -= $_->amount foreach ( $self->cust_pay_refund );
790 sprintf("%.2f", $amount );
795 Returns the "paid" field.
810 =item batch_insert CUST_PAY_OBJECT, ...
812 Class method which inserts multiple payments. Takes a list of FS::cust_pay
813 objects. Returns a list, each element representing the status of inserting the
814 corresponding payment - empty. If there is an error inserting any payment, the
815 entire transaction is rolled back, i.e. all payments are inserted or none are.
817 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
818 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
819 those objects will be inserted with the paynum of the payment, and for
820 each one, an error message or an empty string will be inserted into the
825 my @errors = FS::cust_pay->batch_insert(@cust_pay);
826 my $num_errors = scalar(grep $_, @errors);
827 if ( $num_errors == 0 ) {
828 #success; all payments were inserted
830 #failure; no payments were inserted.
836 my $self = shift; #class method
838 local $SIG{HUP} = 'IGNORE';
839 local $SIG{INT} = 'IGNORE';
840 local $SIG{QUIT} = 'IGNORE';
841 local $SIG{TERM} = 'IGNORE';
842 local $SIG{TSTP} = 'IGNORE';
843 local $SIG{PIPE} = 'IGNORE';
845 my $oldAutoCommit = $FS::UID::AutoCommit;
846 local $FS::UID::AutoCommit = 0;
852 foreach my $cust_pay (@_) {
853 my $error = $cust_pay->insert( 'manual' => 1 );
854 push @errors, $error;
855 $num_errors++ if $error;
857 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
859 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
860 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
864 $cust_bill_pay->set('paynum', $cust_pay->paynum);
865 my $apply_error = $cust_bill_pay->insert;
866 push @errors, $apply_error || '';
867 $num_errors++ if $apply_error;
871 } elsif ( !$error ) { #normal case: apply payments as usual
872 $cust_pay->cust_main->apply_payments;
878 $dbh->rollback if $oldAutoCommit;
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
889 Returns an SQL fragment to retreive the unapplied amount.
894 my ($class, $start, $end) = @_;
895 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
896 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
897 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
898 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
902 ( SELECT SUM(amount) FROM cust_bill_pay
903 WHERE cust_pay.paynum = cust_bill_pay.paynum
904 $bill_start $bill_end )
908 ( SELECT SUM(amount) FROM cust_pay_refund
909 WHERE cust_pay.paynum = cust_pay_refund.paynum
910 $refund_start $refund_end )
919 my @fields = grep { $_ ne 'payinfo' } $self->fields;
920 +{ ( map { $_=>$self->$_ } @fields ),
926 # Used by FS::Upgrade to migrate to a new database.
930 sub _upgrade_data { #class method
931 my ($class, %opt) = @_;
933 warn "$me upgrading $class\n" if $DEBUG;
935 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
938 # otaker/ivan upgrade
941 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
943 #not the most efficient, but hey, it only has to run once
945 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
946 " AND usernum IS NULL ".
947 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
948 " WHERE cust_main.custnum = cust_pay.custnum ) ";
950 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
952 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
953 $sth->execute or die $sth->errstr;
954 my $total = $sth->fetchrow_arrayref->[0];
955 #warn "$total cust_pay records to update\n"
957 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
962 my @cust_pay = qsearch( {
963 'table' => 'cust_pay',
965 'extra_sql' => $where,
966 'order_by' => 'ORDER BY paynum',
969 foreach my $cust_pay (@cust_pay) {
971 my $h_cust_pay = $cust_pay->h_search('insert');
973 next if $cust_pay->otaker eq $h_cust_pay->history_user;
974 #$cust_pay->otaker($h_cust_pay->history_user);
975 $cust_pay->set('otaker', $h_cust_pay->history_user);
977 $cust_pay->set('otaker', 'legacy');
980 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
981 my $error = $cust_pay->replace;
984 warn " *** WARNING: Error updating order taker for payment paynum ".
985 $cust_pay->paynun. ": $error\n";
989 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
992 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
993 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
999 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1003 # payinfo N/A upgrade
1006 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1008 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1010 my @na_cust_pay = qsearch( {
1011 'table' => 'cust_pay',
1012 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1013 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1016 foreach my $na ( @na_cust_pay ) {
1018 next unless $na->payinfo eq 'N/A';
1020 my $cust_pay_pending =
1021 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1022 unless ( $cust_pay_pending ) {
1023 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1024 $na->paynum. " (no cust_pay_pending)\n";
1027 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1028 my $error = $na->replace;
1030 warn " *** WARNING: Error updating payinfo for payment paynum ".
1031 $na->paynun. ": $error\n";
1037 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1041 # otaker->usernum upgrade
1044 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1045 $class->_upgrade_otaker(%opt);
1046 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1048 # if we do this anywhere else, it should become an FS::Upgrade method
1049 my $num_to_upgrade = $class->count('paybatch is not null');
1050 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1051 if ( $num_to_upgrade > 0 ) {
1052 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1053 if ( $opt{queue} ) {
1054 if ( $num_jobs > 0 ) {
1055 warn "Upgrade already queued.\n";
1057 warn "Scheduling upgrade.\n";
1058 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1062 process_upgrade_paybatch();
1067 sub process_upgrade_paybatch {
1069 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1070 local $FS::UID::AutoCommit = 1;
1073 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1075 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1076 my $search = FS::Cursor->new( {
1077 'table' => 'cust_pay',
1078 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1080 while (my $cust_pay = $search->fetch) {
1081 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1082 $cust_pay->set('paybatch' => '');
1083 my $error = $cust_pay->replace;
1084 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1089 # migrate gateway info from the misused 'paybatch' field
1092 # not only cust_pay, but also voided and refunded payments
1093 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1094 local $FS::Record::nowarn_classload=1;
1095 # really inefficient, but again, only has to run once
1096 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1097 my $and_batchnum_is_null =
1098 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1099 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1100 my $search = FS::Cursor->new({
1102 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1103 "AND (paybatch IS NOT NULL ".
1104 "OR (paybatch IS NULL AND auth IS NULL
1105 $and_batchnum_is_null ) )
1106 ORDER BY $pkey DESC"
1108 while ( my $object = $search->fetch ) {
1109 if ( $object->paybatch eq '' ) {
1110 # repair for a previous upgrade that didn't save 'auth'
1111 my $pkey = $object->primary_key;
1112 # find the last history record that had a paybatch value
1114 table => "h_$table",
1116 $pkey => $object->$pkey,
1117 paybatch => { op=>'!=', value=>''},
1118 history_action => 'replace_old',
1120 order_by => 'ORDER BY history_date DESC LIMIT 1',
1123 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1126 # if the paybatch didn't have an auth string, then it's fine
1127 $h->paybatch =~ /:(\w+):/ or next;
1128 # set paybatch to what it was in that record
1129 $object->set('paybatch', $h->paybatch)
1130 # and then upgrade it like the old records
1133 my $parsed = $object->_parse_paybatch;
1134 if (keys %$parsed) {
1135 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1136 $object->set('auth' => $parsed->{authorization});
1137 $object->set('paybatch', '');
1138 my $error = $object->replace;
1139 warn "error parsing CARD/CHEK paybatch fields on $object #".
1140 $object->get($object->primary_key).":\n $error\n"
1145 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1155 =item batch_import HASHREF
1157 Inserts new payments.
1164 my $fh = $param->{filehandle};
1165 my $format = $param->{'format'};
1167 my $agentnum = $param->{agentnum};
1168 my $_date = $param->{_date};
1169 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1170 my $paybatch = $param->{'paybatch'};
1172 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1173 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1175 # here is the agent virtualization
1176 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1180 if ( $format eq 'simple' ) {
1181 @fields = qw( custnum agent_custid paid payinfo invnum );
1183 } elsif ( $format eq 'extended' ) {
1184 die "unimplemented\n";
1188 die "unknown format $format";
1191 eval "use Text::CSV_XS;";
1194 my $csv = new Text::CSV_XS;
1198 local $SIG{HUP} = 'IGNORE';
1199 local $SIG{INT} = 'IGNORE';
1200 local $SIG{QUIT} = 'IGNORE';
1201 local $SIG{TERM} = 'IGNORE';
1202 local $SIG{TSTP} = 'IGNORE';
1203 local $SIG{PIPE} = 'IGNORE';
1205 my $oldAutoCommit = $FS::UID::AutoCommit;
1206 local $FS::UID::AutoCommit = 0;
1210 while ( defined($line=<$fh>) ) {
1212 $csv->parse($line) or do {
1213 $dbh->rollback if $oldAutoCommit;
1214 return "can't parse: ". $csv->error_input();
1217 my @columns = $csv->fields();
1221 paybatch => $paybatch,
1223 $cust_pay{_date} = $_date if $_date;
1226 foreach my $field ( @fields ) {
1228 if ( $field eq 'agent_custid'
1230 && $columns[0] =~ /\S+/ )
1233 my $agent_custid = $columns[0];
1234 my %hash = ( 'agent_custid' => $agent_custid,
1235 'agentnum' => $agentnum,
1238 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1239 $dbh->rollback if $oldAutoCommit;
1240 return "can't specify custnum with agent_custid $agent_custid";
1243 $cust_main = qsearchs({
1244 'table' => 'cust_main',
1245 'hashref' => \%hash,
1246 'extra_sql' => $extra_sql,
1249 unless ( $cust_main ) {
1250 $dbh->rollback if $oldAutoCommit;
1251 return "can't find customer with agent_custid $agent_custid";
1255 $columns[0] = $cust_main->custnum;
1258 $cust_pay{$field} = shift @columns;
1261 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1262 && length($1) == $custnum_length ) {
1263 $cust_pay{custnum} = $2;
1266 my $custnum = $cust_pay{custnum};
1268 my $cust_pay = new FS::cust_pay( \%cust_pay );
1269 my $error = $cust_pay->insert;
1271 if ( ! $error && $cust_pay->custnum != $custnum ) {
1272 #invnum was defined, and ->insert set custnum to the customer for that
1273 #invoice, but it wasn't the one the import specified.
1274 $dbh->rollback if $oldAutoCommit;
1275 $error = "specified invoice #". $cust_pay{invnum}.
1276 " is for custnum ". $cust_pay->custnum.
1277 ", not specified custnum $custnum";
1281 $dbh->rollback if $oldAutoCommit;
1282 return "can't insert payment for $line: $error";
1285 if ( $format eq 'simple' ) {
1286 # include agentnum for less surprise?
1287 $cust_main = qsearchs({
1288 'table' => 'cust_main',
1289 'hashref' => { 'custnum' => $cust_pay->custnum },
1290 'extra_sql' => $extra_sql,
1294 unless ( $cust_main ) {
1295 $dbh->rollback if $oldAutoCommit;
1296 return "can't find customer to which payments apply at line: $line";
1299 $error = $cust_main->apply_payments_and_credits;
1301 $dbh->rollback if $oldAutoCommit;
1302 return "can't apply payments to customer for $line: $error";
1310 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1312 return "Empty file!" unless $imported;
1322 Delete and replace methods.
1326 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1327 schema.html from the base documentation.