4 use vars qw( @ISA $DEBUG $me $conf @encrypted_fields
5 $unsuspendauto $ignore_noapply
8 use Business::CreditCard;
10 use FS::UID qw( getotaker );
11 use FS::Misc qw( send_email );
12 use FS::Record qw( dbh qsearch qsearchs );
14 use FS::cust_main_Mixin;
15 use FS::payinfo_Mixin;
17 use FS::cust_bill_pay;
18 use FS::cust_pay_refund;
20 use FS::cust_pay_void;
22 @ISA = qw(FS::Record FS::cust_main_Mixin FS::payinfo_Mixin );
26 $me = '[FS::cust_pay]';
30 #ask FS::UID to run this stuff for us later
31 FS::UID->install_callback( sub {
33 $unsuspendauto = $conf->exists('unsuspendauto');
36 @encrypted_fields = ('payinfo');
40 FS::cust_pay - Object methods for cust_pay objects
46 $record = new FS::cust_pay \%hash;
47 $record = new FS::cust_pay { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
59 An FS::cust_pay object represents a payment; the transfer of money from a
60 customer. FS::cust_pay inherits from FS::Record. The following fields are
65 =item paynum - primary key (assigned automatically for new payments)
67 =item custnum - customer (see L<FS::cust_main>)
69 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
70 L<Time::Local> and L<Date::Parse> for conversion functions.
72 =item paid - Amount of this payment
74 =item otaker - order taker (assigned automatically, see L<FS::UID>)
76 =item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
78 =item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format)
80 =item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
82 =item paybatch - text field for tracking card processing or other batch grouping
84 =item payunique - Optional unique identifer to prevent duplicate transactions.
86 =item closed - books closed flag, empty or `Y'
96 Creates a new payment. To add the payment to the databse, see L<"insert">.
100 sub table { 'cust_pay'; }
101 sub cust_linked { $_[0]->cust_main_custnum; }
102 sub cust_unlinked_msg {
104 "WARNING: can't find cust_main.custnum ". $self->custnum.
105 ' (cust_pay.paynum '. $self->paynum. ')';
110 Adds this payment to the database.
112 For backwards-compatibility and convenience, if the additional field invnum
113 is defined, an FS::cust_bill_pay record for the full amount of the payment
114 will be created. In this case, custnum is optional. An hash of optional
115 arguments may be passed. Currently "manual" is supported. If true, a
116 payment receipt is sent instead of a statement when 'payment_receipt_email'
117 configuration option is set.
122 my ($self, %options) = @_;
124 local $SIG{HUP} = 'IGNORE';
125 local $SIG{INT} = 'IGNORE';
126 local $SIG{QUIT} = 'IGNORE';
127 local $SIG{TERM} = 'IGNORE';
128 local $SIG{TSTP} = 'IGNORE';
129 local $SIG{PIPE} = 'IGNORE';
131 my $oldAutoCommit = $FS::UID::AutoCommit;
132 local $FS::UID::AutoCommit = 0;
136 if ( $self->invnum ) {
137 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
139 $dbh->rollback if $oldAutoCommit;
140 return "Unknown cust_bill.invnum: ". $self->invnum;
142 $self->custnum($cust_bill->custnum );
146 my $error = $self->check;
147 return $error if $error;
149 my $cust_main = $self->cust_main;
150 my $old_balance = $cust_main->balance;
152 $error = $self->SUPER::insert;
154 $dbh->rollback if $oldAutoCommit;
155 return "error inserting $self: $error";
158 if ( $self->invnum ) {
159 my $cust_bill_pay = new FS::cust_bill_pay {
160 'invnum' => $self->invnum,
161 'paynum' => $self->paynum,
162 'amount' => $self->paid,
163 '_date' => $self->_date,
165 $error = $cust_bill_pay->insert;
167 if ( $ignore_noapply ) {
168 warn "warning: error inserting $cust_bill_pay: $error ".
169 "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
171 $dbh->rollback if $oldAutoCommit;
172 return "error inserting $cust_bill_pay: $error";
177 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
179 #false laziness w/ cust_credit::insert
180 if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
181 my @errors = $cust_main->unsuspend;
183 # side-fx with nested transactions? upstack rolls back?
184 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 #my $cust_main = $self->cust_main;
193 if ( $conf->exists('payment_receipt_email')
194 && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list
197 $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
200 if ( ( exists($options{'manual'}) && $options{'manual'} )
201 || ! $conf->exists('invoice_html_statement')
205 my $receipt_template = new Text::Template (
207 SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
209 warn "can't create payment receipt template: $Text::Template::ERROR";
213 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ }
214 $cust_main->invoicing_list;
216 my $payby = $self->payby;
217 my $payinfo = $self->payinfo;
218 $payby =~ s/^BILL$/Check/ if $payinfo;
219 $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK';
220 $payby =~ s/^CHEK$/Electronic check/;
223 'from' => $conf->config('invoice_from'), #??? well as good as any
224 'to' => \@invoicing_list,
225 'subject' => 'Payment receipt',
226 'body' => [ $receipt_template->fill_in( HASH => {
227 'date' => time2str("%a %B %o, %Y", $self->_date),
228 'name' => $cust_main->name,
229 'paynum' => $self->paynum,
230 'paid' => sprintf("%.2f", $self->paid),
231 'payby' => ucfirst(lc($payby)),
232 'payinfo' => $payinfo,
233 'balance' => $cust_main->balance,
239 my $queue = new FS::queue {
240 'paynum' => $self->paynum,
241 'job' => 'FS::cust_bill::queueable_email',
243 $error = $queue->insert(
244 'invnum' => $cust_bill->invnum,
245 'template' => 'statement',
251 warn "can't send payment receipt/statement: $error";
260 =item void [ REASON ]
262 Voids this payment: deletes the payment and all associated applications and
263 adds a record of the voided payment to the FS::cust_pay_void table.
270 local $SIG{HUP} = 'IGNORE';
271 local $SIG{INT} = 'IGNORE';
272 local $SIG{QUIT} = 'IGNORE';
273 local $SIG{TERM} = 'IGNORE';
274 local $SIG{TSTP} = 'IGNORE';
275 local $SIG{PIPE} = 'IGNORE';
277 my $oldAutoCommit = $FS::UID::AutoCommit;
278 local $FS::UID::AutoCommit = 0;
281 my $cust_pay_void = new FS::cust_pay_void ( {
282 map { $_ => $self->get($_) } $self->fields
284 $cust_pay_void->reason(shift) if scalar(@_);
285 my $error = $cust_pay_void->insert;
287 $dbh->rollback if $oldAutoCommit;
291 $error = $self->delete;
293 $dbh->rollback if $oldAutoCommit;
297 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
305 Unless the closed flag is set, deletes this payment and all associated
306 applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
307 cases, you want to use the void method instead to leave a record of the
312 # very similar to FS::cust_credit::delete
315 return "Can't delete closed payment" if $self->closed =~ /^Y/i;
317 local $SIG{HUP} = 'IGNORE';
318 local $SIG{INT} = 'IGNORE';
319 local $SIG{QUIT} = 'IGNORE';
320 local $SIG{TERM} = 'IGNORE';
321 local $SIG{TSTP} = 'IGNORE';
322 local $SIG{PIPE} = 'IGNORE';
324 my $oldAutoCommit = $FS::UID::AutoCommit;
325 local $FS::UID::AutoCommit = 0;
328 foreach my $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
329 my $error = $app->delete;
331 $dbh->rollback if $oldAutoCommit;
336 my $error = $self->SUPER::delete(@_);
338 $dbh->rollback if $oldAutoCommit;
342 if ( $conf->config('deletepayments') ne '' ) {
344 my $cust_main = $self->cust_main;
346 my $error = send_email(
347 'from' => $conf->config('invoice_from'), #??? well as good as any
348 'to' => $conf->config('deletepayments'),
349 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
351 "This is an automatic message from your Freeside installation\n",
352 "informing you that the following payment has been deleted:\n",
354 'paynum: '. $self->paynum. "\n",
355 'custnum: '. $self->custnum.
356 " (". $cust_main->last. ", ". $cust_main->first. ")\n",
357 'paid: $'. sprintf("%.2f", $self->paid). "\n",
358 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
359 'payby: '. $self->payby. "\n",
360 'payinfo: '. $self->paymask. "\n",
361 'paybatch: '. $self->paybatch. "\n",
366 $dbh->rollback if $oldAutoCommit;
367 return "can't send payment deletion notification: $error";
372 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
378 =item replace OLD_RECORD
380 You can, but probably shouldn't modify payments...
385 #return "Can't modify payment!"
387 return "Can't modify closed payment" if $self->closed =~ /^Y/i;
388 $self->SUPER::replace(@_);
393 Checks all fields to make sure this is a valid payment. If there is an error,
394 returns the error, otherwise returns false. Called by the insert method.
401 $self->otaker(getotaker) unless ($self->otaker);
404 $self->ut_numbern('paynum')
405 || $self->ut_numbern('custnum')
406 || $self->ut_numbern('_date')
407 || $self->ut_money('paid')
408 || $self->ut_alpha('otaker')
409 || $self->ut_textn('paybatch')
410 || $self->ut_textn('payunique')
411 || $self->ut_enum('closed', [ '', 'Y' ])
412 || $self->payinfo_check()
414 return $error if $error;
416 return "paid must be > 0 " if $self->paid <= 0;
418 return "unknown cust_main.custnum: ". $self->custnum
420 || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
422 $self->_date(time) unless $self->_date;
424 #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
425 # # UNIQUE index should catch this too, without race conditions, but this
426 # # should give a better error message the other 99.9% of the time...
427 # if ( length($self->payunique)
428 # && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
429 # #well, it *could* be a better error message
430 # return "duplicate transaction".
431 # " - a payment with unique identifer ". $self->payunique.
438 =item batch_insert CUST_PAY_OBJECT, ...
440 Class method which inserts multiple payments. Takes a list of FS::cust_pay
441 objects. Returns a list, each element representing the status of inserting the
442 corresponding payment - empty. If there is an error inserting any payment, the
443 entire transaction is rolled back, i.e. all payments are inserted or none are.
447 my @errors = FS::cust_pay->batch_insert(@cust_pay);
448 my $num_errors = scalar(grep $_, @errors);
449 if ( $num_errors == 0 ) {
450 #success; all payments were inserted
452 #failure; no payments were inserted.
458 my $self = shift; #class method
460 local $SIG{HUP} = 'IGNORE';
461 local $SIG{INT} = 'IGNORE';
462 local $SIG{QUIT} = 'IGNORE';
463 local $SIG{TERM} = 'IGNORE';
464 local $SIG{TSTP} = 'IGNORE';
465 local $SIG{PIPE} = 'IGNORE';
467 my $oldAutoCommit = $FS::UID::AutoCommit;
468 local $FS::UID::AutoCommit = 0;
474 my $error = $_->insert( 'manual' => 1 );
478 $_->cust_main->apply_payments;
484 $dbh->rollback if $oldAutoCommit;
486 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
495 Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
502 sort { $a->_date <=> $b->_date
503 || $a->invnum <=> $b->invnum }
504 qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
508 =item cust_pay_refund
510 Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
515 sub cust_pay_refund {
517 sort { $a->_date <=> $b->_date }
518 qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
525 Returns the amount of this payment that is still unapplied; which is
526 paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
527 applications (see L<FS::cust_pay_refund>).
533 my $amount = $self->paid;
534 $amount -= $_->amount foreach ( $self->cust_bill_pay );
535 $amount -= $_->amount foreach ( $self->cust_pay_refund );
536 sprintf("%.2f", $amount );
541 Returns the amount of this payment that has not been refuned; which is
542 paid minus all refund applications (see L<FS::cust_pay_refund>).
548 my $amount = $self->paid;
549 $amount -= $_->amount foreach ( $self->cust_pay_refund );
550 sprintf("%.2f", $amount );
556 Returns the parent customer object (see L<FS::cust_main>).
562 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
567 Returns a name for the payby field.
573 FS::payby->shortname( $self->payby );
578 Returns a gatewaynum for the processing gateway.
582 Returns a name for the processing gateway.
586 Returns a name for the processing gateway.
590 Returns a name for the processing gateway.
594 sub gatewaynum { shift->_parse_paybatch->{'gatewaynum'}; }
595 sub processor { shift->_parse_paybatch->{'processor'}; }
596 sub authorization { shift->_parse_paybatch->{'authorization'}; }
597 sub order_number { shift->_parse_paybatch->{'order_number'}; }
599 #sucks that this stuff is in paybatch like this in the first place,
600 #but at least other code can start to use new field names
601 #(code nicked from FS::cust_main::realtime_refund_bop)
602 sub _parse_paybatch {
605 $self->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
607 #"Can't parse paybatch for paynum $options{'paynum'}: ".
608 # $cust_pay->paybatch;
610 my( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
612 if ( $gatewaynum ) { #gateway for the payment to be refunded
614 my $payment_gateway =
615 qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
617 die "payment gateway $gatewaynum not found" #?
618 unless $payment_gateway;
620 $processor = $payment_gateway->gateway_module;
625 'gatewaynum' => $gatewaynum,
626 'processor' => $processor,
627 'authorization' => $auth,
628 'order_number' => $order_number,
641 Returns an SQL fragment to retreive the unapplied amount.
650 ( SELECT SUM(amount) FROM cust_bill_pay
651 WHERE cust_pay.paynum = cust_bill_pay.paynum )
655 ( SELECT SUM(amount) FROM cust_pay_refund
656 WHERE cust_pay.paynum = cust_pay_refund.paynum )
665 # Used by FS::Upgrade to migrate to a new database.
669 sub _upgrade_data { #class method
670 my ($class, %opts) = @_;
672 warn "$me upgrading $class\n" if $DEBUG;
674 #not the most efficient, but hey, it only has to run once
676 my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
677 " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
678 " WHERE cust_main.custnum = cust_pay.custnum ) ";
680 my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
682 my $sth = dbh->prepare($count_sql) or die dbh->errstr;
683 $sth->execute or die $sth->errstr;
684 my $total = $sth->fetchrow_arrayref->[0];
686 local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
692 my $cust_pay = qsearchs( {
693 'table' => 'cust_pay',
695 'extra_sql' => $where,
696 'order_by' => 'ORDER BY paynum LIMIT 1',
699 return unless $cust_pay;
701 my $h_cust_pay = $cust_pay->h_search('insert');
703 $cust_pay->otaker($h_cust_pay->history_user);
705 $cust_pay->otaker('legacy');
708 delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
709 my $error = $cust_pay->replace;
713 # warn " *** WARNING: Error updaating order taker for payment paynum".
714 # $cust_pay->paynun. ": $error\n";
717 die $error if $error;
719 $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
722 if ( $DEBUG > 1 && $lastprog + 30 < time ) {
723 warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n";
737 =item batch_import HASHREF
739 Inserts new payments.
746 my $fh = $param->{filehandle};
747 my $agentnum = $param->{agentnum};
748 my $format = $param->{'format'};
749 my $paybatch = $param->{'paybatch'};
751 # here is the agent virtualization
752 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
756 if ( $format eq 'simple' ) {
757 @fields = qw( custnum agent_custid paid payinfo );
759 } elsif ( $format eq 'extended' ) {
760 die "unimplemented\n";
764 die "unknown format $format";
767 eval "use Text::CSV_XS;";
770 my $csv = new Text::CSV_XS;
774 local $SIG{HUP} = 'IGNORE';
775 local $SIG{INT} = 'IGNORE';
776 local $SIG{QUIT} = 'IGNORE';
777 local $SIG{TERM} = 'IGNORE';
778 local $SIG{TSTP} = 'IGNORE';
779 local $SIG{PIPE} = 'IGNORE';
781 my $oldAutoCommit = $FS::UID::AutoCommit;
782 local $FS::UID::AutoCommit = 0;
786 while ( defined($line=<$fh>) ) {
788 $csv->parse($line) or do {
789 $dbh->rollback if $oldAutoCommit;
790 return "can't parse: ". $csv->error_input();
793 my @columns = $csv->fields();
797 paybatch => $paybatch,
801 foreach my $field ( @fields ) {
803 if ( $field eq 'agent_custid'
805 && $columns[0] =~ /\S+/ )
808 my $agent_custid = $columns[0];
809 my %hash = ( 'agent_custid' => $agent_custid,
810 'agentnum' => $agentnum,
813 if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
814 $dbh->rollback if $oldAutoCommit;
815 return "can't specify custnum with agent_custid $agent_custid";
818 $cust_main = qsearchs({
819 'table' => 'cust_main',
821 'extra_sql' => $extra_sql,
824 unless ( $cust_main ) {
825 $dbh->rollback if $oldAutoCommit;
826 return "can't find customer with agent_custid $agent_custid";
830 $columns[0] = $cust_main->custnum;
833 $cust_pay{$field} = shift @columns;
836 my $cust_pay = new FS::cust_pay( \%cust_pay );
837 my $error = $cust_pay->insert;
840 $dbh->rollback if $oldAutoCommit;
841 return "can't insert payment for $line: $error";
844 if ( $format eq 'simple' ) {
845 # include agentnum for less surprise?
846 $cust_main = qsearchs({
847 'table' => 'cust_main',
848 'hashref' => { 'custnum' => $cust_pay->custnum },
849 'extra_sql' => $extra_sql,
853 unless ( $cust_main ) {
854 $dbh->rollback if $oldAutoCommit;
855 return "can't find customer to which payments apply at line: $line";
858 $error = $cust_main->apply_payments_and_credits;
860 $dbh->rollback if $oldAutoCommit;
861 return "can't apply payments to customer for $line: $error";
869 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
871 return "Empty file!" unless $imported;
881 Delete and replace methods.
885 L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
886 schema.html from the base documentation.