4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
6 use vars qw( $DEBUG $me $conf @encrypted_fields
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 {
40 @encrypted_fields = ('payinfo');
41 sub nohistory_fields { ('payinfo'); }
45 FS::cust_pay - Object methods for cust_pay objects
51 $record = new FS::cust_pay \%hash;
52 $record = new FS::cust_pay { 'column' => 'value' };
54 $error = $record->insert;
56 $error = $new_record->replace($old_record);
58 $error = $record->delete;
60 $error = $record->check;
64 An FS::cust_pay object represents a payment; the transfer of money from a
65 customer. FS::cust_pay inherits from FS::Record. The following fields are
72 primary key (assigned automatically for new payments)
76 customer (see L<FS::cust_main>)
80 specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
81 L<Time::Local> and L<Date::Parse> for conversion functions.
85 Amount of this payment
89 order taker (see L<FS::access_user>)
93 Payment Type (See L<FS::payinfo_Mixin> for valid values)
97 Payment Information (See L<FS::payinfo_Mixin> for data format)
101 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
105 obsolete text field for tracking card processing or other batch grouping
109 Optional unique identifer to prevent duplicate transactions.
113 books closed flag, empty or `Y'
117 Desired pkgnum when using experimental package balances.
121 Flag to only allow manual application of payment, empty or 'Y'
125 The bank where the payment was deposited.
129 The name of the depositor.
133 The deposit account number.
141 The number of the batch this payment came from (see L<FS::pay_batch>),
142 or null if it was processed through a realtime gateway or entered manually.
146 The number of the realtime or batch gateway L<FS::payment_gateway>) this
147 payment was processed through. Null if it was entered manually or processed
148 by the "system default" gateway, which doesn't have a number.
152 The name of the processor module (Business::OnlinePayment, ::BatchPayment,
153 or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly
154 redundant with C<gatewaynum>.
158 The authorization number returned by the credit card network.
162 The transaction ID returned by the gateway, if any. This is usually what
163 you would use to initiate a void or refund of the payment.
173 Creates a new payment. To add the payment to the databse, see L<"insert">.
177 sub table { 'cust_pay'; }
178 sub cust_linked { $_[0]->cust_main_custnum; }
179 sub cust_unlinked_msg {
181 "WARNING: can't find cust_main.custnum ". $self->custnum.
182 ' (cust_pay.paynum '. $self->paynum. ')';
185 =item insert [ OPTION => VALUE ... ]
187 Adds this payment to the database.
189 For backwards-compatibility and convenience, if the additional field invnum
190 is defined, an FS::cust_bill_pay record for the full amount of the payment
191 will be created. In this case, custnum is optional.
193 If the additional field discount_term is defined then a prepayment discount
194 is taken for that length of time. It is an error for the customer to owe
195 after this payment is made.
197 A hash of optional arguments may be passed. Currently "manual" is supported.
198 If true, a payment receipt is sent instead of a statement when
199 'payment_receipt_email' configuration option is set.
201 About the "manual" flag: Normally, if the 'payment_receipt' config option
202 is set, and the customer has an invoice email address, inserting a payment
203 causes a I<statement> to be emailed to the customer. If the payment is
204 considered "manual" (or if the customer has no invoices), then it will
205 instead send a I<payment receipt>. "manual" should be true whenever a
206 payment is created directly from the web interface, from a user-initiated
207 realtime payment, or from a third-party payment via self-service. It should
208 be I<false> when creating a payment from a billing event or from a batch.
213 my($self, %options) = @_;
215 local $SIG{HUP} = 'IGNORE';
216 local $SIG{INT} = 'IGNORE';
217 local $SIG{QUIT} = 'IGNORE';
218 local $SIG{TERM} = 'IGNORE';
219 local $SIG{TSTP} = 'IGNORE';
220 local $SIG{PIPE} = 'IGNORE';
222 my $oldAutoCommit = $FS::UID::AutoCommit;
223 local $FS::UID::AutoCommit = 0;
227 if ( $self->invnum ) {
228 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
230 $dbh->rollback if $oldAutoCommit;
231 return "Unknown cust_bill.invnum: ". $self->invnum;
233 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
234 $dbh->rollback if $oldAutoCommit;
235 return "Invoice custnum ".$cust_bill->custnum
236 ." does not match specified custnum ".$self->custnum
237 ." for invoice ".$self->invnum;
239 $self->custnum($cust_bill->custnum );
242 my $error = $self->check;
243 return $error if $error;
245 my $cust_main = $self->cust_main;
246 my $old_balance = $cust_main->balance;
248 $error = $self->SUPER::insert;
250 $dbh->rollback if $oldAutoCommit;
251 return "error inserting cust_pay: $error";
254 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
255 if ( my $months = $self->discount_term ) {
256 # XXX this should be moved out somewhere, but discount_term_values
258 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
259 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
261 # %billing_pkgs contains this customer's active monthly packages.
262 # Recurring fees for those packages will be credited and then rebilled
263 # for the full discount term. Other packages on the last invoice
264 # (canceled, non-monthly recurring, or one-time charges) will be
266 my %billing_pkgs = map { $_->pkgnum => $_ }
267 grep { $_->part_pkg->freq eq '1' }
268 $cust_main->billing_pkgs;
269 my $credit = 0; # sum of recurring charges from that invoice
270 my $last_bill_date = 0; # the real bill date
271 foreach my $item ( $cust_bill->cust_bill_pkg ) {
272 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
273 $credit += $item->recur;
274 $last_bill_date = $item->cust_pkg->last_bill
275 if defined($item->cust_pkg)
276 and $item->cust_pkg->last_bill > $last_bill_date
279 my $cust_credit = new FS::cust_credit {
280 'custnum' => $self->custnum,
281 'amount' => sprintf('%.2f', $credit),
282 'reason' => 'customer chose to prepay for discount',
284 $error = $cust_credit->insert('reason_type' => $credit_type);
286 $dbh->rollback if $oldAutoCommit;
287 return "error inserting prepayment credit: $error";
291 # bill for the entire term
292 $_->bill($_->last_bill) foreach (values %billing_pkgs);
293 $error = $cust_main->bill(
294 # no recurring_only, we want unbilled packages with start dates to
296 'no_usage_reset' => 1,
297 'time' => $last_bill_date, # not $cust_bill->_date
298 'pkg_list' => [ values %billing_pkgs ],
299 'freq_override' => $months,
302 $dbh->rollback if $oldAutoCommit;
303 return "error inserting cust_pay: $error";
305 $error = $cust_main->apply_payments_and_credits;
307 $dbh->rollback if $oldAutoCommit;
308 return "error inserting cust_pay: $error";
310 my $new_balance = $cust_main->balance;
311 if ($new_balance > 0) {
312 $dbh->rollback if $oldAutoCommit;
313 return "balance after prepay discount attempt: $new_balance";
315 # user friendly: override the "apply only to this invoice" mode
322 if ( $self->invnum ) {
323 my $cust_bill_pay = new FS::cust_bill_pay {
324 'invnum' => $self->invnum,
325 'paynum' => $self->paynum,
326 'amount' => $self->paid,
327 '_date' => $self->_date,
329 $error = $cust_bill_pay->insert(%options);
331 if ( $ignore_noapply ) {
332 warn "warning: error inserting cust_bill_pay: $error ".
333 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
335 $dbh->rollback if $oldAutoCommit;
336 return "error inserting cust_bill_pay: $error";
341 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
343 # possibly trigger package unsuspend, doesn't abort transaction on failure
344 $self->unsuspend_balance if $old_balance;
346 #bill setup fees for voip_cdr bill_every_call packages
347 #some false laziness w/search in freeside-cdrd
349 'LEFT JOIN part_pkg USING ( pkgpart ) '.
350 "LEFT JOIN part_pkg_option
351 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
352 AND part_pkg_option.optionname = 'bill_every_call' )";
354 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
355 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
357 my @cust_pkg = qsearch({
358 'table' => 'cust_pkg',
359 'addl_from' => $addl_from,
360 'hashref' => { 'custnum' => $self->custnum,
364 'extra_sql' => $extra_sql,
368 warn "voip_cdr bill_every_call packages found; billing customer\n";
369 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
371 warn "WARNING: Error billing customer: $bill_error\n";
374 #end of billing setup fees for voip_cdr bill_every_call packages
376 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
379 my $trigger = $conf->config('payment_receipt-trigger',
380 $self->cust_main->agentnum) || 'cust_pay';
381 if ( $trigger eq 'cust_pay' ) {
382 my $error = $self->send_receipt(
383 'manual' => $options{'manual'},
384 'cust_bill' => $cust_bill,
385 'cust_main' => $cust_main,
387 warn "can't send payment receipt/statement: $error" if $error;
390 #run payment events immediately
391 my $due_cust_event = $self->cust_main->due_cust_event(
392 'eventtable' => 'cust_pay',
393 'objects' => [ $self ],
395 if ( !ref($due_cust_event) ) {
396 warn "Error searching for cust_pay billing events: $due_cust_event\n";
398 foreach my $cust_event (@$due_cust_event) {
399 next unless $cust_event->test_conditions;
400 if ( my $error = $cust_event->do_event() ) {
401 warn "Error running cust_pay billing event: $error\n";
410 =item void [ REASON ]
412 Voids this payment: deletes the payment and all associated applications and
413 adds a record of the voided payment to the FS::cust_pay_void table.
420 local $SIG{HUP} = 'IGNORE';
421 local $SIG{INT} = 'IGNORE';
422 local $SIG{QUIT} = 'IGNORE';
423 local $SIG{TERM} = 'IGNORE';
424 local $SIG{TSTP} = 'IGNORE';
425 local $SIG{PIPE} = 'IGNORE';
427 my $oldAutoCommit = $FS::UID::AutoCommit;
428 local $FS::UID::AutoCommit = 0;
431 my $cust_pay_void = new FS::cust_pay_void ( {
432 map { $_ => $self->get($_) } $self->fields
434 $cust_pay_void->reason(shift) if scalar(@_);
435 my $error = $cust_pay_void->insert;
437 my $cust_pay_pending =
438 qsearchs('cust_pay_pending', { paynum => $self->paynum });
439 if ( $cust_pay_pending ) {
440 $cust_pay_pending->set('void_paynum', $self->paynum);
441 $cust_pay_pending->set('paynum', '');
442 $error ||= $cust_pay_pending->replace;
445 $error ||= $self->delete;
448 $dbh->rollback if $oldAutoCommit;
452 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
460 Unless the closed flag is set, deletes this payment and all associated
461 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
462 cases, you want to use the void method instead to leave a record of the
467 # very similar to FS::cust_credit::delete
470 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
472 local $SIG{HUP} = 'IGNORE';
473 local $SIG{INT} = 'IGNORE';
474 local $SIG{QUIT} = 'IGNORE';
475 local $SIG{TERM} = 'IGNORE';
476 local $SIG{TSTP} = 'IGNORE';
477 local $SIG{PIPE} = 'IGNORE';
479 my $oldAutoCommit = $FS::UID::AutoCommit;
480 local $FS::UID::AutoCommit = 0;
483 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
484 my $error = $app->delete;
486 $dbh->rollback if $oldAutoCommit;
491 my $error = $self->SUPER::delete(@_);
493 $dbh->rollback if $oldAutoCommit;
497 if ( $conf->exists('deletepayments')
498 && $conf->config('deletepayments') ne '' ) {
500 my $cust_main = $self->cust_main;
502 my $error = send_email(
503 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
504 #invoice_from??? well as good as any
505 'to' => $conf->config('deletepayments'),
506 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
508 "This is an automatic message from your Freeside installation\n",
509 "informing you that the following payment has been deleted:\n",
511 'paynum: '. $self->paynum. "\n",
512 'custnum: '. $self->custnum.
513 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
514 'paid: $'. sprintf("%.2f", $self->paid). "\n",
515 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
516 'payby: '. $self->payby. "\n",
517 'payinfo: '. $self->paymask. "\n",
518 'paybatch: '. $self->paybatch. "\n",
523 $dbh->rollback if $oldAutoCommit;
524 return "can't send payment deletion notification: $error";
529 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
535 =item replace [ OLD_RECORD ]
537 You can, but probably shouldn't modify payments...
539 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
540 supplied, replaces this record. If there is an error, returns the error,
541 otherwise returns false.
547 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
548 $self->SUPER::replace(@_);
553 Checks all fields to make sure this is a valid payment. If there is an error,
554 returns the error, otherwise returns false. Called by the insert method.
561 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
564 $self->ut_numbern('paynum')
565 || $self->ut_numbern('custnum')
566 || $self->ut_numbern('_date')
567 || $self->ut_money('paid')
568 || $self->ut_alphan('otaker')
569 || $self->ut_textn('paybatch')
570 || $self->ut_textn('payunique')
571 || $self->ut_enum('closed', [ '', 'Y' ])
572 || $self->ut_flag('no_auto_apply')
573 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
574 || $self->ut_textn('bank')
575 || $self->ut_alphan('depositor')
576 || $self->ut_numbern('account')
577 || $self->ut_numbern('teller')
578 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
579 || $self->payinfo_check()
581 return $error if $error;
583 return "paid must be > 0 " if $self->paid <= 0;
585 return "unknown cust_main.custnum: ". $self->custnum
587 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
589 $self->_date(time) unless $self->_date;
591 return "invalid discount_term"
592 if ($self->discount_term && $self->discount_term < 2);
594 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
595 foreach (qw(bank depositor account teller)) {
596 return "$_ required" if $self->get($_) eq '';
600 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
601 # # UNIQUE index should catch this too, without race conditions, but this
602 # # should give a better error message the other 99.9% of the time...
603 # if ( length($self->payunique)
604 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
605 # #well, it *could* be a better error message
606 # return "duplicate transaction".
607 # " - a payment with unique identifer ". $self->payunique.
614 =item send_receipt HASHREF | OPTION => VALUE ...
616 Sends a payment receipt for this payment..
624 Flag indicating the payment is being made manually.
628 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
633 Customer (FS::cust_main) object (for efficiency).
641 my $opt = ref($_[0]) ? shift : { @_ };
643 my $cust_bill = $opt->{'cust_bill'};
644 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
646 my $conf = new FS::Conf;
648 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
650 my @invoicing_list = $cust_main->invoicing_list_emailonly;
651 return '' unless @invoicing_list;
653 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
657 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
658 #|| ! $conf->exists('invoice_html_statement')
662 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
665 my %substitutions = ();
666 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
668 my $queue = new FS::queue {
669 'job' => 'FS::Misc::process_send_email',
670 'paynum' => $self->paynum,
671 'custnum' => $cust_main->custnum,
673 $error = $queue->insert(
674 FS::msg_template->by_key($msgnum)->prepare(
675 'cust_main' => $cust_main,
677 'from_config' => 'payment_receipt_from',
678 'substitutions' => \%substitutions,
680 'msgtype' => 'receipt', # override msg_template's default
683 } elsif ( $conf->exists('payment_receipt_email') ) {
685 my $receipt_template = new Text::Template (
687 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
689 warn "can't create payment receipt template: $Text::Template::ERROR";
693 my $payby = $self->payby;
694 my $payinfo = $self->payinfo;
695 $payby =~ s/^BILL$/Check/ if $payinfo;
696 if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
697 $payinfo = $self->paymask
699 $payinfo = $self->decrypt($payinfo);
701 $payby =~ s/^CHEK$/Electronic check/;
704 'date' => time2str("%a %B %o, %Y", $self->_date),
705 'name' => $cust_main->name,
706 'paynum' => $self->paynum,
707 'paid' => sprintf("%.2f", $self->paid),
708 'payby' => ucfirst(lc($payby)),
709 'payinfo' => $payinfo,
710 'balance' => $cust_main->balance,
711 'company_name' => $conf->config('company_name', $cust_main->agentnum),
714 $fill_in{'invnum'} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
716 if ( $opt->{'cust_pkg'} ) {
717 $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
718 #setup date, other things?
721 my $queue = new FS::queue {
722 'job' => 'FS::Misc::process_send_generated_email',
723 'paynum' => $self->paynum,
724 'custnum' => $cust_main->custnum,
725 'msgtype' => 'receipt',
727 $error = $queue->insert(
728 'from' => $conf->invoice_from_full( $cust_main->agentnum ),
729 #invoice_from??? well as good as any
730 'to' => \@invoicing_list,
731 'subject' => 'Payment receipt',
732 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
737 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
741 } elsif ( ! $cust_main->invoice_noemail ) { #not manual
743 my $queue = new FS::queue {
744 'job' => 'FS::cust_bill::queueable_email',
745 'paynum' => $self->paynum,
746 'custnum' => $cust_main->custnum,
750 'invnum' => $cust_bill->invnum,
754 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
755 $opt{'mode'} = $mode;
757 # backward compatibility, no good fix for this yet as some people may
758 # still have "invoice_latex_statement" and such options
759 $opt{'template'} = 'statement';
760 $opt{'notice_name'} = 'Statement';
763 $error = $queue->insert(%opt);
767 warn "send_receipt: $error\n" if $error;
772 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
779 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
780 sort { $a->_date <=> $b->_date
781 || $a->invnum <=> $b->invnum }
782 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
786 =item cust_pay_refund
788 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
793 sub cust_pay_refund {
795 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
796 sort { $a->_date <=> $b->_date }
797 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
804 Returns the amount of this payment that is still unapplied; which is
805 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
806 applications (see L<FS::cust_pay_refund>).
812 my $amount = $self->paid;
813 $amount -= $_->amount foreach ( $self->cust_bill_pay );
814 $amount -= $_->amount foreach ( $self->cust_pay_refund );
815 sprintf("%.2f", $amount );
820 Returns the amount of this payment that has not been refuned; which is
821 paid minus all refund applications (see L<FS::cust_pay_refund>).
827 my $amount = $self->paid;
828 $amount -= $_->amount foreach ( $self->cust_pay_refund );
829 sprintf("%.2f", $amount );
834 Returns the "paid" field.
843 =item delete_cust_bill_pay OPTIONS
845 Deletes all associated cust_bill_pay records.
847 If option 'unapplied' is a specified, only deletes until
848 this object's 'unapplied' value is >= the specified amount.
849 (Deletes in order returned by L</cust_bill_pay>.)
853 sub delete_cust_bill_pay {
857 local $SIG{HUP} = 'IGNORE';
858 local $SIG{INT} = 'IGNORE';
859 local $SIG{QUIT} = 'IGNORE';
860 local $SIG{TERM} = 'IGNORE';
861 local $SIG{TSTP} = 'IGNORE';
862 local $SIG{PIPE} = 'IGNORE';
864 my $oldAutoCommit = $FS::UID::AutoCommit;
865 local $FS::UID::AutoCommit = 0;
868 my $unapplied = $self->unapplied; #only need to look it up once
872 # Maybe we should reverse the order these get deleted in?
873 # ie delete newest first?
874 # keeping consistent with how bop refunds work, for now...
875 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
876 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
877 $unapplied += $cust_bill_pay->amount;
878 $error = $cust_bill_pay->delete;
883 $dbh->rollback if $oldAutoCommit;
887 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
893 Accepts input for creating a new FS::cust_refund object.
894 Unapplies payment from invoices up to the amount of the refund,
895 creates the refund and applies payment to refund. Allows entire
896 process to be handled in one transaction.
898 Causes a fatal error if called on CARD or CHEK payments.
905 die "Cannot call cust_pay->refund on " . $self->payby
906 if grep { $_ eq $self->payby } qw(CARD CHEK);
908 local $SIG{HUP} = 'IGNORE';
909 local $SIG{INT} = 'IGNORE';
910 local $SIG{QUIT} = 'IGNORE';
911 local $SIG{TERM} = 'IGNORE';
912 local $SIG{TSTP} = 'IGNORE';
913 local $SIG{PIPE} = 'IGNORE';
915 my $oldAutoCommit = $FS::UID::AutoCommit;
916 local $FS::UID::AutoCommit = 0;
919 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
922 $dbh->rollback if $oldAutoCommit;
926 $hash->{'paynum'} = $self->paynum;
927 my $new = new FS::cust_refund ( $hash );
928 $error = $new->insert;
931 $dbh->rollback if $oldAutoCommit;
935 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
939 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
941 =item refund_to_unapply
943 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
944 (all currently applied refunds that aren't closed.)
945 Returns empty list if payment itself is closed.
949 sub refund_to_unapply {
951 return () if $self->closed;
953 'table' => 'cust_pay_refund',
954 'hashref' => { 'paynum' => $self->paynum },
955 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
956 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
962 Deletes all objects returned by L</refund_to_unapply>.
969 local $SIG{HUP} = 'IGNORE';
970 local $SIG{INT} = 'IGNORE';
971 local $SIG{QUIT} = 'IGNORE';
972 local $SIG{TERM} = 'IGNORE';
973 local $SIG{TSTP} = 'IGNORE';
974 local $SIG{PIPE} = 'IGNORE';
976 my $oldAutoCommit = $FS::UID::AutoCommit;
977 local $FS::UID::AutoCommit = 0;
979 foreach my $cust_pay_refund ($self->refund_to_unapply) {
980 my $error = $cust_pay_refund->delete;
982 dbh->rollback if $oldAutoCommit;
987 dbh->commit or die dbh->errstr if $oldAutoCommit;
997 =item batch_insert CUST_PAY_OBJECT, ...
999 Class method which inserts multiple payments. Takes a list of FS::cust_pay
1000 objects. Returns a list, each element representing the status of inserting the
1001 corresponding payment - empty. If there is an error inserting any payment, the
1002 entire transaction is rolled back, i.e. all payments are inserted or none are.
1004 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
1005 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
1006 those objects will be inserted with the paynum of the payment, and for
1007 each one, an error message or an empty string will be inserted into the
1012 my @errors = FS::cust_pay->batch_insert(@cust_pay);
1013 my $num_errors = scalar(grep $_, @errors);
1014 if ( $num_errors == 0 ) {
1015 #success; all payments were inserted
1017 #failure; no payments were inserted.
1023 my $self = shift; #class method
1025 local $SIG{HUP} = 'IGNORE';
1026 local $SIG{INT} = 'IGNORE';
1027 local $SIG{QUIT} = 'IGNORE';
1028 local $SIG{TERM} = 'IGNORE';
1029 local $SIG{TSTP} = 'IGNORE';
1030 local $SIG{PIPE} = 'IGNORE';
1032 my $oldAutoCommit = $FS::UID::AutoCommit;
1033 local $FS::UID::AutoCommit = 0;
1039 foreach my $cust_pay (@_) {
1040 my $error = $cust_pay->insert( 'manual' => 1 );
1041 push @errors, $error;
1042 $num_errors++ if $error;
1044 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1046 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1047 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1051 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1052 my $apply_error = $cust_bill_pay->insert;
1053 push @errors, $apply_error || '';
1054 $num_errors++ if $apply_error;
1058 } elsif ( !$error ) { #normal case: apply payments as usual
1059 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1064 if ( $num_errors ) {
1065 $dbh->rollback if $oldAutoCommit;
1067 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1076 Returns an SQL fragment to retreive the unapplied amount.
1081 my ($class, $start, $end) = @_;
1082 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1083 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1084 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1085 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1089 ( SELECT SUM(amount) FROM cust_bill_pay
1090 WHERE cust_pay.paynum = cust_bill_pay.paynum
1091 $bill_start $bill_end )
1095 ( SELECT SUM(amount) FROM cust_pay_refund
1096 WHERE cust_pay.paynum = cust_pay_refund.paynum
1097 $refund_start $refund_end )
1106 # Used by FS::Upgrade to migrate to a new database.
1110 sub _upgrade_data { #class method
1111 my ($class, %opt) = @_;
1113 warn "$me upgrading $class\n" if $DEBUG;
1115 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1118 # otaker/ivan upgrade
1121 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1123 #not the most efficient, but hey, it only has to run once
1125 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
1126 " AND usernum IS NULL ".
1127 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
1128 " WHERE cust_main.custnum = cust_pay.custnum ) ";
1130 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1132 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1133 $sth->execute or die $sth->errstr;
1134 my $total = $sth->fetchrow_arrayref->[0];
1135 #warn "$total cust_pay records to update\n"
1137 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1142 my @cust_pay = qsearch( {
1143 'table' => 'cust_pay',
1145 'extra_sql' => $where,
1146 'order_by' => 'ORDER BY paynum',
1149 foreach my $cust_pay (@cust_pay) {
1151 my $h_cust_pay = $cust_pay->h_search('insert');
1152 if ( $h_cust_pay ) {
1153 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1154 #$cust_pay->otaker($h_cust_pay->history_user);
1155 $cust_pay->set('otaker', $h_cust_pay->history_user);
1157 $cust_pay->set('otaker', 'legacy');
1160 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1161 my $error = $cust_pay->replace;
1164 warn " *** WARNING: Error updating order taker for payment paynum ".
1165 $cust_pay->paynun. ": $error\n";
1169 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1172 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1173 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1179 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1183 # payinfo N/A upgrade
1186 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1188 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1190 my @na_cust_pay = qsearch( {
1191 'table' => 'cust_pay',
1192 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1193 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1196 foreach my $na ( @na_cust_pay ) {
1198 next unless $na->payinfo eq 'N/A';
1200 my $cust_pay_pending =
1201 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1202 unless ( $cust_pay_pending ) {
1203 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1204 $na->paynum. " (no cust_pay_pending)\n";
1207 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1208 my $error = $na->replace;
1210 warn " *** WARNING: Error updating payinfo for payment paynum ".
1211 $na->paynun. ": $error\n";
1217 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1221 # otaker->usernum upgrade
1224 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
1225 $class->_upgrade_otaker(%opt);
1226 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
1228 # if we do this anywhere else, it should become an FS::Upgrade method
1229 my $num_to_upgrade = $class->count('paybatch is not null');
1230 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1231 if ( $num_to_upgrade > 0 ) {
1232 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1233 if ( $opt{queue} ) {
1234 if ( $num_jobs > 0 ) {
1235 warn "Upgrade already queued.\n";
1237 warn "Scheduling upgrade.\n";
1238 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1242 process_upgrade_paybatch();
1247 sub process_upgrade_paybatch {
1249 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1250 local $FS::UID::AutoCommit = 1;
1253 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1255 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1256 my $search = FS::Cursor->new( {
1257 'table' => 'cust_pay',
1258 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1260 while (my $cust_pay = $search->fetch) {
1261 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1262 $cust_pay->set('paybatch' => '');
1263 my $error = $cust_pay->replace;
1264 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1269 # migrate gateway info from the misused 'paybatch' field
1272 # not only cust_pay, but also voided and refunded payments
1273 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1274 local $FS::Record::nowarn_classload=1;
1275 # really inefficient, but again, only has to run once
1276 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1277 my $and_batchnum_is_null =
1278 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1279 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1280 my $search = FS::Cursor->new({
1282 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1283 "AND (paybatch IS NOT NULL ".
1284 "OR (paybatch IS NULL AND auth IS NULL
1285 $and_batchnum_is_null ) )
1286 ORDER BY $pkey DESC"
1288 while ( my $object = $search->fetch ) {
1289 if ( $object->paybatch eq '' ) {
1290 # repair for a previous upgrade that didn't save 'auth'
1291 my $pkey = $object->primary_key;
1292 # find the last history record that had a paybatch value
1294 table => "h_$table",
1296 $pkey => $object->$pkey,
1297 paybatch => { op=>'!=', value=>''},
1298 history_action => 'replace_old',
1300 order_by => 'ORDER BY history_date DESC LIMIT 1',
1303 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1306 # if the paybatch didn't have an auth string, then it's fine
1307 $h->paybatch =~ /:(\w+):/ or next;
1308 # set paybatch to what it was in that record
1309 $object->set('paybatch', $h->paybatch)
1310 # and then upgrade it like the old records
1313 my $parsed = $object->_parse_paybatch;
1314 if (keys %$parsed) {
1315 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1316 $object->set('auth' => $parsed->{authorization});
1317 $object->set('paybatch', '');
1318 my $error = $object->replace;
1319 warn "error parsing CARD/CHEK paybatch fields on $object #".
1320 $object->get($object->primary_key).":\n $error\n"
1325 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1335 =item process_batch_import
1339 sub process_batch_import {
1344 my $custnum = $hash{'custnum'};
1345 my $agentnum = $hash{'agentnum'};
1346 my $agent_custid = $hash{'agent_custid'};
1348 $hash{'_date'} = parse_datetime($hash{'_date'})
1349 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1350 #remove custnum_prefix
1351 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1352 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1355 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1356 && length($1) == $custnum_length
1360 # check agentnum against custnum and
1361 # translate agent_custid into regular custnum
1362 if ($custnum && $agent_custid) {
1363 die "can't specify both custnum and agent_custid\n";
1364 } elsif ($agentnum || $agent_custid) {
1365 # here is the agent virtualization
1366 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1368 $search{'agentnum'} = $agentnum
1370 $search{'agent_custid'} = $agent_custid
1372 $search{'custnum'} = $custnum
1374 my $cust_main = qsearchs({
1375 'table' => 'cust_main',
1376 'hashref' => \%search,
1377 'extra_sql' => $extra_sql,
1379 die "can't find customer with" .
1380 ($agentnum ? " agentnum $agentnum" : '') .
1381 ($custnum ? " custnum $custnum" : '') .
1382 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1384 die "mismatched customer number\n"
1385 if $custnum && ($custnum ne $cust_main->custnum);
1386 $custnum = $cust_main->custnum;
1388 $hash{'custnum'} = $custnum;
1389 delete($hash{'agent_custid'});
1394 'table' => 'cust_pay',
1395 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1396 #agent_custid isn't a cust_pay field, see hash callback
1397 'formats' => { 'simple' =>
1398 [ qw(custnum agent_custid paid payinfo invnum) ] },
1399 'format_types' => { 'simple' => '' }, #force infer from file extension
1400 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1401 'format_hash_callbacks' => { 'simple' => $hashcb },
1402 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1403 'postinsert_callback' => sub {
1404 my $cust_pay = shift;
1405 my $cust_main = $cust_pay->cust_main
1406 or return "can't find customer to which payments apply";
1407 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1409 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1414 FS::Record::process_batch_import( $job, $opt, @_ );
1418 =item batch_import HASHREF
1420 Inserts new payments.
1427 my $fh = $param->{filehandle};
1428 my $format = $param->{'format'};
1430 my $agentnum = $param->{agentnum};
1431 my $_date = $param->{_date};
1432 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1433 my $paybatch = $param->{'paybatch'};
1435 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1436 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1438 # here is the agent virtualization
1439 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1443 if ( $format eq 'simple' ) {
1444 @fields = qw( custnum agent_custid paid payinfo invnum );
1446 } elsif ( $format eq 'extended' ) {
1447 die "unimplemented\n";
1451 die "unknown format $format";
1454 eval "use Text::CSV_XS;";
1457 my $csv = new Text::CSV_XS;
1461 local $SIG{HUP} = 'IGNORE';
1462 local $SIG{INT} = 'IGNORE';
1463 local $SIG{QUIT} = 'IGNORE';
1464 local $SIG{TERM} = 'IGNORE';
1465 local $SIG{TSTP} = 'IGNORE';
1466 local $SIG{PIPE} = 'IGNORE';
1468 my $oldAutoCommit = $FS::UID::AutoCommit;
1469 local $FS::UID::AutoCommit = 0;
1473 while ( defined($line=<$fh>) ) {
1475 $csv->parse($line) or do {
1476 $dbh->rollback if $oldAutoCommit;
1477 return "can't parse: ". $csv->error_input();
1480 my @columns = $csv->fields();
1484 paybatch => $paybatch,
1486 $cust_pay{_date} = $_date if $_date;
1489 foreach my $field ( @fields ) {
1491 if ( $field eq 'agent_custid'
1493 && $columns[0] =~ /\S+/ )
1496 my $agent_custid = $columns[0];
1497 my %hash = ( 'agent_custid' => $agent_custid,
1498 'agentnum' => $agentnum,
1501 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1502 $dbh->rollback if $oldAutoCommit;
1503 return "can't specify custnum with agent_custid $agent_custid";
1506 $cust_main = qsearchs({
1507 'table' => 'cust_main',
1508 'hashref' => \%hash,
1509 'extra_sql' => $extra_sql,
1512 unless ( $cust_main ) {
1513 $dbh->rollback if $oldAutoCommit;
1514 return "can't find customer with agent_custid $agent_custid";
1518 $columns[0] = $cust_main->custnum;
1521 $cust_pay{$field} = shift @columns;
1524 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1525 && length($1) == $custnum_length ) {
1526 $cust_pay{custnum} = $2;
1529 my $custnum = $cust_pay{custnum};
1531 my $cust_pay = new FS::cust_pay( \%cust_pay );
1532 my $error = $cust_pay->insert;
1534 if ( ! $error && $cust_pay->custnum != $custnum ) {
1535 #invnum was defined, and ->insert set custnum to the customer for that
1536 #invoice, but it wasn't the one the import specified.
1537 $dbh->rollback if $oldAutoCommit;
1538 $error = "specified invoice #". $cust_pay{invnum}.
1539 " is for custnum ". $cust_pay->custnum.
1540 ", not specified custnum $custnum";
1544 $dbh->rollback if $oldAutoCommit;
1545 return "can't insert payment for $line: $error";
1548 if ( $format eq 'simple' ) {
1549 # include agentnum for less surprise?
1550 $cust_main = qsearchs({
1551 'table' => 'cust_main',
1552 'hashref' => { 'custnum' => $cust_pay->custnum },
1553 'extra_sql' => $extra_sql,
1557 unless ( $cust_main ) {
1558 $dbh->rollback if $oldAutoCommit;
1559 return "can't find customer to which payments apply at line: $line";
1562 $error = $cust_main->apply_payments_and_credits;
1564 $dbh->rollback if $oldAutoCommit;
1565 return "can't apply payments to customer for $line: $error";
1573 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1575 return "Empty file!" unless $imported;
1585 Delete and replace methods.
1589 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1590 schema.html from the base documentation.