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