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