VirtualNet.pm

   1 package Business::OnlinePayment::VirtualNet;
   2
   3 use strict;
   4 use Carp;
   5 use File::CounterFile;
   6 use Date::Format;
   7 use Business::OnlinePayment;
   8 #use Business::CreditCard;
   9 use Net::SSLeay qw( make_form post_https );
  10 use String::Parity qw(setEvenParity isEvenParity);
  11 use String::LRC;
  12 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG);
  13
  14 require Exporter;
  15
  16 @ISA = qw(Exporter AutoLoader Business::OnlinePayment);
  17 @EXPORT = qw();
  18 @EXPORT_OK = qw();
  19 $VERSION = '0.01';
  20
  21 $DEBUG ||= 0;
  22
  23 use vars qw( $STX $ETX $FS $ETB );
  24 $STX = pack("C", 0x02 );
  25 $ETX = pack("C", 0x03 );
  26 $FS = pack("C", 0x1c );
  27 $ETB = pack("C", 0x17 );
  28 #$EOT = pack("C", 0x04 );
  29
  30 ##should be configurable **FIXME**
  31 #my $industry_code = '0';
  32 my $industry_code = 'D'; #Direct Marketing
  33
  34 sub set_defaults {
  35     my $self = shift;
  36     $self->server('ssl.pgs.wcom.net');
  37     $self->port('443');
  38     $self->path('/scripts/gateway.dll?Transact');
  39
  40     $self->build_subs(qw( authorization_source_code returned_ACI
  41                           transaction_sequence_num transaction_identifier
  42                           validation_code local_transaction_date
  43                           local_transaction_time AVS_result_code ));
  44 }
  45
  46 sub revmap_fields {
  47     my($self,%map) = @_;
  48     my %content = $self->content();
  49     foreach(keys %map) {
  50         $content{$_} = ref($map{$_})
  51                          ? ${ $map{$_} }
  52                          : $content{$map{$_}};
  53     }
  54     $self->content(%content);
  55 }
  56
  57 sub get_fields {
  58     my($self,@fields) = @_;
  59
  60     my %content = $self->content();
  61     my %new = ();
  62     foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; }
  63     return %new;
  64 }
  65
  66 sub submit {
  67     my($self) = @_;
  68     my %content = $self->content;
  69
  70     my $action = lc($content{'action'});
  71     #die 'eSec only supports "Authorization Only" transactions'
  72     #  unless $action eq 'authorization only';
  73
  74     #my %typemap = (
  75     #  "VISA card"                  => 'visa',
  76     #  "MasterCard"                 => 'mastercard',
  77     #  "Discover card"              => 'discover', #not supported...
  78     #  "American Express card"      => 'amex',
  79     #  "Diner's Club/Carte Blanche" => 'dinersclub',
  80     #  "enRoute"                    => 'enroute', #not supported...
  81     #  "JCB"                        => 'jcb',
  82     #  "BankCard"                   => 'bankcard',
  83     #);
  84     #my $cardtype = $self->test_transaction
  85     #                 ? 'testcard'
  86     #                 : $typemap{cardtype($content{'card_number'})};
  87
  88    #? what's supported
  89    if (  $self->transaction_type() =~
  90            /^(cc|visa|mastercard|american express|discover)$/i ) {
  91       $self->required_fields(qw/type action amount card_number expiration/);
  92     } else {
  93       croak("VirtualNet can't handle transaction type: ".
  94             $self->transaction_type());
  95     }
  96
  97     #my %content = $self->content;
  98     if ( $DEBUG ) {
  99       warn " \n";
 100       warn "content:$_ => $content{$_}\n" foreach keys %content;
 101     }
 102
 103     my( $message, $mimetype );
 104     if ( $action eq 'authorization only' ) {
 105       $message = $self->eis1080_request( \%content );
 106       $mimetype = 'x-Visa-II/x-auth';
 107     } elsif ( $action eq 'post authorization' ) {
 108       $message = $self->eis1081_request( \%content );
 109       $mimetype = 'x-Visa-II/x-settle';
 110     } elsif ( $action eq 'normal authorization' ) {
 111       croak 'Normal Authorization not supported';
 112     } elsif ( $action eq 'credit' ) {
 113       croak 'Credit not (yet) supported';
 114     }
 115
 116     if ( $DEBUG ) {
 117       warn "post_data:$message\n";
 118     }
 119
 120     my $server = $self->server();
 121     my $port = $self->port();
 122     my $path = $self->path();
 123     my($page,$response,%headers) =
 124       post_https($server,$port,$path,'',$message, $mimetype );
 125
 126     #warn "Response: $page";
 127
 128     if ( $page eq '' ) {
 129       die "protocol unsucessful: empty response, status $response\n";
 130     }
 131
 132     if ( $page =~ /^(\d+)\s+\-\s+(\S.*)$/ ) {
 133       die "VirtualNet protocol error: $page";
 134       #$self->is_success(0);
 135       #$self->result_code($1);
 136       #$self->error_message($2);
 137       #$self->error_message($page);
 138     } else {
 139       warn "protocol sucessful, decoding VisaNet-II response\n" if $DEBUG;
 140
 141       isEvenParity($page) or die "VisaNet-II response not even parity";
 142
 143       $page =~ s/(.)/pack('C', unpack('C',$1) & 0x7f)/ge; #drop parity bits
 144
 145       #warn $page;
 146
 147       my %response;
 148       if ( $action eq 'authorization only' ) {
 149         %response = $self->eis1080_response( $page );
 150       } elsif ( $action eq 'post authorization' ) {
 151         %response = $self->eis1081_response( $page );
 152       #} elsif ( $action eq 'normal authorization' ) {
 153       #  croak 'Normal Authorization not supported';
 154       #} elsif ( $action eq 'credit' ) {
 155       #  croak 'Credit not (yet) supported';
 156       }
 157
 158 #      $self->is_success($response{is_success});
 159 #      $self->result_code($response{result_code});
 160 #      $self->error_message($response{error_message});
 161 #      $self->authorization($response{authorization});
 162
 163        for my $field ( qw( is_success result_code error_message authorization
 164                            authorization_source_code returned_ACI
 165                            transaction_identifier validation_code
 166                            transaction_sequence_num local_transaction_date
 167                            local_transaction_time AVS_result_code ) ) {
 168          $self->$field($response{$field});
 169        }
 170
 171     }
 172
 173 }
 174
 175 sub testhost {
 176   my $self = shift;
 177
 178   my $content = 'D4.999995';
 179   #my $content = 'D2.999995';
 180   #my $content = 'D0.999995';
 181   my $message =
 182     $STX.
 183     $content.
 184     $ETX.
 185     lrc($content.$ETX)
 186   ;
 187   $message = setEvenParity $message;
 188
 189   if ( $DEBUG ) {
 190     warn "post_data: $message\n";
 191     warn "post_data hex dump: ". join(" ", unpack("H*", $message) ). "\n";
 192   }
 193
 194   my $server = $self->server();
 195   my $port = $self->port();
 196   my $path = $self->path();
 197   my($page,$response,%headers) =
 198     post_https($server,$port,$path,'',$message, 'x-Visa-II/x-auth');
 199
 200   #warn "Response: $page";
 201
 202   if ( $page =~ /^(\d+)\s+\-\s+(\S.*)$/ ) {
 203     die "VirtualNet protocol error: $page";
 204     #$self->is_success(0);
 205     #$self->result_code($1);
 206     #$self->error_message($2);
 207     #$self->error_message($page);
 208   } else {
 209     warn "protocol sucessful, not decoding VisaNet-II response" if $DEBUG;
 210     $self->is_success(1);
 211   }
 212
 213 }
 214
 215 sub eis1080_request {
 216   my( $self, $param ) = @_;
 217   # card_number expiration address zip amount
 218
 219   #D-Format    Authorization Request Message  (Non-Set Electronic Commerce)
 220
 221 #  my $zip = $param->{zip};
 222 #  $zip =~ s/\D//g;
 223 #  $zip = substr("$zip         ",0,9); #Left-justified/Space-filled
 224
 225   $param->{expiration} =~ /^(\d{1,2})\D+(\d{2})?(\d{2})$/
 226     or croak "unparsable expiration ". $param->{expiration};
 227   my ($month, $year) = ( $1, $3 );
 228   $month = "0$month" if length($month) < 2;
 229   my $exp= "$month$year";
 230
 231   #my $zip = $param->{zip};
 232   #$zip =~ s/\D//g;
 233   #$zip = substr("$zip         ",0,9);
 234
 235   my $amount = $param->{amount};
 236   $amount =~ s/\.//;
 237
 238   my $zip = substr( $self->zip. "         ", 0, 9 );
 239
 240   my $seq_file = $self->seq_file;
 241   my $counter = File::CounterFile->new($seq_file, '0001')
 242     or die "can't create sequence file $seq_file: $!";
 243
 244   $counter->lock();
 245   my $seq = substr('0000'.$counter->inc, -4);
 246   $seq = substr('0000'.$counter->inc, -4) if $seq eq '0000';
 247   $counter->unlock();
 248
 249                                 # Byte Length Field: Content
 250
 251   my $content = 'D4.';            # 1     1    Record format: D
 252                                   # 2     1    Application Type: 4=Interleaved
 253                                   # 3     1    Message Delimiter: .
 254   $content .= $self->bin;         # 4-9   6    Acquirer BIN
 255   $content .= $self->merchant_id; # 10-21 12   Merchant Number
 256   $content .= $self->store;       # 22-25 4    Store Number
 257   $content .= $self->terminal;    # 26-29 4    Terminal Number
 258   $content .= 'Q';                # 30    1    Device Code:
 259                                   #          Q="Third party software developer"
 260   #$content .= 'C';                # 30    1    Device Code: C="P.C."
 261   #$content .= 'M';                # 30    1    Device Code: M="Main Frame"
 262   $content .= $industry_code;      # 31    1    Industry Code
 263   $content .= '840';              # 32-34 3    Currency Code: 840=U.S. Dollars
 264   $content .= '840';              # 35-37 3    Country Code: 840=United States
 265   $content .= $zip;               # 38-46 9    (Merchant) City Code(Zip);
 266   $content .= '00';               # 47-48 2    Language Indicator: 00=English
 267                                   # ***FIXME***
 268   $content .= '705';              # 49-51 3    Time Zone Differential: 705=EST
 269   $content .= $self->mcc;         # 52-55 4    Metchant Category Code: 5999
 270   $content .= 'N';                # 56    1    Requested ACI (Authorization
 271                                   #            Characteristics Indicator):
 272                                   #            N=Device is not CPS capable
 273   $content .= $seq;               # 57-60 4    Tran Sequence Number
 274   $content .= '56';               # 61-62 2    Auth Transaction Code:
 275                                   #            56=Card Not Present
 276   $content .= 'N';                # 63    1    Cardholder ID Code: N=AVS
 277                                   #            (Address Verification Data or
 278                                   #            CPS/Card Not Present or
 279                                   #            Electronic Commerce)
 280   $content .= '@';                # 64    1    Account Data Source:
 281                                   #            @=No Cardreader
 282
 283   die "content-length should be 64!" unless length($content) == 64;
 284
 285   # - 5-76 Customer Data Field: Acct#<FS>ExpDate<FS>
 286   $content .= $param->{card_number}. $FS. $exp. $FS;
 287
 288   # - 1 Field Separator
 289   $content .= $FS;
 290
 291   # - 0-29 Address Verification Data
 292   $content .= substr($param->{address}, 0, 23)." ". substr($param->{zip}, 0, 5);
 293
 294   $content .= $FS; # - 1 Field Separator
 295   $content .= $FS; # - 1 Field Separator
 296
 297   $content .= $amount; # - 1-12 Transaction Amount
 298
 299   $content .= $FS; # - 1 Field Separator
 300   $content .= $FS; # - 1 Field Separator
 301   $content .= $FS; # - 1 Field Separator
 302
 303   # - 25 Merchant Name
 304   $content .= substr($self->merchant_name.(' 'x25),0,25);
 305
 306   # - 13 Merchant City
 307   $content .= substr($self->merchant_city.(' 'x13),0,13);
 308
 309   # - 2 Merchant State
 310   $content .= substr($self->merchant_state.('X'x2),0,2);
 311
 312   $content .= $FS; # - 1 Field Separator
 313   $content .= $FS; # - 1 Field Separator
 314   $content .= $FS; # - 1 Field Separator
 315
 316   #-----
 317
 318   $content .= '014'; # - 3 Group III Version Number:
 319                      #014=MOTO/Electronic Commerce
 320
 321   $content .= '7'; # - 1 MOTO/Electronic Com. Ind: 7= Non-Authenticated
 322                    # Security transaction, such as a channel-encrypted
 323                    # transaction (e.g., ssl, DES or RSA)
 324
 325
 326   my $message =
 327     $STX.
 328     $content.
 329     $ETX.
 330     lrc($content.$ETX)
 331   ;
 332
 333   $message = setEvenParity $message;
 334
 335   $message;
 336 }
 337
 338 sub eis1080_response {
 339   my( $self, $response) = @_;
 340   my %response;
 341
 342   $response =~ /^$STX(.{67})([\w ]{0,15})$FS([\w ]{0,4})$FS.*$ETX(.)$/
 343     or die "can't decode (eis1080) response: $response\n". join(' ', map { sprintf("%x", unpack('C',$_)) } split('', $response) );
 344   ( $response{transaction_identifier},
 345     $response{validation_code},
 346     my $lrc
 347   ) = ($2, $3, $4);
 348
 349   warn "$response\n".
 350        join(' ', map { sprintf("%x", unpack('C',$_)) } split('', $response) ).
 351        "\n"
 352     if $DEBUG;
 353
 354   (
 355     $response{record_format},
 356     $response{application_type},
 357     $response{message_delimiter},
 358     $response{returned_ACI},
 359     $response{store_number},
 360     $response{terminal_number},
 361     $response{authorization_source_code},
 362     $response{transaction_sequence_num},
 363     $response{response_code},
 364     $response{approval_code},
 365     $response{local_transaction_date},
 366     $response{local_transaction_time},
 367     $response{auth_response_text},
 368     $response{AVS_result_code},
 369     $response{retrieval_reference_num},
 370     $response{market_specific_data_id},
 371   ) = unpack "AAAAA4A4A1A4A2A6A6A6A16A1A12A1", $1;
 372
 373   if ( $response{record_format} ne "E" ) {
 374     die "unknown response record_format $response{record_format}";
 375   }
 376   if ( $response{application_type} ne "4" ) {
 377     die "unknown response record_format $response{application_type}";
 378   }
 379   if ( $response{message_delimiter} ne "." ) {
 380     die "unknown response record_format $response{message_delimiter}";
 381   }
 382
 383   $response{is_success} = $response{response_code} =~ /^(00|85)$/;
 384   $response{result_code} = $response{response_code};
 385   $response{error_message} = $response{auth_response_text};
 386   $response{authorization} = $response{approval_code};
 387   #$response{returned_ACI} = $response{returned_ACI};
 388   #$response{authorization_source_code} = $response{authorization_source_code};
 389   #$response{transaction_sequence_num} = $response{transaction_sequence_num};
 390
 391   %response;
 392 }
 393
 394 sub eis1081_request {
 395   my( $self, $param ) = @_;
 396
 397   my $batchnum_file = $self->batchnum_file;
 398   my $counter = File::CounterFile->new($batchnum_file, '001')
 399     or die "can't create batchnumuence file $batchnum_file: $!";
 400
 401   $counter->lock();
 402   my $batchnum = substr('000'.$counter->inc, -3);
 403   $batchnum = substr('000'.$counter->inc, -3) if $batchnum eq '000';
 404   $counter->unlock();
 405
 406   #K-Format Header Record (Base Group)
 407 #Byte Length Frmt Field description Content Section
 408                                   # Byte Length Field: Content (section)
 409   my $header = 'K1.ZH@@@@';   # 1     1  A/N Record Format: K (4.154)
 410                               # 2     1  NUM Application Type: 1=Single Batch
 411                               #                                          (4.10)
 412                               # 3     1  A/N Message Delimiter: . (4.123)
 413                               # 4     1  A/N X.25 Routing ID: Z (4.226)
 414                               # 5-9   5  A/N Record Type: H@@@@ (4.155)
 415   $header .= $self->bin;      # 10-15 6  NUM Acquirer BIN  (4.2)
 416   $header .= $self->agent;    # 16-21 6  NUM Agent Bank Number (4.5)
 417   $header .= $self->can('chain') ? $self->chain : '000000';
 418                               # 22-27 6  NUM Agent Chain Number (4.6)
 419   $header .= $self->merchant_id;
 420                               # 28-39 12 NUM Merchant Number (4.121)
 421   $header .= $self->store;    # 40-43 4  NUM Store Number (4.187)
 422   $header .= $self->terminal; # 44-47 4  NUM Terminal Number 9911 (4.195)
 423   $header .= 'Q';             # 48    1  A/N Device Code:
 424                               #       Q="Third party software developer" (4.62)
 425   #$header .= 'C';             # 48    1  A/N Device Code: C="P.C." (4.62)
 426   #$header .= 'M';            # 48    1  A/N Device Code M="Main Frame" (4.62)
 427   $header .= $industry_code;  # 49    1  A/N Industry Code (4.94)
 428   $header .= '840';           # 50-52 3  NUM Currency Code (4.52)
 429   $header .= '00';            # 53-54 2  NUM Language Indicator: 00=English
 430                               #                                         (4.104)
 431                               # ***FIXME***
 432   $header .= '705';           # 55-57 3  NUM Time Zone Differential (4.200)
 433
 434   my $mmdd = substr(time2str('0%m%d',time),-4);
 435   $header .= $mmdd;           # 58-61 4  NUM Batch Transmission Date MMDD (4.22)
 436
 437   $header .= $batchnum;       # 62-64 3  NUM Batch Number 001 - 999 (4.18)
 438   $header .= '0';             # 65    1  NUM Blocking Indicator 0=Not Blocked
 439                               #                                          (4.23)
 440
 441   die "header length should be 65!" unless length($header) == 65;
 442
 443   my $message =
 444     $STX.
 445     $header.
 446     $ETB.
 447     lrc($header.$ETB)
 448   ;
 449
 450   my $zip = substr( $self->zip. "         ", 0, 9 );
 451
 452   #K-Format Parameter Record (Base Group)
 453 #Byte Length Frmt Field Description Content Section
 454
 455   my $parameter = 'K1.ZP@@@@'; # 1   1 A/N Record Format: K (4.154)
 456                                # 2   1 NUM Application Type: 1=Single Batch
 457                                #                                         (4.10)
 458                                # 3   1 A/N Message Delimiter: . (4.123)
 459                                # 4   1 A/N X.25 Routing ID: Z (4.226)
 460                                # 5-9 5 A/N Record Type: P@@@@ (4.155)
 461   $parameter .= '840';         # 10-12 3 NUM Country Code 840 4.47
 462   $parameter .= $zip;          # 13-21 9 A/N City Code
 463                                #    Left-Justified/Space-Filled 4.43
 464   $parameter .= $self->mcc;    # 22-25 4 NUM Merchant Category Code (4.116)
 465
 466   # 26-50 25 A/N Merchant Name Left-Justified/Space-Filled (4.27.1)
 467   $parameter .= substr($self->merchant_name.(' 'x25),0,25);
 468
 469   #51-63 13 A/N Merchant City Left-Justified/Space-Filled (4.27.2)
 470   $parameter .= substr($self->merchant_city.(' 'x13),0,13);
 471
 472   # 64-65 2 A/N Merchant State (4.27.3)
 473   $parameter .= substr($self->merchant_state.('X'x2),0,2);
 474
 475   $parameter .= '00001'; # 66-70 5 A/N Merchant Location Number 00001 4.120
 476
 477   $parameter .= $self->v; # 71-78 8 NUM Terminal ID Number 00000001 4.194
 478
 479   die "parameter length should be 78 (is ". length($parameter). ")!"
 480     unless length($parameter) == 78;
 481
 482   $message .=
 483     $STX.
 484     $parameter.
 485     $ETB.
 486     lrc($parameter.$ETB)
 487   ;
 488
 489 # K-Format Detail Record (Electronic Commerce)
 490 #Byte Size Frmt Field Description Content Section
 491 #D@@'D'  `
 492   my $detail = 'K1.ZD@@`D';  # 1   1 A/N Record Format: K (4.154)
 493                               # 2   1 NUM Application Type 1=Single Batch
 494                               #                                          (4.10)
 495                               # 3   1 A/N Message Delimiter: . (4.123)
 496                               # 4   1 A/N X.25 Routing ID: Z (4.226)
 497                               # 5-9 5 A/N Record Type: D@@`D (4.155)
 498
 499   $detail .= '56';               # 10-11 2 A/N Transaction Code:
 500                                  #             56 = Card Not Present
 501                                  #             (4.205)
 502   $detail .= 'N';                # 12 1 A/N Cardholder Identification Code N 4.32
 503                                  #            (Address Verification Data or
 504                                  #            CPS/Card Not Present or
 505                                  #            Electronic Commerce)
 506   $detail .= '@';                # 13 1 A/N Account Data Source Code @ = No Cardreader 4.1
 507                                  #            @=No Cardreader
 508
 509   #14-35 22 A/N Cardholder Account Number Left-Justified/Space-Filled 4.30
 510   $detail .= substr( $param->{card_number}.'                      ', 0, 22 );
 511
 512   $detail .= 'N';                # 36    1    Requested ACI (Authorization
 513                                  #            Characteristics Indicator):
 514                                  #            N (4.163)
 515
 516   # 37 1 A/N Returned ACI (4.168)
 517   $detail .= $param->{returned_ACI} || 'N';
 518
 519   # *** 38 1 A/N Authorization Source Code (4.13)
 520   $detail .= $param->{authorization_source_code} || '6';
 521
 522   # 39-42 4 NUM Transaction Sequence Number Right-Justified/Zero-Filled (4.207)
 523   die "missing transaction_sequence_num"
 524     unless $param->{transaction_sequence_num};
 525   $detail .= $param->{transaction_sequence_num};
 526
 527   $detail .= '00'; # ###FIXME (from auth)*** 43-44 2 A/N Response Code 4.164
 528
 529   # 45-50 6 A/N Authorization Code Left-Justified/Space-Filled (4.12)
 530   $detail .= $param->{authorization};
 531
 532   # 51-54 4 NUM Local Transaction Date MMDD (4.113)
 533   die "missing local_transaction_date"
 534     unless $param->{local_transaction_date};
 535   $detail .= substr($param->{local_transaction_date}, 0, 4);
 536
 537   # 55-60 6 NUM Local Transaction Time HHMMSS (4.114)
 538   die "missing local_transaction_time"
 539     unless $param->{local_transaction_time};
 540   #die "length of local_transaction_time ". $param->{local_transaction_time}.
 541   #    " != 6"
 542   #  unless length($param->{local_transaction_time}) == 6;
 543   $detail .= $param->{local_transaction_time};
 544
 545   #(from auth) 61 1 A/N AVS Result Code 4.3
 546   die "missing AVS_result_code"
 547     unless $param->{AVS_result_code};
 548   $detail .= $param->{AVS_result_code};
 549
 550   # 62-76 15 A/N Transaction Identifier Left-Justified/Space-Filled 4.206
 551   $detail .= substr($param->{transaction_identifier}. (' 'x15), 0, 15);
 552
 553   # 77-80 4 A/N Validation Code 4.218
 554   $detail .= substr($param->{validation_code}.'    ', 0, 4);
 555
 556   $detail .= ' '; # 81 1 A/N Void Indicator <SPACE> = Not Voided 4.224
 557   $detail .= '00'; # 82-83 2 NUM Transaction Status Code 00 4.208
 558   $detail .= '0'; # 84 1 A/N Reimbursement Attribute 0 4.157
 559
 560   my $amount = $param->{amount};
 561   $amount =~ s/\.//;
 562   $amount = substr('000000000000'.$amount,-12);
 563
 564   $detail .= $amount; # 85-96 12 NUM Settlement Amount
 565                       # Right-Justified/Zero-Filled 4.175
 566
 567   $detail .= $amount; # 97-108 12 NUM Authorized Amount
 568                       # Right-Justified/Zero-Filled 4.14
 569
 570   $detail .= $amount; # 109-120 12 NUM Total Authorized Amount
 571                       # Right-Justified/Zero-Filled 4.201
 572
 573 #  $detail .= '1'; # 121 1 A/N Purchase Identifier Format Code 1 4.150
 574 #
 575 #  # 122-146 25 A/N Purchase Identifier Left-Justified/Space-Filled 4.149
 576 #  $detail .= 'Internet Services        ';
 577 #             #1234567890123456789012345
 578
 579   $detail .= '0'; # 121 1 A/N Purchase Identifier Format Code 1 4.150
 580
 581   # 122-146 25 A/N Purchase Identifier Left-Justified/Space-Filled 4.149
 582   $detail .= '                         ';
 583              #1234567890123456789012345
 584
 585   $detail .= '01'; # ??? 147-148 2 NUM Multiple Clearing Sequence Number 4.129
 586   $detail .= '01'; # ???  149-150 2 NUM Multiple Clearing Sequence Count 1.128
 587   $detail .= '7'; # 151 1 A/N MOTO/Electronic Commerce Indicator 7 = Channel Encrypted 4.127
 588
 589   die "detail length should be 151 (is ". length($detail). ")"
 590     unless length($detail) == 151;
 591
 592   $message .=
 593     $STX.
 594     $detail.
 595     $ETB.
 596     lrc($detail.$ETB)
 597   ;
 598
 599 # K-Format     Trailer Record
 600 #Byte    Length    Frmt    Field Description    Content    Section
 601
 602   my $trailer = 'K1.ZT@@@@';
 603 #1    1    A/N    Record Format    K    4.154
 604 #2    1    NUM    Application Type    1=Single 3=Multiple Batch    4.10
 605 #3    1    A/N    Message Delimiter    .    4.123
 606 #4    1    A/N    X.25 Routing ID    Z    4.226
 607 #5-9    5    A/N    Record Type    T@@@@    4.155
 608
 609   $trailer .= $mmdd;           # 10-13  4 NUM Batch Transmission Date MMDD 4.22
 610   $trailer .= $batchnum;       # 14-16  3 NUM Batch Number    001 - 999    4.18
 611   $trailer .= '000000004';        # 17-25  9 NUM Batch Record Count
 612                                   #Right-Justified/Zero-Filled    4.19
 613   $trailer .= '0000'.$amount;     # 26-41 16 NUM Batch Hashing Total
 614                                   #Purchases + Returns    4.16
 615   $trailer .= '0000000000000000'; # 42-57 16 NUM Cashback Total 4.38
 616   $trailer .= '0000'.$amount;     # 58-73 16 NUM Batch Net Deposit
 617                                   # Purchases - Returns    4.17
 618
 619   die "trailer length should be 73!" unless length($trailer) == 73;
 620
 621   $message .=
 622     $STX.
 623     $trailer.
 624     $ETX.
 625     lrc($trailer.$ETX)
 626   ;
 627
 628   ####
 629
 630   $message = setEvenParity $message;
 631
 632   $message;
 633
 634 }
 635
 636 sub eis1081_response {
 637   my( $self, $response ) = @_;
 638   my %response;
 639
 640   $response =~ /^$STX(.{41})(.*)$ETX(.)$/
 641     or die "can't decode (eis1081) response: $response";
 642   my $remainder = $2;
 643   my $lrc = $3;
 644
 645   (
 646     $response{record_format},
 647     $response{application_type},
 648     $response{message_delimiter},
 649     $response{x25_routing_id},
 650     $response{record_type},
 651     $response{batch_record_count},
 652     $response{batch_net_deposit},
 653     $response{batch_response_code},
 654     $response{filler},
 655     $response{batch_number},
 656   ) = unpack "AAAAA5A9A16A2A2A3", $1;
 657   warn "$1\n" if $DEBUG;
 658
 659   if ( $response{record_format} ne "K" ) {
 660     die "unknown response record_format $response{record_format}";
 661   }
 662   if ( $response{application_type} ne "1" ) {
 663     die "unknown response record_format $response{application_type}";
 664   }
 665   if ( $response{message_delimiter} ne "." ) {
 666     die "unknown response record_format $response{message_delimiter}";
 667   }
 668
 669   if ( $response{is_success} = $response{batch_response_code} eq 'GB' ) {
 670     $response{result_code} = $response{batch_response_code};
 671     $response{error_message} = '';
 672   } elsif ( $response{batch_response_code} eq 'RB' ) {
 673     $response{result_code} = $response{batch_response_code};
 674     #$remainder =~ /^(.)(.{4})(.)(..)(.{32})$/
 675     $remainder =~ /^(.)(.{4})(.)(..)(.*)$/
 676       or die "can't decode (eis1081) RB response (41+ ". length($remainder).
 677              "): $remainder";
 678     my( $error_type, $error_record_sequence_number, $error_record_type,
 679         $error_data_field_number, $error_data ) = ( $1, $2, $3, $4, $5 );
 680     my %error_type = (
 681       B => 'Blocked Terminal',
 682       C => 'Card Type Error',
 683       D => 'Device Error',
 684       E => 'Error in Batch',
 685       S => 'Sequence Error',
 686       T => 'Transmission Error',
 687       U => 'Unknown Error',
 688       V => 'Routing Error',
 689     );
 690     my %error_record_type = (
 691       H => 'Header Record',
 692       P => 'Parameter Record',
 693       D => 'Detail Record',
 694       T => 'Trailer Record',
 695     );
 696     $response{error_message} = 'Auth sucessful but capture rejected: '.
 697       $error_type{$error_type}. ' in '. $error_record_type{$error_record_type}.
 698       ' #'. $error_record_sequence_number. ' field #'. $error_data_field_number.
 699       ': '. $error_data;
 700   } else {
 701     $response{result_code} = $response{batch_response_code};
 702     $response{error_message} = $remainder;
 703   }
 704
 705   %response;
 706 }
 707
 708 1;
 709
 710 __END__
 711
 712 =head1 NAME
 713
 714 Business::OnlinePayment::VirtualNet - Vital VirtualNet backend for Business::OnlinePayment
 715
 716 =head1 SYNOPSIS
 717
 718   use Business::OnlinePayment;
 719
 720   my $tx = new Business::OnlinePayment("VirtualNet",
 721     'merchant_id' => '999999999911',
 722     'store'       => '0011',
 723     'terminal'    => '9911',
 724     'mcc'         => '5999', #merchant category code
 725     'bin'         => '999995', #acquirer BIN (Bank Identification Number)
 726     'zip'         => '543211420', #merchant zip (US) or assigned city code
 727
 728     'agent'       => '000000', #agent bank
 729     'v'           => '00000001',
 730
 731     'merchant_name'  => 'Internet Service Provider', #25 char max
 732     'merchant_city'  => 'Gloucester', #13 char max
 733     'merchant_state' => 'VA', #2 char
 734
 735     'seq_file'      => '/tmp/bop-virtualnet-sequence',
 736     'batchnum_file' => '/tmp/bop-virtualnet-batchnum', # :/  0-999 in 5 days
 737
 738   );
 739   $tx->content(
 740       type           => 'CC',
 741       login          => 'test',
 742       action         => 'Authorization Only',
 743       description    => 'Business::OnlinePayment test',
 744       amount         => '49.95',
 745       invoice_number => '100100',
 746       name           => 'Tofu Beast',
 747       card_number    => '4111111111111111',
 748       expiration     => '09/03',
 749   );
 750   $tx->submit();
 751
 752   if( $tx->is_success() ) {
 753       print "Card authorized successfully: ".$tx->authorization."\n";
 754   } else {
 755       print "Error: ".$tx->error_message."\n";
 756   }
 757
 758  if( $tx->is_success() ) {
 759
 760       my $capture = new Business::OnlinePayment("VirtualNet",
 761         'agent'       => '000001',
 762         'chain'       => '000000', #optional?
 763         'v'           => '00000001',
 764
 765         'merchant_id' => '999999999911',
 766         'store'       => '0011',
 767         'terminal'    => '9911',
 768         'mcc'         => '5999', #merchant category code
 769         'bin'         => '999995', #acquirer BIN (Bank Identification Number)
 770       );
 771
 772       $capture->content(
 773         type           => 'CC',
 774         action         => 'Post Authorization',
 775         amount         => '49.95',
 776         card_number    => '4111111111111111',
 777         expiration     => '09/03',
 778         authorization             => $tx->authorization,
 779         authorization_source_code => $tx->authorization_source_code,
 780         returned_ACI              => $tx->returned_ACI,
 781         transaction_identifier    => $tx->transaction_identifier,
 782         validation_code           => $tx->validation_code,
 783         transaction_sequence_num  => $tx->transaction_sequence_num,
 784         local_transaction_date    => $tx->local_transaction_date,
 785         local_transaction_time    => $tx->local_transaction_time,
 786         AVS_result_code           => $tx->AVS_result_code,
 787         #description    => 'Business::OnlinePayment::VirtualNet test',
 788
 789           action         => 'Post Authorization',
 790       #    order_number   => $ordernum,
 791       #    amount         => '0.01',
 792       #    authorization  => $auth,
 793       #    description    => 'Business::OnlinePayment::VirtualNet test',
 794       );
 795
 796       $capture->submit();
 797
 798       if( $capture->is_success() ) {
 799           print "Card captured successfully\n";
 800       } else {
 801           print "Error: ".$capture->error_message."\n";
 802       }
 803
 804   }
 805
 806 =head1 DESCRIPTION
 807
 808 For detailed information see L<Business::OnlinePayment>.
 809
 810 =head1 NOTE
 811
 812 =head1 COMPATIBILITY
 813
 814 This module implements the interface documented at
 815 http://www.vitalps.com/sections/int/int_Interfacespecs.html
 816
 817 Specifically, start with
 818 http://www.vitalps.com/pdfs_specs/VirtualNet%020Specification%0200011.pdf
 819 and then http://www.vitalps.com/pdfs_specs/EIS%0201080%020v6_4_1.pdf and
 820 http://www.vitalps.com/pdfs_specs/EIS_1081_v_6_4.pdf and maybe even
 821 http://www.vitalps.com/pdfs_specs/EIS%0201051.pdf and
 822 http://www.vitalps.com/pdfs_specs/EIS%0201052.pdf
 823
 824 =head1 AUTHOR
 825
 826 Ivan Kohler <ivan-virtualnet@420.am>
 827
 828 =head1 SEE ALSO
 829
 830 perl(1). L<Business::OnlinePayment>.
 831
 832 =cut
 833