1 package FS::cust_pay_batch;
4 use vars qw( @ISA $DEBUG );
5 use Carp qw( confess );
6 use Business::CreditCard 0.28;
7 use FS::Record qw(dbh qsearch qsearchs);
12 @ISA = qw( FS::payinfo_Mixin FS::Record );
14 # 1 is mostly method/subroutine entry and options
15 # 2 traces progress of some operations
16 # 3 is even more information including possibly sensitive data
21 FS::cust_pay_batch - Object methods for batch cards
25 use FS::cust_pay_batch;
27 $record = new FS::cust_pay_batch \%hash;
28 $record = new FS::cust_pay_batch { 'column' => 'value' };
30 $error = $record->insert;
32 $error = $new_record->replace($old_record);
34 $error = $record->delete;
36 $error = $record->check;
38 #deprecated# $error = $record->retriable;
42 An FS::cust_pay_batch object represents a credit card transaction ready to be
43 batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record.
44 Typically called by the collect method of an FS::cust_main object. The
45 following fields are currently supported:
49 =item paybatchnum - primary key (automatically assigned)
51 =item batchnum - indentifies group in batch
53 =item payby - CARD/CHEK/LECB/BILL/COMP
57 =item exp - card expiration
61 =item invnum - invoice
63 =item custnum - customer
65 =item payname - name on card
93 Creates a new record. To add the record to the database, see L<"insert">.
95 Note that this stores the hash reference, not a distinct copy of the hash it
96 points to. You can ask the object for a copy with the I<hash> method.
100 sub table { 'cust_pay_batch'; }
104 Adds this record to the database. If there is an error, returns the error,
105 otherwise returns false.
109 Delete this record from the database. If there is an error, returns the error,
110 otherwise returns false.
112 =item replace OLD_RECORD
114 Replaces the OLD_RECORD with this one in the database. If there is an error,
115 returns the error, otherwise returns false.
119 Checks all fields to make sure this is a valid transaction. If there is
120 an error, returns the error, otherwise returns false. Called by the insert
129 $self->ut_numbern('paybatchnum')
130 || $self->ut_numbern('trancode') #deprecated
131 || $self->ut_money('amount')
132 || $self->ut_number('invnum')
133 || $self->ut_number('custnum')
134 || $self->ut_text('address1')
135 || $self->ut_textn('address2')
136 || $self->ut_text('city')
137 || $self->ut_textn('state')
140 return $error if $error;
142 $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
143 $self->setfield('last',$1);
145 $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
148 $error = $self->payinfo_check();
149 return $error if $error;
151 if ( $self->exp eq '' ) {
152 return "Expiration date required"
153 unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
156 if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
157 $self->exp("$1-$2-$3");
158 } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
159 if ( length($2) == 4 ) {
160 $self->exp("$2-$1-01");
161 } elsif ( $2 > 98 ) { #should pry change to check for "this year"
162 $self->exp("19$2-$1-01");
164 $self->exp("20$2-$1-01");
167 return "Illegal expiration date";
171 if ( $self->payname eq '' ) {
172 $self->payname( $self->first. " ". $self->getfield('last') );
174 $self->payname =~ /^([\w \,\.\-\']+)$/
175 or return "Illegal billing name";
179 #we have lots of old zips in there... don't hork up batch results cause of em
180 $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
181 or return "Illegal zip: ". $self->zip;
184 $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
187 #$error = $self->ut_zip('zip', $self->country);
188 #return $error if $error;
190 #check invnum, custnum, ?
197 Returns the customer (see L<FS::cust_main>) for this batched credit card
204 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
207 #you know what, screw this in the new world of events. we should be able to
208 #get the event defs to retry (remove once.pm condition, add every.pm) without
209 #mucking about with statuses of previous cust_event records. right?
213 #Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
214 #credit card payment as retriable. Useful if the corresponding financial
215 #institution account was declined for temporary reasons and/or a manual
218 #Implementation details: For the named customer's invoice, changes the
219 #statustext of the 'done' (without statustext) event to 'retriable.'
225 confess "deprecated method cust_pay_batch->retriable called; try removing ".
226 "the once condition and adding an every condition?";
230 local $SIG{HUP} = 'IGNORE'; #Hmm
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
241 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
242 or return "event $self->eventnum references nonexistant invoice $self->invnum";
244 warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
245 my @cust_bill_event =
246 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
248 $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
249 && $_->status eq 'done'
252 $cust_bill->cust_bill_event;
253 # complain loudly if scalar(@cust_bill_event) > 1 ?
254 my $error = $cust_bill_event[0]->retriable;
256 # gah, even with transactions.
257 $dbh->commit if $oldAutoCommit; #well.
258 return "error marking invoice event retriable: $error";
263 =item approve PAYBATCH
265 Approve this payment. This will replace the existing record with the
266 same paybatchnum, set its status to 'Approved', and generate a payment
267 record (L<FS::cust_pay>). This should only be called from the batch
273 # to break up the Big Wall of Code that is import_results
275 my $paybatch = shift;
276 my $paybatchnum = $new->paybatchnum;
277 my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
278 or return "paybatchnum $paybatchnum not found";
279 return "paybatchnum $paybatchnum already resolved ('".$old->status."')"
281 $new->status('Approved');
282 my $error = $new->replace($old);
284 return "error updating status of paybatchnum $paybatchnum: $error\n";
286 my $cust_pay = new FS::cust_pay ( {
287 'custnum' => $new->custnum,
288 'payby' => $new->payby,
289 'paybatch' => $paybatch,
290 'payinfo' => $new->payinfo || $old->payinfo,
291 'paid' => $new->paid,
292 '_date' => $new->_date,
293 'usernum' => $new->usernum,
295 $error = $cust_pay->insert;
297 return "error inserting payment for paybatchnum $paybatchnum: $error\n";
299 $cust_pay->cust_main->apply_payments;
305 Decline this payment. This will replace the existing record with the
306 same paybatchnum, set its status to 'Declined', and run collection events
307 as appropriate. This should only be called from the batch import process.
313 my $conf = new FS::Conf;
315 my $paybatchnum = $new->paybatchnum;
316 my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
317 or return "paybatchnum $paybatchnum not found";
318 if ( $old->status ) {
319 # Handle the case where payments are rejected after the batch has been
320 # approved. Only if manual approval is enabled.
321 if ( $conf->exists('batch-manual_approval')
322 and lc($old->status) eq 'approved' ) {
324 my $cust_pay = qsearchs('cust_pay', {
325 custnum => $new->custnum,
326 paybatch => $new->batchnum
329 # should never happen...
330 return "failed to revoke paybatchnum $paybatchnum, payment not found";
332 $cust_pay->void('Returned payment');
335 # normal case: refuse to do anything
336 return "paybatchnum $paybatchnum already resolved ('".$old->status."')";
339 $new->status('Declined');
340 my $error = $new->replace($old);
342 return "error updating status of paybatchnum $paybatchnum: $error\n";
344 my $due_cust_event = $new->cust_main->due_cust_event(
345 'eventtable' => 'cust_pay_batch',
346 'objects' => [ $new ],
348 if ( !ref($due_cust_event) ) {
349 return $due_cust_event;
351 # XXX breaks transaction integrity
352 foreach my $cust_event (@$due_cust_event) {
353 next unless $cust_event->test_conditions;
354 if ( my $error = $cust_event->do_event() ) {
365 There should probably be a configuration file with a list of allowed credit
370 L<FS::cust_main>, L<FS::Record>