1 package FS::cust_pay_batch;
4 use vars qw( @ISA $DEBUG );
5 use FS::Record qw(dbh qsearch qsearchs);
7 use FS::part_bill_event qw(due_events);
8 use Business::CreditCard 0.28;
10 @ISA = qw( FS::Record FS::payinfo_Mixin );
12 # 1 is mostly method/subroutine entry and options
13 # 2 traces progress of some operations
14 # 3 is even more information including possibly sensitive data
19 FS::cust_pay_batch - Object methods for batch cards
23 use FS::cust_pay_batch;
25 $record = new FS::cust_pay_batch \%hash;
26 $record = new FS::cust_pay_batch { 'column' => 'value' };
28 $error = $record->insert;
30 $error = $new_record->replace($old_record);
32 $error = $record->delete;
34 $error = $record->check;
36 $error = $record->retriable;
40 An FS::cust_pay_batch object represents a credit card transaction ready to be
41 batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record.
42 Typically called by the collect method of an FS::cust_main object. The
43 following fields are currently supported:
47 =item paybatchnum - primary key (automatically assigned)
49 =item batchnum - indentifies group in batch
51 =item payby - CARD/CHEK/LECB/BILL/COMP
55 =item exp - card expiration
59 =item invnum - invoice
61 =item custnum - customer
63 =item payname - name on card
91 Creates a new record. To add the record to the database, see L<"insert">.
93 Note that this stores the hash reference, not a distinct copy of the hash it
94 points to. You can ask the object for a copy with the I<hash> method.
98 sub table { 'cust_pay_batch'; }
102 Adds this record to the database. If there is an error, returns the error,
103 otherwise returns false.
107 Delete this record from the database. If there is an error, returns the error,
108 otherwise returns false.
110 =item replace OLD_RECORD
112 Replaces the OLD_RECORD with this one in the database. If there is an error,
113 returns the error, otherwise returns false.
117 Checks all fields to make sure this is a valid transaction. If there is
118 an error, returns the error, otherwise returns false. Called by the insert
127 $self->ut_numbern('paybatchnum')
128 || $self->ut_numbern('trancode') #deprecated
129 || $self->ut_money('amount')
130 || $self->ut_number('invnum')
131 || $self->ut_number('custnum')
132 || $self->ut_text('address1')
133 || $self->ut_textn('address2')
134 || $self->ut_text('city')
135 || $self->ut_textn('state')
138 return $error if $error;
140 $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
141 $self->setfield('last',$1);
143 $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
146 $error = $self->payinfo_check();
147 return $error if $error;
149 if ( $self->exp eq '' ) {
150 return "Expiration date required"
151 unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
154 if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
155 $self->exp("$1-$2-$3");
156 } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
157 if ( length($2) == 4 ) {
158 $self->exp("$2-$1-01");
159 } elsif ( $2 > 98 ) { #should pry change to check for "this year"
160 $self->exp("19$2-$1-01");
162 $self->exp("20$2-$1-01");
165 return "Illegal expiration date";
169 if ( $self->payname eq '' ) {
170 $self->payname( $self->first. " ". $self->getfield('last') );
172 $self->payname =~ /^([\w \,\.\-\']+)$/
173 or return "Illegal billing name";
177 #we have lots of old zips in there... don't hork up batch results cause of em
178 $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
179 or return "Illegal zip: ". $self->zip;
182 $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
185 #$error = $self->ut_zip('zip', $self->country);
186 #return $error if $error;
188 #check invnum, custnum, ?
195 Returns the customer (see L<FS::cust_main>) for this batched credit card
202 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
207 Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
208 credit card payment as retriable. Useful if the corresponding financial
209 institution account was declined for temporary reasons and/or a manual
212 Implementation details: For the named customer's invoice, changes the
213 statustext of the 'done' (without statustext) event to 'retriable.'
220 local $SIG{HUP} = 'IGNORE'; #Hmm
221 local $SIG{INT} = 'IGNORE';
222 local $SIG{QUIT} = 'IGNORE';
223 local $SIG{TERM} = 'IGNORE';
224 local $SIG{TSTP} = 'IGNORE';
225 local $SIG{PIPE} = 'IGNORE';
227 my $oldAutoCommit = $FS::UID::AutoCommit;
228 local $FS::UID::AutoCommit = 0;
231 my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
232 or return "event $self->eventnum references nonexistant invoice $self->invnum";
234 warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
235 my @cust_bill_event =
236 sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
238 $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
239 && $_->status eq 'done'
242 $cust_bill->cust_bill_event;
243 # complain loudly if scalar(@cust_bill_event) > 1 ?
244 my $error = $cust_bill_event[0]->retriable;
246 # gah, even with transactions.
247 $dbh->commit if $oldAutoCommit; #well.
248 return "error marking invoice event retriable: $error";
266 eval "use Text::CSV_XS;";
270 my $fh = $param->{'filehandle'};
271 my $format = $param->{'format'};
272 my $paybatch = $param->{'paybatch'};
274 my $filetype; # CSV, Fixed80, Fixed264
276 my $formatre; # for Fixed.+
282 my $approved_condition;
283 my $declined_condition;
285 if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) {
290 'paybatchnum', # Reference#: Invoice number of the transaction
291 'paid', # Amount: Amount of the transaction. Dollars and cents
292 # with no decimal entered.
293 '', # Card Type: 0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover,
294 # 4 - Insignia, 5 - Diners/EnRoute, 6 - JCB
295 '_date', # Transaction Date: Date the Transaction was processed
296 'time', # Transaction Time: Time the transaction was processed
297 'payinfo', # Card Number: Card number for the transaction
298 '', # Expiry Date: Expiry date of the card
299 '', # Auth#: Authorization number entered for force post
301 'type', # Transaction Type: 0 - purchase, 40 - refund,
303 'result', # Processing Result: 3 - Approval,
304 # 4 - Declined/Amount over limit,
305 # 5 - Invalid/Expired/stolen card,
307 '', # Terminal ID: Terminal ID used to process the transaction
310 $end_condition = sub {
312 $hash->{'type'} eq '0BC';
316 my( $hash, $total) = @_;
317 $total = sprintf("%.2f", $total);
318 my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100 );
319 return "Our total $total does not match bank total $batch_total!"
320 if $total != $batch_total;
326 $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
327 $hash->{'_date'} = timelocal( substr($hash->{'time'}, 4, 2),
328 substr($hash->{'time'}, 2, 2),
329 substr($hash->{'time'}, 0, 2),
330 substr($hash->{'_date'}, 6, 2),
331 substr($hash->{'_date'}, 4, 2)-1,
332 substr($hash->{'_date'}, 0, 4)-1900, );
335 $approved_condition = sub {
337 $hash->{'type'} eq '0' && $hash->{'result'} == 3;
340 $declined_condition = sub {
342 $hash->{'type'} eq '0' && ( $hash->{'result'} == 4
343 || $hash->{'result'} == 5 );
347 }elsif ( $format eq 'csv-chase_canada-E-xactBatch' ) {
352 '', # Internal(bank) id of the transaction
353 '', # Transaction Type: 00 - purchase, 01 - preauth,
354 # 02 - completion, 03 - forcepost,
355 # 04 - refund, 05 - auth,
356 # 06 - purchase corr, 07 - refund corr,
357 # 08 - void 09 - void return
358 '', # gateway used to process this transaction
359 'paid', # Amount: Amount of the transaction. Dollars and cents
360 # with decimal entered.
361 'auth', # Auth#: Authorization number (if approved)
362 'payinfo', # Card Number: Card number for the transaction
363 '', # Expiry Date: Expiry date of the card
364 '', # Cardholder Name
365 'bankcode', # Bank response code (3 alphanumeric)
366 'bankmess', # Bank response message
367 'etgcode', # ETG response code (2 alphanumeric)
368 'etgmess', # ETG response message
369 '', # Returned customer number for the transaction
370 'paybatchnum', # Reference#: paybatch number of the transaction
371 '', # Reference#: Invoice number of the transaction
372 'result', # Processing Result: Approved of Declined
375 $end_condition = sub {
382 $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'}); #hmmmm
383 $hash->{'_date'} = time; # got a better one?
384 $hash->{'payinfo'} = $cpb->{'payinfo'}
385 if( substr($hash->{'payinfo'}, -4) eq substr($cpb->{'payinfo'}, -4) );
388 $approved_condition = sub {
390 $hash->{'etgcode'} eq '00' && $hash->{'result'} eq "Approved";
393 $declined_condition = sub {
395 $hash->{'etgcode'} ne '00' # internal processing error
396 || ( $hash->{'result'} eq "Declined" );
400 }elsif ( $format eq 'PAP' ) {
402 $filetype = "Fixed264";
405 'recordtype', # We are interested in the 'D' or debit records
406 'batchnum', # Record#: batch number we used when sending the file
407 'datacenter', # Where in the bowels of the bank the data was processed
408 'paid', # Amount: Amount of the transaction. Dollars and cents
409 # with no decimal entered.
410 '_date', # Transaction Date: Date the Transaction was processed
411 'bank', # Routing information
412 'payinfo', # Account number for the transaction
413 'paybatchnum', # Reference#: Invoice number of the transaction
416 $formatre = '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$';
418 $end_condition = sub {
420 $hash->{'recordtype'} eq 'W';
424 my( $hash, $total) = @_;
425 $total = sprintf("%.2f", $total);
426 my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}.
427 substr($hash->{'_date'},0,1); # YUCK!
428 $batch_total = sprintf("%.2f", $batch_total / 100 );
429 return "Our total $total does not match bank total $batch_total!"
430 if $total != $batch_total;
436 $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
437 my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000);
438 $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ;
439 $hash->{'_date'} = $tmpdate;
440 $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
443 $approved_condition = sub {
447 $declined_condition = sub {
453 return "Unknown format $format";
456 my $csv = new Text::CSV_XS;
458 local $SIG{HUP} = 'IGNORE';
459 local $SIG{INT} = 'IGNORE';
460 local $SIG{QUIT} = 'IGNORE';
461 local $SIG{TERM} = 'IGNORE';
462 local $SIG{TSTP} = 'IGNORE';
463 local $SIG{PIPE} = 'IGNORE';
465 my $oldAutoCommit = $FS::UID::AutoCommit;
466 local $FS::UID::AutoCommit = 0;
469 my $pay_batch = qsearchs('pay_batch',{'batchnum'=> $paybatch});
470 unless ($pay_batch && $pay_batch->status eq 'I') {
471 $dbh->rollback if $oldAutoCommit;
472 return "batch $paybatch is not in transit";
475 my $newbatch = new FS::pay_batch { $pay_batch->hash };
476 $newbatch->status('R'); # Resolved
477 $newbatch->upload(time);
478 my $error = $newbatch->replace($pay_batch);
480 $dbh->rollback if $oldAutoCommit;
486 while ( defined($line=<$fh>) ) {
488 next if $line =~ /^\s*$/; #skip blank lines
490 if ($filetype eq "CSV") {
491 $csv->parse($line) or do {
492 $dbh->rollback if $oldAutoCommit;
493 return "can't parse: ". $csv->error_input();
495 @values = $csv->fields();
496 }elsif ($filetype eq "Fixed80" || $filetype eq "Fixed264"){
497 @values = $line =~ /$formatre/;
499 $dbh->rollback if $oldAutoCommit;
500 return "can't parse: ". $line;
503 $dbh->rollback if $oldAutoCommit;
504 return "Unknown file type $filetype";
508 foreach my $field ( @fields ) {
509 my $value = shift @values;
511 $hash{$field} = $value;
514 if ( &{$end_condition}(\%hash) ) {
515 my $error = &{$end_hook}(\%hash, $total);
517 $dbh->rollback if $oldAutoCommit;
524 qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
525 unless ( $cust_pay_batch ) {
526 $dbh->rollback if $oldAutoCommit;
527 return "unknown paybatchnum $hash{'paybatchnum'}\n";
529 my $custnum = $cust_pay_batch->custnum,
530 my $payby = $cust_pay_batch->payby,
532 my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
534 &{$hook}(\%hash, $cust_pay_batch->hashref);
536 if ( &{$approved_condition}(\%hash) ) {
538 $new_cust_pay_batch->status('Approved');
540 my $cust_pay = new FS::cust_pay ( {
541 'custnum' => $custnum,
543 'paybatch' => $paybatch,
544 map { $_ => $hash{$_} } (qw( paid _date payinfo )),
546 $error = $cust_pay->insert;
548 $dbh->rollback if $oldAutoCommit;
549 return "error adding payment paybatchnum $hash{'paybatchnum'}: $error\n";
551 $total += $hash{'paid'};
553 $cust_pay->cust_main->apply_payments;
555 } elsif ( &{$declined_condition}(\%hash) ) {
557 $new_cust_pay_batch->status('Declined');
559 foreach my $part_bill_event ( due_events ( $new_cust_pay_batch,
564 # don't run subsequent events if balance<=0
565 last if $cust_pay_batch->cust_main->balance <= 0;
567 if (my $error = $part_bill_event->do_event($new_cust_pay_batch)) {
568 # gah, even with transactions.
569 $dbh->commit if $oldAutoCommit; #well.
577 my $error = $new_cust_pay_batch->replace($cust_pay_batch);
579 $dbh->rollback if $oldAutoCommit;
580 return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n";
585 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
594 There should probably be a configuration file with a list of allowed credit
599 L<FS::cust_main>, L<FS::Record>