FS/FS/cust_pay_batch.pm

   1 package FS::cust_pay_batch;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw(dbh qsearch qsearchs);
   6 use FS::payinfo_Mixin;
   7 use FS::part_bill_event qw(due_events);
   8 use Business::CreditCard 0.28;
   9
  10 @ISA = qw( FS::Record FS::payinfo_Mixin );
  11
  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
  15 $DEBUG = 0;
  16
  17 =head1 NAME
  18
  19 FS::cust_pay_batch - Object methods for batch cards
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::cust_pay_batch;
  24
  25   $record = new FS::cust_pay_batch \%hash;
  26   $record = new FS::cust_pay_batch { 'column' => 'value' };
  27
  28   $error = $record->insert;
  29
  30   $error = $new_record->replace($old_record);
  31
  32   $error = $record->delete;
  33
  34   $error = $record->check;
  35
  36   $error = $record->retriable;
  37
  38 =head1 DESCRIPTION
  39
  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:
  44
  45 =over 4
  46
  47 =item paybatchnum - primary key (automatically assigned)
  48
  49 =item batchnum - indentifies group in batch
  50
  51 =item payby - CARD/CHEK/LECB/BILL/COMP
  52
  53 =item payinfo
  54
  55 =item exp - card expiration
  56
  57 =item amount
  58
  59 =item invnum - invoice
  60
  61 =item custnum - customer
  62
  63 =item payname - name on card
  64
  65 =item first - name
  66
  67 =item last - name
  68
  69 =item address1
  70
  71 =item address2
  72
  73 =item city
  74
  75 =item state
  76
  77 =item zip
  78
  79 =item country
  80
  81 =item status
  82
  83 =back
  84
  85 =head1 METHODS
  86
  87 =over 4
  88
  89 =item new HASHREF
  90
  91 Creates a new record.  To add the record to the database, see L<"insert">.
  92
  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.
  95
  96 =cut
  97
  98 sub table { 'cust_pay_batch'; }
  99
 100 =item insert
 101
 102 Adds this record to the database.  If there is an error, returns the error,
 103 otherwise returns false.
 104
 105 =item delete
 106
 107 Delete this record from the database.  If there is an error, returns the error,
 108 otherwise returns false.
 109
 110 =item replace OLD_RECORD
 111
 112 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 113 returns the error, otherwise returns false.
 114
 115 =item check
 116
 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
 119 and replace methods.
 120
 121 =cut
 122
 123 sub check {
 124   my $self = shift;
 125
 126   my $error =
 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')
 136   ;
 137
 138   return $error if $error;
 139
 140   $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
 141   $self->setfield('last',$1);
 142
 143   $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
 144   $self->first($1);
 145
 146   $error = $self->payinfo_check();
 147   return $error if $error;
 148
 149   if ( $self->exp eq '' ) {
 150     return "Expiration date required"
 151       unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
 152     $self->exp('');
 153   } else {
 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");
 161       } else {
 162         $self->exp("20$2-$1-01");
 163       }
 164     } else {
 165       return "Illegal expiration date";
 166     }
 167   }
 168
 169   if ( $self->payname eq '' ) {
 170     $self->payname( $self->first. " ". $self->getfield('last') );
 171   } else {
 172     $self->payname =~ /^([\w \,\.\-\']+)$/
 173       or return "Illegal billing name";
 174     $self->payname($1);
 175   }
 176
 177   #$self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
 178   #  or return "Illegal zip: ". $self->zip;
 179   #$self->zip($1);
 180
 181   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 182   $self->country($1);
 183
 184   $error = $self->ut_zip('zip', $self->country);
 185   return $error if $error;
 186
 187   #check invnum, custnum, ?
 188
 189   $self->SUPER::check;
 190 }
 191
 192 =item cust_main
 193
 194 Returns the customer (see L<FS::cust_main>) for this batched credit card
 195 payment.
 196
 197 =cut
 198
 199 sub cust_main {
 200   my $self = shift;
 201   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 202 }
 203
 204 =item retriable
 205
 206 Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
 207 credit card payment as retriable.  Useful if the corresponding financial
 208 institution account was declined for temporary reasons and/or a manual
 209 retry is desired.
 210
 211 Implementation details: For the named customer's invoice, changes the
 212 statustext of the 'done' (without statustext) event to 'retriable.'
 213
 214 =cut
 215
 216 sub retriable {
 217   my $self = shift;
 218
 219   local $SIG{HUP} = 'IGNORE';        #Hmm
 220   local $SIG{INT} = 'IGNORE';
 221   local $SIG{QUIT} = 'IGNORE';
 222   local $SIG{TERM} = 'IGNORE';
 223   local $SIG{TSTP} = 'IGNORE';
 224   local $SIG{PIPE} = 'IGNORE';
 225
 226   my $oldAutoCommit = $FS::UID::AutoCommit;
 227   local $FS::UID::AutoCommit = 0;
 228   my $dbh = dbh;
 229
 230   my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
 231     or return "event $self->eventnum references nonexistant invoice $self->invnum";
 232
 233   warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
 234   my @cust_bill_event =
 235     sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
 236       grep {
 237         $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
 238           && $_->status eq 'done'
 239           && ! $_->statustext
 240         }
 241       $cust_bill->cust_bill_event;
 242   # complain loudly if scalar(@cust_bill_event) > 1 ?
 243   my $error = $cust_bill_event[0]->retriable;
 244   if ($error ) {
 245     # gah, even with transactions.
 246     $dbh->commit if $oldAutoCommit; #well.
 247     return "error marking invoice event retriable: $error";
 248   }
 249   '';
 250 }
 251
 252 =back
 253
 254 =head1 SUBROUTINES
 255
 256 =over 4
 257
 258 =item import_results
 259
 260 =cut
 261
 262 sub import_results {
 263   use Time::Local;
 264   use FS::cust_pay;
 265   eval "use Text::CSV_XS;";
 266   die $@ if $@;
 267 #
 268   my $param = shift;
 269   my $fh = $param->{'filehandle'};
 270   my $format = $param->{'format'};
 271   my $paybatch = $param->{'paybatch'};
 272
 273   my $filetype;      # CSV, Fixed80, Fixed264
 274   my @fields;
 275   my $formatre;      # for Fixed.+
 276   my @values;
 277   my $begin_condition;
 278   my $end_condition;
 279   my $end_hook;
 280   my $hook;
 281   my $approved_condition;
 282   my $declined_condition;
 283
 284   if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) {
 285
 286     $filetype = "CSV";
 287
 288     @fields = (
 289       'paybatchnum', # Reference#:  Invoice number of the transaction
 290       'paid',        # Amount:  Amount of the transaction.  Dollars and cents
 291                      #          with no decimal entered.
 292       '',            # Card Type:  0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover,
 293                      #             4 - Insignia, 5 - Diners/EnRoute, 6 - JCB
 294       '_date',       # Transaction Date:  Date the Transaction was processed
 295       'time',        # Transaction Time:  Time the transaction was processed
 296       'payinfo',     # Card Number:  Card number for the transaction
 297       '',            # Expiry Date:  Expiry date of the card
 298       '',            # Auth#:  Authorization number entered for force post
 299                      #         transaction
 300       'type',        # Transaction Type:  0 - purchase, 40 - refund,
 301                      #                    20 - force post
 302       'result',      # Processing Result: 3 - Approval,
 303                      #                    4 - Declined/Amount over limit,
 304                      #                    5 - Invalid/Expired/stolen card,
 305                      #                    6 - Comm Error
 306       '',            # Terminal ID: Terminal ID used to process the transaction
 307     );
 308
 309     $end_condition = sub {
 310       my $hash = shift;
 311       $hash->{'type'} eq '0BC';
 312     };
 313
 314     $end_hook = sub {
 315       my( $hash, $total) = @_;
 316       $total = sprintf("%.2f", $total);
 317       my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100 );
 318       return "Our total $total does not match bank total $batch_total!"
 319         if $total != $batch_total;
 320       '';
 321     };
 322
 323     $hook = sub {
 324       my $hash = shift;
 325       $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
 326       $hash->{'_date'} = timelocal( substr($hash->{'time'},  4, 2),
 327                                     substr($hash->{'time'},  2, 2),
 328                                     substr($hash->{'time'},  0, 2),
 329                                     substr($hash->{'_date'}, 6, 2),
 330                                     substr($hash->{'_date'}, 4, 2)-1,
 331                                     substr($hash->{'_date'}, 0, 4)-1900, );
 332     };
 333
 334     $approved_condition = sub {
 335       my $hash = shift;
 336       $hash->{'type'} eq '0' && $hash->{'result'} == 3;
 337     };
 338
 339     $declined_condition = sub {
 340       my $hash = shift;
 341       $hash->{'type'} eq '0' && (    $hash->{'result'} == 4
 342                                   || $hash->{'result'} == 5 );
 343     };
 344
 345
 346   }elsif ( $format eq 'csv-chase_canada-E-xactBatch' ) {
 347
 348     $filetype = "CSV";
 349
 350     @fields = (
 351       '',            # Internal(bank) id of the transaction
 352       '',            # Transaction Type:  00 - purchase,      01 - preauth,
 353                      #                    02 - completion,    03 - forcepost,
 354                      #                    04 - refund,        05 - auth,
 355                      #                    06 - purchase corr, 07 - refund corr,
 356                      #                    08 - void           09 - void return
 357       '',            # gateway used to process this transaction
 358       'paid',        # Amount:  Amount of the transaction.  Dollars and cents
 359                      #          with decimal entered.
 360       'auth',        # Auth#:  Authorization number (if approved)
 361       'payinfo',     # Card Number:  Card number for the transaction
 362       '',            # Expiry Date:  Expiry date of the card
 363       '',            # Cardholder Name
 364       'bankcode',    # Bank response code (3 alphanumeric)
 365       'bankmess',    # Bank response message
 366       'etgcode',     # ETG response code (2 alphanumeric)
 367       'etgmess',     # ETG response message
 368       '',            # Returned customer number for the transaction
 369       'paybatchnum', # Reference#:  paybatch number of the transaction
 370       '',            # Reference#:  Invoice number of the transaction
 371       'result',      # Processing Result: Approved of Declined
 372     );
 373
 374     $end_condition = sub {
 375       '';
 376     };
 377
 378     $hook = sub {
 379       my $hash = shift;
 380       $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'}); #hmmmm
 381       $hash->{'_date'} = time;  # got a better one?
 382     };
 383
 384     $approved_condition = sub {
 385       my $hash = shift;
 386       $hash->{'etgcode'} eq '00' && $hash->{'result'} eq "Approved";
 387     };
 388
 389     $declined_condition = sub {
 390       my $hash = shift;
 391       $hash->{'etgcode'} ne '00' # internal processing error
 392         || ( $hash->{'result'} eq "Declined" );
 393     };
 394
 395
 396   }elsif ( $format eq 'PAP' ) {
 397
 398     $filetype = "Fixed264";
 399
 400     @fields = (
 401       'recordtype',  # We are interested in the 'D' or debit records
 402       'batchnum',    # Record#:  batch number we used when sending the file
 403       'datacenter',  # Where in the bowels of the bank the data was processed
 404       'paid',        # Amount:  Amount of the transaction.  Dollars and cents
 405                      #          with no decimal entered.
 406       '_date',       # Transaction Date:  Date the Transaction was processed
 407       'bank',        # Routing information
 408       'payinfo',     # Account number for the transaction
 409       'paybatchnum', # Reference#:  Invoice number of the transaction
 410     );
 411
 412     $formatre = '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$';
 413
 414     $end_condition = sub {
 415       my $hash = shift;
 416       $hash->{'recordtype'} eq 'W';
 417     };
 418
 419     $end_hook = sub {
 420       my( $hash, $total) = @_;
 421       $total = sprintf("%.2f", $total);
 422       my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}.
 423                         substr($hash->{'_date'},0,1);          # YUCK!
 424       $batch_total = sprintf("%.2f", $batch_total / 100 );
 425       return "Our total $total does not match bank total $batch_total!"
 426         if $total != $batch_total;
 427       '';
 428     };
 429
 430     $hook = sub {
 431       my $hash = shift;
 432       $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
 433       my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000);
 434       $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ;
 435       $hash->{'_date'} = $tmpdate;
 436       $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
 437     };
 438
 439     $approved_condition = sub {
 440       1;
 441     };
 442
 443     $declined_condition = sub {
 444       0;
 445     };
 446
 447
 448   } else {
 449     return "Unknown format $format";
 450   }
 451
 452   my $csv = new Text::CSV_XS;
 453
 454   local $SIG{HUP} = 'IGNORE';
 455   local $SIG{INT} = 'IGNORE';
 456   local $SIG{QUIT} = 'IGNORE';
 457   local $SIG{TERM} = 'IGNORE';
 458   local $SIG{TSTP} = 'IGNORE';
 459   local $SIG{PIPE} = 'IGNORE';
 460
 461   my $oldAutoCommit = $FS::UID::AutoCommit;
 462   local $FS::UID::AutoCommit = 0;
 463   my $dbh = dbh;
 464
 465   my $pay_batch = qsearchs('pay_batch',{'batchnum'=> $paybatch});
 466   unless ($pay_batch && $pay_batch->status eq 'I') {
 467     $dbh->rollback if $oldAutoCommit;
 468     return "batch $paybatch is not in transit";
 469   };
 470
 471   my $newbatch = new FS::pay_batch { $pay_batch->hash };
 472   $newbatch->status('R');   # Resolved
 473   $newbatch->upload(time);
 474   my $error = $newbatch->replace($pay_batch);
 475   if ( $error ) {
 476     $dbh->rollback if $oldAutoCommit;
 477     return $error
 478   }
 479
 480   my $total = 0;
 481   my $line;
 482   while ( defined($line=<$fh>) ) {
 483
 484     next if $line =~ /^\s*$/; #skip blank lines
 485
 486     if ($filetype eq "CSV") {
 487       $csv->parse($line) or do {
 488         $dbh->rollback if $oldAutoCommit;
 489         return "can't parse: ". $csv->error_input();
 490       };
 491       @values = $csv->fields();
 492     }elsif ($filetype eq "Fixed80" || $filetype eq "Fixed264"){
 493       @values = $line =~ /$formatre/;
 494       unless (@values) {
 495         $dbh->rollback if $oldAutoCommit;
 496         return "can't parse: ". $line;
 497       };
 498     }else{
 499       $dbh->rollback if $oldAutoCommit;
 500       return "Unknown file type $filetype";
 501     }
 502
 503     my %hash;
 504     foreach my $field ( @fields ) {
 505       my $value = shift @values;
 506       next unless $field;
 507       $hash{$field} = $value;
 508     }
 509
 510     if ( &{$end_condition}(\%hash) ) {
 511       my $error = &{$end_hook}(\%hash, $total);
 512       if ( $error ) {
 513         $dbh->rollback if $oldAutoCommit;
 514         return $error;
 515       }
 516       last;
 517     }
 518
 519     my $cust_pay_batch =
 520       qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
 521     unless ( $cust_pay_batch ) {
 522       $dbh->rollback if $oldAutoCommit;
 523       return "unknown paybatchnum $hash{'paybatchnum'}\n";
 524     }
 525     my $custnum = $cust_pay_batch->custnum,
 526     my $payby = $cust_pay_batch->payby,
 527
 528     my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
 529
 530     &{$hook}(\%hash);
 531
 532     if ( &{$approved_condition}(\%hash) ) {
 533
 534       $new_cust_pay_batch->status('Approved');
 535
 536       my $cust_pay = new FS::cust_pay ( {
 537         'custnum'  => $custnum,
 538         'payby'    => $payby,
 539         'paybatch' => $paybatch,
 540         map { $_ => $hash{$_} } (qw( paid _date payinfo )),
 541       } );
 542       $error = $cust_pay->insert;
 543       if ( $error ) {
 544         $dbh->rollback if $oldAutoCommit;
 545         return "error adding payment paybatchnum $hash{'paybatchnum'}: $error\n";
 546       }
 547       $total += $hash{'paid'};
 548
 549       $cust_pay->cust_main->apply_payments;
 550
 551     } elsif ( &{$declined_condition}(\%hash) ) {
 552
 553       $new_cust_pay_batch->status('Declined');
 554
 555       foreach my $part_bill_event ( due_events ( $new_cust_pay_batch,
 556                                                  'DCLN',
 557                                                  '',
 558                                                  '') ) {
 559
 560         # don't run subsequent events if balance<=0
 561         last if $cust_pay_batch->cust_main->balance <= 0;
 562
 563         if (my $error = $part_bill_event->do_event($new_cust_pay_batch)) {
 564           # gah, even with transactions.
 565           $dbh->commit if $oldAutoCommit; #well.
 566           return $error;
 567         }
 568
 569       }
 570
 571     }
 572
 573     my $error = $new_cust_pay_batch->replace($cust_pay_batch);
 574     if ( $error ) {
 575       $dbh->rollback if $oldAutoCommit;
 576       return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n";
 577     }
 578
 579   }
 580
 581   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 582   '';
 583
 584 }
 585
 586 =back
 587
 588 =head1 BUGS
 589
 590 There should probably be a configuration file with a list of allowed credit
 591 card types.
 592
 593 =head1 SEE ALSO
 594
 595 L<FS::cust_main>, L<FS::Record>
 596
 597 =cut
 598
 599 1;
 600