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