4 use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
5 FS::reason_Mixin FS::Record);
6 use vars qw( $DEBUG $me $conf @encrypted_fields
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;
32 $me = '[FS::cust_pay]';
36 #ask FS::UID to run this stuff for us later
37 FS::UID->install_callback( sub {
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 || $_[0]->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. The following arguments are
205 If true, a payment receipt is sent instead of a statement when
206 'payment_receipt_email' configuration option is set.
208 About the "manual" flag: Normally, if the 'payment_receipt' config option
209 is set, and the customer has an invoice email address, inserting a payment
210 causes a I<statement> to be emailed to the customer. If the payment is
211 considered "manual" (or if the customer has no invoices), then it will
212 instead send a I<payment receipt>. "manual" should be true whenever a
213 payment is created directly from the web interface, from a user-initiated
214 realtime payment, or from a third-party payment via self-service. It should
215 be I<false> when creating a payment from a billing event or from a batch.
219 Don't send an email receipt. (Note: does not currently work when
220 payment_receipt-trigger is set to something other than default / cust_bill)
227 my($self, %options) = @_;
229 local $SIG{HUP} = 'IGNORE';
230 local $SIG{INT} = 'IGNORE';
231 local $SIG{QUIT} = 'IGNORE';
232 local $SIG{TERM} = 'IGNORE';
233 local $SIG{TSTP} = 'IGNORE';
234 local $SIG{PIPE} = 'IGNORE';
236 my $oldAutoCommit = $FS::UID::AutoCommit;
237 local $FS::UID::AutoCommit = 0;
241 if ( $self->invnum ) {
242 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
244 $dbh->rollback if $oldAutoCommit;
245 return "Unknown cust_bill.invnum: ". $self->invnum;
247 if ($self->custnum && ($cust_bill->custnum ne $self->custnum)) {
248 $dbh->rollback if $oldAutoCommit;
249 return "Invoice custnum ".$cust_bill->custnum
250 ." does not match specified custnum ".$self->custnum
251 ." for invoice ".$self->invnum;
253 $self->custnum($cust_bill->custnum );
256 my $error = $self->check;
257 return $error if $error;
259 my $cust_main = $self->cust_main;
260 my $old_balance = $cust_main->balance;
262 $error = $self->SUPER::insert;
264 $dbh->rollback if $oldAutoCommit;
265 return "error inserting cust_pay: $error";
268 if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
269 if ( my $months = $self->discount_term ) {
270 # XXX this should be moved out somewhere, but discount_term_values
272 my ($cust_bill) = ($cust_main->cust_bill)[-1]; # most recent invoice
273 return "can't accept prepayment for an unbilled customer" if !$cust_bill;
275 # %billing_pkgs contains this customer's active monthly packages.
276 # Recurring fees for those packages will be credited and then rebilled
277 # for the full discount term. Other packages on the last invoice
278 # (canceled, non-monthly recurring, or one-time charges) will be
280 my %billing_pkgs = map { $_->pkgnum => $_ }
281 grep { $_->part_pkg->freq eq '1' }
282 $cust_main->billing_pkgs;
283 my $credit = 0; # sum of recurring charges from that invoice
284 my $last_bill_date = 0; # the real bill date
285 foreach my $item ( $cust_bill->cust_bill_pkg ) {
286 next if !exists($billing_pkgs{$item->pkgnum}); # skip inactive packages
287 $credit += $item->recur;
288 $last_bill_date = $item->cust_pkg->last_bill
289 if defined($item->cust_pkg)
290 and $item->cust_pkg->last_bill > $last_bill_date
293 my $cust_credit = new FS::cust_credit {
294 'custnum' => $self->custnum,
295 'amount' => sprintf('%.2f', $credit),
296 'reason' => 'customer chose to prepay for discount',
298 $error = $cust_credit->insert('reason_type' => $credit_type);
300 $dbh->rollback if $oldAutoCommit;
301 return "error inserting prepayment credit: $error";
305 # bill for the entire term
306 $_->bill($_->last_bill) foreach (values %billing_pkgs);
307 $error = $cust_main->bill(
308 # no recurring_only, we want unbilled packages with start dates to
310 'no_usage_reset' => 1,
311 'time' => $last_bill_date, # not $cust_bill->_date
312 'pkg_list' => [ values %billing_pkgs ],
313 'freq_override' => $months,
316 $dbh->rollback if $oldAutoCommit;
317 return "error inserting cust_pay: $error";
319 $error = $cust_main->apply_payments_and_credits;
321 $dbh->rollback if $oldAutoCommit;
322 return "error inserting cust_pay: $error";
324 my $new_balance = $cust_main->balance;
325 if ($new_balance > 0) {
326 $dbh->rollback if $oldAutoCommit;
327 return "balance after prepay discount attempt: $new_balance";
329 # user friendly: override the "apply only to this invoice" mode
336 if ( $self->invnum ) {
337 my $cust_bill_pay = new FS::cust_bill_pay {
338 'invnum' => $self->invnum,
339 'paynum' => $self->paynum,
340 'amount' => $self->paid,
341 '_date' => $self->_date,
343 $error = $cust_bill_pay->insert(%options);
345 if ( $ignore_noapply ) {
346 warn "warning: error inserting cust_bill_pay: $error ".
347 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
349 $dbh->rollback if $oldAutoCommit;
350 return "error inserting cust_bill_pay: $error";
355 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
357 # possibly trigger package unsuspend, doesn't abort transaction on failure
358 $self->unsuspend_balance if $old_balance;
360 #bill setup fees for voip_cdr bill_every_call packages
361 #some false laziness w/search in freeside-cdrd
363 'LEFT JOIN part_pkg USING ( pkgpart ) '.
364 "LEFT JOIN part_pkg_option
365 ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
366 AND part_pkg_option.optionname = 'bill_every_call' )";
368 my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
369 " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
371 my @cust_pkg = qsearch({
372 'table' => 'cust_pkg',
373 'addl_from' => $addl_from,
374 'hashref' => { 'custnum' => $self->custnum,
378 'extra_sql' => $extra_sql,
382 warn "voip_cdr bill_every_call packages found; billing customer\n";
383 my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
385 warn "WARNING: Error billing customer: $bill_error\n";
388 #end of billing setup fees for voip_cdr bill_every_call packages
390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
393 my $trigger = $conf->config('payment_receipt-trigger',
394 $self->cust_main->agentnum) || 'cust_pay';
395 if ( $trigger eq 'cust_pay' ) {
396 my $error = $self->send_receipt(
397 'manual' => $options{'manual'},
398 'noemail' => $options{'noemail'},
399 'cust_bill' => $cust_bill,
400 'cust_main' => $cust_main,
402 warn "can't send payment receipt/statement: $error" if $error;
405 #run payment events immediately
406 my $due_cust_event = $self->cust_main->due_cust_event(
407 'eventtable' => 'cust_pay',
408 'objects' => [ $self ],
410 if ( !ref($due_cust_event) ) {
411 warn "Error searching for cust_pay billing events: $due_cust_event\n";
413 foreach my $cust_event (@$due_cust_event) {
414 next unless $cust_event->test_conditions;
415 if ( my $error = $cust_event->do_event() ) {
416 warn "Error running cust_pay billing event: $error\n";
425 =item void [ REASON ]
427 Voids this payment: deletes the payment and all associated applications and
428 adds a record of the voided payment to the FS::cust_pay_void table.
436 unless (ref($reason) || !$reason) {
437 $reason = FS::reason->new_or_existing(
439 'type' => 'Void payment',
444 local $SIG{HUP} = 'IGNORE';
445 local $SIG{INT} = 'IGNORE';
446 local $SIG{QUIT} = 'IGNORE';
447 local $SIG{TERM} = 'IGNORE';
448 local $SIG{TSTP} = 'IGNORE';
449 local $SIG{PIPE} = 'IGNORE';
451 my $oldAutoCommit = $FS::UID::AutoCommit;
452 local $FS::UID::AutoCommit = 0;
455 my $cust_pay_void = new FS::cust_pay_void ( {
456 map { $_ => $self->get($_) } $self->fields
458 $cust_pay_void->reasonnum($reason->reasonnum) if $reason;
459 my $error = $cust_pay_void->insert;
461 my $cust_pay_pending =
462 qsearchs('cust_pay_pending', { paynum => $self->paynum });
463 if ( $cust_pay_pending ) {
464 $cust_pay_pending->set('void_paynum', $self->paynum);
465 $cust_pay_pending->set('paynum', '');
466 $error ||= $cust_pay_pending->replace;
469 $error ||= $self->delete;
472 $dbh->rollback if $oldAutoCommit;
476 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
484 Unless the closed flag is set, deletes this payment and all associated
485 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
486 cases, you want to use the void method instead to leave a record of the
491 # very similar to FS::cust_credit::delete
494 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
496 local $SIG{HUP} = 'IGNORE';
497 local $SIG{INT} = 'IGNORE';
498 local $SIG{QUIT} = 'IGNORE';
499 local $SIG{TERM} = 'IGNORE';
500 local $SIG{TSTP} = 'IGNORE';
501 local $SIG{PIPE} = 'IGNORE';
503 my $oldAutoCommit = $FS::UID::AutoCommit;
504 local $FS::UID::AutoCommit = 0;
507 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
508 my $error = $app->delete;
510 $dbh->rollback if $oldAutoCommit;
515 my $error = $self->SUPER::delete(@_);
517 $dbh->rollback if $oldAutoCommit;
521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
527 =item replace [ OLD_RECORD ]
529 You can, but probably shouldn't modify payments...
531 Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
532 supplied, replaces this record. If there is an error, returns the error,
533 otherwise returns false.
539 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
540 $self->SUPER::replace(@_);
545 Checks all fields to make sure this is a valid payment. If there is an error,
546 returns the error, otherwise returns false. Called by the insert method.
553 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
556 $self->ut_numbern('paynum')
557 || $self->ut_numbern('custnum')
558 || $self->ut_numbern('_date')
559 || $self->ut_money('paid')
560 || $self->ut_alphan('otaker')
561 || $self->ut_textn('paybatch')
562 || $self->ut_textn('payunique')
563 || $self->ut_enum('closed', [ '', 'Y' ])
564 || $self->ut_flag('no_auto_apply')
565 || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
566 || $self->ut_textn('bank')
567 || $self->ut_alphan('depositor')
568 || $self->ut_numbern('account')
569 || $self->ut_numbern('teller')
570 || $self->ut_foreign_keyn('batchnum', 'pay_batch', 'batchnum')
571 || $self->payinfo_check()
573 return $error if $error;
575 return "paid must be > 0 " if $self->paid <= 0;
577 return "unknown cust_main.custnum: ". $self->custnum
579 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
581 $self->_date(time) unless $self->_date;
583 return "invalid discount_term"
584 if ($self->discount_term && $self->discount_term < 2);
586 if ( $self->payby eq 'CASH' and $conf->exists('require_cash_deposit_info') ) {
587 foreach (qw(bank depositor account teller)) {
588 return "$_ required" if $self->get($_) eq '';
592 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
593 # # UNIQUE index should catch this too, without race conditions, but this
594 # # should give a better error message the other 99.9% of the time...
595 # if ( length($self->payunique)
596 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
597 # #well, it *could* be a better error message
598 # return "duplicate transaction".
599 # " - a payment with unique identifer ". $self->payunique.
606 =item send_receipt HASHREF | OPTION => VALUE ...
608 Sends a payment receipt for this payment..
616 Flag indicating the payment is being made manually.
620 Invoice (FS::cust_bill) object. If not specified, the most recent invoice
625 Customer (FS::cust_main) object (for efficiency).
629 Don't send an email receipt.
639 my $opt = ref($_[0]) ? shift : { @_ };
641 my $cust_bill = $opt->{'cust_bill'};
642 my $cust_main = $opt->{'cust_main'} || $self->cust_main;
644 my $conf = new FS::Conf;
646 return '' unless $conf->config_bool('payment_receipt', $cust_main->agentnum);
648 my @invoicing_list = $cust_main->invoicing_list_emailonly;
649 return '' unless @invoicing_list;
651 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
655 if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
656 #|| ! $conf->exists('invoice_html_statement')
660 my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
663 my %substitutions = ();
664 $substitutions{invnum} = $opt->{cust_bill}->invnum if $opt->{cust_bill};
666 my $msg_template = qsearchs('msg_template',{ msgnum => $msgnum});
667 unless ($msg_template) {
668 warn "send_receipt could not load msg_template";
672 my $cust_msg = $msg_template->prepare(
673 'cust_main' => $cust_main,
675 'from_config' => 'payment_receipt_from',
676 'substitutions' => \%substitutions,
677 'msgtype' => 'receipt',
679 $error = $cust_msg ? $cust_msg->insert : 'error preparing msg_template';
681 warn "send_receipt: $error";
685 my $queue = new FS::queue {
686 'job' => 'FS::cust_msg::process_send',
687 'paynum' => $self->paynum,
688 'custnum' => $cust_main->custnum,
690 $error = $queue->insert( $cust_msg->custmsgnum );
694 warn "payment_receipt is on, but no payment_receipt_msgnum\n";
698 #not manual and no noemail flag (here or on the customer)
699 } elsif ( ! $opt->{'noemail'} && ! $cust_main->invoice_noemail ) {
701 my $queue = new FS::queue {
702 'job' => 'FS::cust_bill::queueable_email',
703 'paynum' => $self->paynum,
704 'custnum' => $cust_main->custnum,
708 'invnum' => $cust_bill->invnum,
712 if ( my $mode = $conf->config('payment_receipt_statement_mode') ) {
713 $opt{'mode'} = $mode;
715 # backward compatibility, no good fix for this yet as some people may
716 # still have "invoice_latex_statement" and such options
717 $opt{'template'} = 'statement';
718 $opt{'notice_name'} = 'Statement';
721 $error = $queue->insert(%opt);
725 warn "send_receipt: $error\n" if $error;
730 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
737 map { $_ } #return $self->num_cust_bill_pay unless wantarray;
738 sort { $a->_date <=> $b->_date
739 || $a->invnum <=> $b->invnum }
740 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
744 =item cust_pay_refund
746 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
751 sub cust_pay_refund {
753 map { $_ } #return $self->num_cust_pay_refund unless wantarray;
754 sort { $a->_date <=> $b->_date }
755 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
762 Returns the amount of this payment that is still unapplied; which is
763 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
764 applications (see L<FS::cust_pay_refund>).
770 my $amount = $self->paid;
771 $amount -= $_->amount foreach ( $self->cust_bill_pay );
772 $amount -= $_->amount foreach ( $self->cust_pay_refund );
773 sprintf("%.2f", $amount );
778 Returns the amount of this payment that has not been refuned; which is
779 paid minus all refund applications (see L<FS::cust_pay_refund>).
785 my $amount = $self->paid;
786 $amount -= $_->amount foreach ( $self->cust_pay_refund );
787 sprintf("%.2f", $amount );
792 Returns the "paid" field.
801 =item delete_cust_bill_pay OPTIONS
803 Deletes all associated cust_bill_pay records.
805 If option 'unapplied' is a specified, only deletes until
806 this object's 'unapplied' value is >= the specified amount.
807 (Deletes in order returned by L</cust_bill_pay>.)
811 sub delete_cust_bill_pay {
815 local $SIG{HUP} = 'IGNORE';
816 local $SIG{INT} = 'IGNORE';
817 local $SIG{QUIT} = 'IGNORE';
818 local $SIG{TERM} = 'IGNORE';
819 local $SIG{TSTP} = 'IGNORE';
820 local $SIG{PIPE} = 'IGNORE';
822 my $oldAutoCommit = $FS::UID::AutoCommit;
823 local $FS::UID::AutoCommit = 0;
826 my $unapplied = $self->unapplied; #only need to look it up once
830 # Maybe we should reverse the order these get deleted in?
831 # ie delete newest first?
832 # keeping consistent with how bop refunds work, for now...
833 foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
834 last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'});
835 $unapplied += $cust_bill_pay->amount;
836 $error = $cust_bill_pay->delete;
841 $dbh->rollback if $oldAutoCommit;
845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
851 Accepts input for creating a new FS::cust_refund object.
852 Unapplies payment from invoices up to the amount of the refund,
853 creates the refund and applies payment to refund. Allows entire
854 process to be handled in one transaction.
856 Causes a fatal error if called on CARD or CHEK payments.
863 die "Cannot call cust_pay->refund on " . $self->payby
864 if grep { $_ eq $self->payby } qw(CARD CHEK);
866 local $SIG{HUP} = 'IGNORE';
867 local $SIG{INT} = 'IGNORE';
868 local $SIG{QUIT} = 'IGNORE';
869 local $SIG{TERM} = 'IGNORE';
870 local $SIG{TSTP} = 'IGNORE';
871 local $SIG{PIPE} = 'IGNORE';
873 my $oldAutoCommit = $FS::UID::AutoCommit;
874 local $FS::UID::AutoCommit = 0;
877 my $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'});
880 $dbh->rollback if $oldAutoCommit;
884 $hash->{'paynum'} = $self->paynum;
885 my $new = new FS::cust_refund ( $hash );
886 $error = $new->insert;
889 $dbh->rollback if $oldAutoCommit;
893 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
897 ### refund_to_unapply/unapply_refund false laziness with FS::cust_credit
899 =item refund_to_unapply
901 Returns L<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
902 (all currently applied refunds that aren't closed.)
903 Returns empty list if payment itself is closed.
907 sub refund_to_unapply {
909 return () if $self->closed;
911 'table' => 'cust_pay_refund',
912 'hashref' => { 'paynum' => $self->paynum },
913 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
914 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
920 Deletes all objects returned by L</refund_to_unapply>.
927 local $SIG{HUP} = 'IGNORE';
928 local $SIG{INT} = 'IGNORE';
929 local $SIG{QUIT} = 'IGNORE';
930 local $SIG{TERM} = 'IGNORE';
931 local $SIG{TSTP} = 'IGNORE';
932 local $SIG{PIPE} = 'IGNORE';
934 my $oldAutoCommit = $FS::UID::AutoCommit;
935 local $FS::UID::AutoCommit = 0;
937 foreach my $cust_pay_refund ($self->refund_to_unapply) {
938 my $error = $cust_pay_refund->delete;
940 dbh->rollback if $oldAutoCommit;
945 dbh->commit or die dbh->errstr if $oldAutoCommit;
955 =item batch_insert CUST_PAY_OBJECT, ...
957 Class method which inserts multiple payments. Takes a list of FS::cust_pay
958 objects. Returns a list, each element representing the status of inserting the
959 corresponding payment - empty. If there is an error inserting any payment, the
960 entire transaction is rolled back, i.e. all payments are inserted or none are.
962 FS::cust_pay objects may have the pseudo-field 'apply_to', containing a
963 reference to an array of (uninserted) FS::cust_bill_pay objects. If so,
964 those objects will be inserted with the paynum of the payment, and for
965 each one, an error message or an empty string will be inserted into the
970 my @errors = FS::cust_pay->batch_insert(@cust_pay);
971 my $num_errors = scalar(grep $_, @errors);
972 if ( $num_errors == 0 ) {
973 #success; all payments were inserted
975 #failure; no payments were inserted.
981 my $self = shift; #class method
983 local $SIG{HUP} = 'IGNORE';
984 local $SIG{INT} = 'IGNORE';
985 local $SIG{QUIT} = 'IGNORE';
986 local $SIG{TERM} = 'IGNORE';
987 local $SIG{TSTP} = 'IGNORE';
988 local $SIG{PIPE} = 'IGNORE';
990 my $oldAutoCommit = $FS::UID::AutoCommit;
991 local $FS::UID::AutoCommit = 0;
997 foreach my $cust_pay (@_) {
998 my $error = $cust_pay->insert( 'manual' => 1 );
999 push @errors, $error;
1000 $num_errors++ if $error;
1002 if ( ref($cust_pay->get('apply_to')) eq 'ARRAY' ) {
1004 foreach my $cust_bill_pay ( @{ $cust_pay->apply_to } ) {
1005 if ( $error ) { # insert placeholders if cust_pay wasn't inserted
1009 $cust_bill_pay->set('paynum', $cust_pay->paynum);
1010 my $apply_error = $cust_bill_pay->insert;
1011 push @errors, $apply_error || '';
1012 $num_errors++ if $apply_error;
1016 } elsif ( !$error ) { #normal case: apply payments as usual
1017 $cust_pay->cust_main->apply_payments( 'manual'=>1 );
1022 if ( $num_errors ) {
1023 $dbh->rollback if $oldAutoCommit;
1025 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1034 Returns an SQL fragment to retreive the unapplied amount.
1039 my ($class, $start, $end) = @_;
1040 my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
1041 my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
1042 my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
1043 my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
1047 ( SELECT SUM(amount) FROM cust_bill_pay
1048 WHERE cust_pay.paynum = cust_bill_pay.paynum
1049 $bill_start $bill_end )
1053 ( SELECT SUM(amount) FROM cust_pay_refund
1054 WHERE cust_pay.paynum = cust_pay_refund.paynum
1055 $refund_start $refund_end )
1064 my @fields = grep { $_ ne 'payinfo' } $self->fields;
1065 +{ ( map { $_=>$self->$_ } @fields ),
1071 # Used by FS::Upgrade to migrate to a new database.
1075 sub _upgrade_data { #class method
1076 my ($class, %opt) = @_;
1078 warn "$me upgrading $class\n" if $DEBUG;
1080 $class->_upgrade_reasonnum(%opt);
1082 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1085 # otaker/ivan upgrade
1088 unless ( FS::upgrade_journal->is_done('cust_pay__otaker_ivan') ) {
1090 #not the most efficient, but hey, it only has to run once
1092 my $where = " WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' )
1094 AND EXISTS ( SELECT 1 FROM cust_main
1095 WHERE cust_main.custnum = cust_pay.custnum )
1098 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
1100 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
1101 $sth->execute or die $sth->errstr;
1102 my $total = $sth->fetchrow_arrayref->[0];
1103 #warn "$total cust_pay records to update\n"
1105 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
1110 my @cust_pay = qsearch( {
1111 'table' => 'cust_pay',
1113 'extra_sql' => $where,
1114 'order_by' => 'ORDER BY paynum',
1117 foreach my $cust_pay (@cust_pay) {
1119 my $h_cust_pay = $cust_pay->h_search('insert');
1120 if ( $h_cust_pay ) {
1121 next if $cust_pay->otaker eq $h_cust_pay->history_user;
1122 #$cust_pay->otaker($h_cust_pay->history_user);
1123 $cust_pay->set('otaker', $h_cust_pay->history_user);
1125 $cust_pay->set('otaker', 'legacy');
1128 my $error = $cust_pay->replace;
1131 warn " *** WARNING: Error updating order taker for payment paynum ".
1132 $cust_pay->paynun. ": $error\n";
1137 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
1138 warn "$me $count/$total (".sprintf('%.2f',100*$count/$total). '%)'."\n";
1144 FS::upgrade_journal->set_done('cust_pay__otaker_ivan');
1148 # payinfo N/A upgrade
1151 unless ( FS::upgrade_journal->is_done('cust_pay__payinfo_na') ) {
1153 #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
1155 my @na_cust_pay = qsearch( {
1156 'table' => 'cust_pay',
1157 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
1158 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
1161 foreach my $na ( @na_cust_pay ) {
1163 next unless $na->payinfo eq 'N/A';
1165 my $cust_pay_pending =
1166 qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
1167 unless ( $cust_pay_pending ) {
1168 warn " *** WARNING: not-yet recoverable N/A card for payment ".
1169 $na->paynum. " (no cust_pay_pending)\n";
1172 $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
1173 my $error = $na->replace;
1175 warn " *** WARNING: Error updating payinfo for payment paynum ".
1176 $na->paynun. ": $error\n";
1182 FS::upgrade_journal->set_done('cust_pay__payinfo_na');
1186 # otaker->usernum upgrade
1189 $class->_upgrade_otaker(%opt);
1191 # if we do this anywhere else, it should become an FS::Upgrade method
1192 my $num_to_upgrade = $class->count('paybatch is not null');
1193 my $num_jobs = FS::queue->count('job = \'FS::cust_pay::process_upgrade_paybatch\' and status != \'failed\'');
1194 if ( $num_to_upgrade > 0 ) {
1195 warn "Need to migrate paybatch field in $num_to_upgrade payments.\n";
1196 if ( $opt{queue} ) {
1197 if ( $num_jobs > 0 ) {
1198 warn "Upgrade already queued.\n";
1200 warn "Scheduling upgrade.\n";
1201 my $job = FS::queue->new({ job => 'FS::cust_pay::process_upgrade_paybatch' });
1205 process_upgrade_paybatch();
1210 sub process_upgrade_paybatch {
1212 local $FS::payinfo_Mixin::ignore_masked_payinfo = 1;
1213 local $FS::UID::AutoCommit = 1;
1216 # migrate batchnums from the misused 'paybatch' field to 'batchnum'
1218 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
1219 my $search = FS::Cursor->new( {
1220 'table' => 'cust_pay',
1221 'addl_from' => " JOIN pay_batch ON cust_pay.paybatch = CAST(pay_batch.batchnum AS $text) ",
1223 while (my $cust_pay = $search->fetch) {
1224 $cust_pay->set('batchnum' => $cust_pay->paybatch);
1225 $cust_pay->set('paybatch' => '');
1226 my $error = $cust_pay->replace;
1227 warn "error setting batchnum on cust_pay #".$cust_pay->paynum.":\n $error"
1232 # migrate gateway info from the misused 'paybatch' field
1235 # not only cust_pay, but also voided and refunded payments
1236 if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) {
1237 local $FS::Record::nowarn_classload=1;
1238 # really inefficient, but again, only has to run once
1239 foreach my $table (qw(cust_pay cust_pay_void cust_refund)) {
1240 my $and_batchnum_is_null =
1241 ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' );
1242 my $pkey = ($table =~ /^cust_pay/ ? 'paynum' : 'refundnum');
1243 my $search = FS::Cursor->new({
1245 extra_sql => "WHERE payby IN('CARD','CHEK') ".
1246 "AND (paybatch IS NOT NULL ".
1247 "OR (paybatch IS NULL AND auth IS NULL
1248 $and_batchnum_is_null ) )
1249 ORDER BY $pkey DESC"
1251 while ( my $object = $search->fetch ) {
1252 if ( $object->paybatch eq '' ) {
1253 # repair for a previous upgrade that didn't save 'auth'
1254 my $pkey = $object->primary_key;
1255 # find the last history record that had a paybatch value
1257 table => "h_$table",
1259 $pkey => $object->$pkey,
1260 paybatch => { op=>'!=', value=>''},
1261 history_action => 'replace_old',
1263 order_by => 'ORDER BY history_date DESC LIMIT 1',
1266 warn "couldn't find paybatch history record for $table ".$object->$pkey."\n";
1269 # if the paybatch didn't have an auth string, then it's fine
1270 $h->paybatch =~ /:(\w+):/ or next;
1271 # set paybatch to what it was in that record
1272 $object->set('paybatch', $h->paybatch)
1273 # and then upgrade it like the old records
1276 my $parsed = $object->_parse_paybatch;
1277 if (keys %$parsed) {
1278 $object->set($_ => $parsed->{$_}) foreach keys %$parsed;
1279 $object->set('auth' => $parsed->{authorization});
1280 $object->set('paybatch', '');
1281 my $error = $object->replace;
1282 warn "error parsing CARD/CHEK paybatch fields on $object #".
1283 $object->get($object->primary_key).":\n $error\n"
1288 FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
1298 =item process_batch_import
1302 sub process_batch_import {
1307 my $custnum = $hash{'custnum'};
1308 my $agentnum = $hash{'agentnum'};
1309 my $agent_custid = $hash{'agent_custid'};
1311 $hash{'_date'} = parse_datetime($hash{'_date'})
1312 if $hash{'_date'} && $hash{'_date'} =~ /\D/;
1313 #remove custnum_prefix
1314 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1315 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1318 && $custnum =~ /^$custnum_prefix(0*([1-9]\d*))$/
1319 && length($1) == $custnum_length
1323 # check agentnum against custnum and
1324 # translate agent_custid into regular custnum
1325 if ($custnum && $agent_custid) {
1326 die "can't specify both custnum and agent_custid\n";
1327 } elsif ($agentnum || $agent_custid) {
1328 # here is the agent virtualization
1329 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1331 $search{'agentnum'} = $agentnum
1333 $search{'agent_custid'} = $agent_custid
1335 $search{'custnum'} = $custnum
1337 my $cust_main = qsearchs({
1338 'table' => 'cust_main',
1339 'hashref' => \%search,
1340 'extra_sql' => $extra_sql,
1342 die "can't find customer with" .
1343 ($agentnum ? " agentnum $agentnum" : '') .
1344 ($custnum ? " custnum $custnum" : '') .
1345 ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
1347 die "mismatched customer number\n"
1348 if $custnum && ($custnum ne $cust_main->custnum);
1349 $custnum = $cust_main->custnum;
1351 $hash{'custnum'} = $custnum;
1352 delete($hash{'agent_custid'});
1357 'table' => 'cust_pay',
1358 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ],
1359 #agent_custid isn't a cust_pay field, see hash callback
1360 'formats' => { 'simple' =>
1361 [ qw(custnum agent_custid paid payinfo invnum) ] },
1362 'format_types' => { 'simple' => '' }, #force infer from file extension
1363 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension
1364 'format_hash_callbacks' => { 'simple' => $hashcb },
1365 'insert_args_callback' => sub { ( 'manual'=>1 ); },
1366 'postinsert_callback' => sub {
1367 my $cust_pay = shift;
1368 my $cust_main = $cust_pay->cust_main
1369 or return "can't find customer to which payments apply";
1370 my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
1372 ? "can't apply payments to customer ".$cust_pay->custnum."$error"
1377 FS::Record::process_batch_import( $job, $opt, @_ );
1381 =item batch_import HASHREF
1383 Inserts new payments.
1390 my $fh = $param->{filehandle};
1391 my $format = $param->{'format'};
1393 my $agentnum = $param->{agentnum};
1394 my $_date = $param->{_date};
1395 $_date = parse_datetime($_date) if $_date && $_date =~ /\D/;
1396 my $paybatch = $param->{'paybatch'};
1398 my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
1399 my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
1401 # here is the agent virtualization
1402 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
1406 if ( $format eq 'simple' ) {
1407 @fields = qw( custnum agent_custid paid payinfo invnum );
1409 } elsif ( $format eq 'extended' ) {
1410 die "unimplemented\n";
1414 die "unknown format $format";
1417 eval "use Text::CSV_XS;";
1420 my $csv = new Text::CSV_XS;
1424 local $SIG{HUP} = 'IGNORE';
1425 local $SIG{INT} = 'IGNORE';
1426 local $SIG{QUIT} = 'IGNORE';
1427 local $SIG{TERM} = 'IGNORE';
1428 local $SIG{TSTP} = 'IGNORE';
1429 local $SIG{PIPE} = 'IGNORE';
1431 my $oldAutoCommit = $FS::UID::AutoCommit;
1432 local $FS::UID::AutoCommit = 0;
1436 while ( defined($line=<$fh>) ) {
1438 $csv->parse($line) or do {
1439 $dbh->rollback if $oldAutoCommit;
1440 return "can't parse: ". $csv->error_input();
1443 my @columns = $csv->fields();
1447 paybatch => $paybatch,
1449 $cust_pay{_date} = $_date if $_date;
1452 foreach my $field ( @fields ) {
1454 if ( $field eq 'agent_custid'
1456 && $columns[0] =~ /\S+/ )
1459 my $agent_custid = $columns[0];
1460 my %hash = ( 'agent_custid' => $agent_custid,
1461 'agentnum' => $agentnum,
1464 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
1465 $dbh->rollback if $oldAutoCommit;
1466 return "can't specify custnum with agent_custid $agent_custid";
1469 $cust_main = qsearchs({
1470 'table' => 'cust_main',
1471 'hashref' => \%hash,
1472 'extra_sql' => $extra_sql,
1475 unless ( $cust_main ) {
1476 $dbh->rollback if $oldAutoCommit;
1477 return "can't find customer with agent_custid $agent_custid";
1481 $columns[0] = $cust_main->custnum;
1484 $cust_pay{$field} = shift @columns;
1487 if ( $custnum_prefix && $cust_pay{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
1488 && length($1) == $custnum_length ) {
1489 $cust_pay{custnum} = $2;
1492 my $custnum = $cust_pay{custnum};
1494 my $cust_pay = new FS::cust_pay( \%cust_pay );
1495 my $error = $cust_pay->insert;
1497 if ( ! $error && $cust_pay->custnum != $custnum ) {
1498 #invnum was defined, and ->insert set custnum to the customer for that
1499 #invoice, but it wasn't the one the import specified.
1500 $dbh->rollback if $oldAutoCommit;
1501 $error = "specified invoice #". $cust_pay{invnum}.
1502 " is for custnum ". $cust_pay->custnum.
1503 ", not specified custnum $custnum";
1507 $dbh->rollback if $oldAutoCommit;
1508 return "can't insert payment for $line: $error";
1511 if ( $format eq 'simple' ) {
1512 # include agentnum for less surprise?
1513 $cust_main = qsearchs({
1514 'table' => 'cust_main',
1515 'hashref' => { 'custnum' => $cust_pay->custnum },
1516 'extra_sql' => $extra_sql,
1520 unless ( $cust_main ) {
1521 $dbh->rollback if $oldAutoCommit;
1522 return "can't find customer to which payments apply at line: $line";
1525 $error = $cust_main->apply_payments_and_credits;
1527 $dbh->rollback if $oldAutoCommit;
1528 return "can't apply payments to customer for $line: $error";
1536 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1538 return "Empty file!" unless $imported;
1548 Delete and replace methods.
1552 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
1553 schema.html from the base documentation.