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;
303 =item decline [ REASON ]
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.
309 REASON is a string description of the decline reason, defaulting to
316 my $reason = shift || 'Returned payment';
317 #my $conf = new FS::Conf;
319 my $paybatchnum = $new->paybatchnum;
320 my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
321 or return "paybatchnum $paybatchnum not found";
322 if ( $old->status ) {
323 # Handle the case where payments are rejected after the batch has been
324 # approved. FS::pay_batch::import_results won't allow results to be
325 # imported to a closed batch unless batch-manual_approval is enabled,
326 # so we don't check it here.
327 # if ( $conf->exists('batch-manual_approval') and
328 if ( lc($old->status) eq 'approved' ) {
330 my $cust_pay = qsearchs('cust_pay', {
331 custnum => $new->custnum,
332 paybatch => $new->batchnum
335 # should never happen...
336 return "failed to revoke paybatchnum $paybatchnum, payment not found";
338 $cust_pay->void($reason);
341 # normal case: refuse to do anything
342 return "paybatchnum $paybatchnum already resolved ('".$old->status."')";
345 $new->status('Declined');
346 my $error = $new->replace($old);
348 return "error updating status of paybatchnum $paybatchnum: $error\n";
350 my $due_cust_event = $new->cust_main->due_cust_event(
351 'eventtable' => 'cust_pay_batch',
352 'objects' => [ $new ],
354 if ( !ref($due_cust_event) ) {
355 return $due_cust_event;
357 # XXX breaks transaction integrity
358 foreach my $cust_event (@$due_cust_event) {
359 next unless $cust_event->test_conditions;
360 if ( my $error = $cust_event->do_event() ) {
371 There should probably be a configuration file with a list of allowed credit
376 L<FS::cust_main>, L<FS::Record>