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