From 66bb30f463ce9846ffa5d98ff0df20851aa4815a Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 26 Aug 2002 18:15:04 +0000 Subject: [PATCH 1/1] initial import --- Changes | 4 + MANIFEST | 10 + Makefile.PL | 18 ++ README | 17 ++ VirtualNet.pm | 818 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/bad_auth.t | 59 ++++ t/bop.t | 5 + t/credit_card.t | 89 ++++++ t/load.t | 5 + t/testhost.t | 14 + 10 files changed, 1039 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 VirtualNet.pm create mode 100644 t/bad_auth.t create mode 100644 t/bop.t create mode 100644 t/credit_card.t create mode 100644 t/load.t create mode 100644 t/testhost.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..007c411 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension Business::OnlinePayment::VirtualNet + +0.01 Fri Jul 19 08:25:26 PDT 2002 + -original version; created by ivan 1.0 diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..9023254 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,10 @@ +VirtualNet.pm +Changes +MANIFEST +Makefile.PL +README +t/load.t +t/credit_card.t +t/bop.t +t/bad_auth.t +t/testhost.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..ae6d26a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Business::OnlinePayment::VirtualNet', + 'VERSION_FROM' => 'VirtualNet.pm', # finds $VERSION + 'AUTHOR' => 'Ivan Kohler ', + #'NORECURS' => 1, # dont descend into subdirectories + 'PREREQ_PM' => { 'Net::SSLeay' => 0, + #'Text::CSV_XS' => 0, + 'Business::OnlinePayment' => 0, + #'Business::CreditCard' => 0.27, + 'String::Parity' => 0, + 'String::LRC' => 0, + 'File::CounterFile' => 0, + 'Date::Format' => 0, + }, +); diff --git a/README b/README new file mode 100644 index 0000000..97e536e --- /dev/null +++ b/README @@ -0,0 +1,17 @@ +Copyright (c) 2002 Ivan Kohler +All rights reserved. This program is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +This is Business::OnlinePayment::VirtualNet, an Business::OnlinePayment +backend module for Vital VirtualNet. It is only useful if you have a merchant +account with Vital VirtualNet: +http://www.vitalps.com/sections/merch/mer_ps_VNET_info.html + +It based on Business::OnlinePayment::AuthorizeNet written by Jason Kohles. + +Ivan Kohler + +Business::OnlinePayment is a generic interface for processing payments through +online credit card processors, online check acceptance houses, etc. (If you +like buzzwords, call it an "multiplatform ecommerce-enabling middleware +solution"). diff --git a/VirtualNet.pm b/VirtualNet.pm new file mode 100644 index 0000000..84530b6 --- /dev/null +++ b/VirtualNet.pm @@ -0,0 +1,818 @@ +package Business::OnlinePayment::VirtualNet; + +use strict; +use Carp; +use File::CounterFile; +use Date::Format; +use Business::OnlinePayment; +#use Business::CreditCard; +use Net::SSLeay qw( make_form post_https ); +use String::Parity qw(setEvenParity isEvenParity); +use String::LRC; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG); + +require Exporter; + +@ISA = qw(Exporter AutoLoader Business::OnlinePayment); +@EXPORT = qw(); +@EXPORT_OK = qw(); +$VERSION = '0.01'; + +$DEBUG ||= 0; + +use vars qw( $STX $ETX $FS $ETB ); +$STX = pack("C", 0x02 ); +$ETX = pack("C", 0x03 ); +$FS = pack("C", 0x1c ); +$ETB = pack("C", 0x17 ); +#$EOT = pack("C", 0x04 ); + +##should be configurable **FIXME** +my $industry_code = '0'; + +sub set_defaults { + my $self = shift; + $self->server('ssl.pgs.wcom.net'); + $self->port('443'); + $self->path('/scripts/gateway.dll?Transact'); + + $self->build_subs(qw( authorization_source_code returned_ACI + transaction_sequence_num transaction_identifier + validation_code )); +} + +sub revmap_fields { + my($self,%map) = @_; + my %content = $self->content(); + foreach(keys %map) { + $content{$_} = ref($map{$_}) + ? ${ $map{$_} } + : $content{$map{$_}}; + } + $self->content(%content); +} + +sub get_fields { + my($self,@fields) = @_; + + my %content = $self->content(); + my %new = (); + foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; } + return %new; +} + +sub submit { + my($self) = @_; + my %content = $self->content; + + my $action = lc($content{'action'}); + #die 'eSec only supports "Authorization Only" transactions' + # unless $action eq 'authorization only'; + + #my %typemap = ( + # "VISA card" => 'visa', + # "MasterCard" => 'mastercard', + # "Discover card" => 'discover', #not supported... + # "American Express card" => 'amex', + # "Diner's Club/Carte Blanche" => 'dinersclub', + # "enRoute" => 'enroute', #not supported... + # "JCB" => 'jcb', + # "BankCard" => 'bankcard', + #); + #my $cardtype = $self->test_transaction + # ? 'testcard' + # : $typemap{cardtype($content{'card_number'})}; + + #? what's supported + if ( $self->transaction_type() =~ + /^(cc|visa|mastercard|american express|discover)$/i ) { + $self->required_fields(qw/type action amount card_number expiration/); + } else { + croak("VirtualNet can't handle transaction type: ". + $self->transaction_type()); + } + + #my %content = $self->content; + if ( $DEBUG ) { + warn " \n"; + warn "content:$_ => $content{$_}\n" foreach keys %content; + } + + my( $message, $mimetype ); + if ( $action eq 'authorization only' ) { + $message = $self->eis1080_request( \%content ); + $mimetype = 'x-Visa-II/x-auth'; + } elsif ( $action eq 'post authorization' ) { + $message = $self->eis1081_request( \%content ); + $mimetype = 'x-Visa-II/x-settle'; + } elsif ( $action eq 'normal authorization' ) { + croak 'Normal Authorization not supported'; + } elsif ( $action eq 'credit' ) { + croak 'Credit not (yet) supported'; + } + + if ( $DEBUG ) { + warn "post_data:$message\n"; + } + + my $server = $self->server(); + my $port = $self->port(); + my $path = $self->path(); + my($page,$response,%headers) = + post_https($server,$port,$path,'',$message, $mimetype ); + + #warn "Response: $page"; + + if ( $page eq '' ) { + die "protocol unsucessful: empty response, status $response\n"; + } + + if ( $page =~ /^(\d+)\s+\-\s+(\S.*)$/ ) { + die "protocol unsucessful: $page"; + #$self->is_success(0); + #$self->result_code($1); + #$self->error_message($2); + #$self->error_message($page); + } else { + warn "protocol sucessful, decoding VisaNet-II response\n" if $DEBUG; + + isEvenParity($page) or die "VisaNet-II response not even parity"; + + $page =~ s/(.)/pack('C', unpack('C',$1) & 0x7f)/ge; #drop parity bits + + #warn $page; + + my %response; + if ( $action eq 'authorization only' ) { + %response = $self->eis1080_response( $page ); + } elsif ( $action eq 'post authorization' ) { + %response = $self->eis1081_response( $page ); + #} elsif ( $action eq 'normal authorization' ) { + # croak 'Normal Authorization not supported'; + #} elsif ( $action eq 'credit' ) { + # croak 'Credit not (yet) supported'; + } + +# $self->is_success($response{is_success}); +# $self->result_code($response{result_code}); +# $self->error_message($response{error_message}); +# $self->authorization($response{authorization}); + + for my $field ( qw( is_success result_code error_message authorization + authorization_source_code returned_ACI + transaction_identifier validation_code + transaction_sequence_num ) ) { + $self->$field($response{$field}); + } + + } + +# my( $r, $a, $m, $s, $e ) = +# map { /^\s*\w+\s*\=\s*(.*)$/; $1; } split("\n", $page); + +# if ( $m =~ /^200/ ) { +# $self->is_success(1); +# $self->result_code($e); +# $self->authorization($a); +# } else { +# $self->is_success(0); +# $self->result_code($e); +# $self->error_message($m); +# } + +} + +sub testhost { + my $self = shift; + + my $content = 'D4.999995'; + #my $content = 'D2.999995'; + #my $content = 'D0.999995'; + my $message = + $STX. + $content. + $ETX. + lrc($content.$ETX) + ; + $message = setEvenParity $message; + + if ( $DEBUG ) { + warn "post_data: $message\n"; + warn "post_data hex dump: ". join(" ", unpack("H*", $message) ). "\n"; + } + + my $server = $self->server(); + my $port = $self->port(); + my $path = $self->path(); + my($page,$response,%headers) = + post_https($server,$port,$path,'',$message, 'x-Visa-II/x-auth'); + + #warn "Response: $page"; + + if ( $page =~ /^(\d+)\s+\-\s+(\S.*)$/ ) { + die "protocol unsucessful: $page"; + #$self->is_success(0); + #$self->result_code($1); + #$self->error_message($2); + #$self->error_message($page); + } else { + warn "protocol sucessful, not decoding VisaNet-II response" if $DEBUG; + $self->is_success(1); + } + +} + +sub eis1080_request { + my( $self, $param ) = @_; + # card_number expiration address zip amount + + #D-Format Authorization Request Message (Non-Set Electronic Commerce) + +# my $zip = $param->{zip}; +# $zip =~ s/\D//g; +# $zip = substr("$zip ",0,9); #Left-justified/Space-filled + + $param->{expiration} =~ /^(\d{1,2})\D+(\d{2})?(\d{2})$/ + or croak "unparsable expiration ". $param->{expiration}; + my ($month, $year) = ( $1, $3 ); + $month = "0$month" if length($month) < 2; + my $exp= "$month$year"; + + #my $zip = $param->{zip}; + #$zip =~ s/\D//g; + #$zip = substr("$zip ",0,9); + + my $amount = $param->{amount}; + $amount =~ s/\.//; + + my $zip = substr( $self->zip. " ", 0, 9 ); + + my $seq_file = $self->seq_file; + my $counter = File::CounterFile->new($seq_file, '0001') + or die "can't create sequence file $seq_file: $!"; + + $counter->lock(); + my $seq = substr('0000'.$counter->inc, -4); + $seq = substr('0000'.$counter->inc, -4) if $seq eq '0000'; + $counter->unlock(); + + # Byte Length Field: Content + + my $content = 'D4.'; # 1 1 Record format: D + # 2 1 Application Type: 4=Interleaved + # 3 1 Message Delimiter: . + $content .= $self->bin; # 4-9 6 Acquirer BIN + $content .= $self->merchant_id; # 10-21 12 Merchant Number + $content .= $self->store; # 22-25 4 Store Number + $content .= $self->terminal; # 26-29 4 Terminal Number + $content .= 'C'; # 30 1 Device Code: C="P.C." + #$content .= 'M'; # 30 1 Device Code: M="Main Frame" + $content .= $industry_code; # 31 1 Industry Code + $content .= '840'; # 32-34 3 Currency Code: 840=U.S. Dollars + $content .= '840'; # 35-37 3 Country Code: 840=United States + $content .= $zip; # 38-46 9 (Merchant) City Code(Zip); + $content .= '00'; # 47-48 2 Language Indicator: 00=English + # ***FIXME*** + $content .= '705'; # 49-51 3 Time Zone Differential: 705=EST + $content .= $self->mcc; # 52-55 4 Metchant Category Code: 5999 + $content .= 'N'; # 56 1 Requested ACI (Authorization + # Characteristics Indicator): + # N=Device is not CPS capable + $content .= $seq; # 57-60 4 Tran Sequence Number + $content .= '56'; # 61-62 2 Auth Transaction Code: + # 56=Card Not Present + $content .= 'N'; # 63 1 Cardholder ID Code: N=AVS + # (Address Verification Data or + # CPS/Card Not Present or + # Electronic Commerce) + $content .= '@'; # 64 1 Account Data Source: + # @=No Cardreader + + die "content-length should be 64!" unless length($content) == 64; + + # - 5-76 Customer Data Field: Acct#ExpDate + $content .= $param->{card_number}. $FS. $exp. $FS; + + # - 1 Field Separator + $content .= $FS; + + # - 0-29 Address Verification Data +# $content .= substr($param->{address}, 0, 23)." ". substr($param->{zip}, 0, 5); + + $content .= $FS; # - 1 Field Separator + $content .= $FS; # - 1 Field Separator + + $content .= $amount; # - 1-12 Transaction Amount + + $content .= $FS; # - 1 Field Separator + $content .= $FS; # - 1 Field Separator + $content .= $FS; # - 1 Field Separator + + # - 25 Merchant Name + $content .= substr($self->merchant_name.(' 'x25),0,25); + + # - 13 Merchant City + $content .= substr($self->merchant_city.(' 'x13),0,13); + + # - 2 Merchant State + $content .= substr($self->merchant_state.('X'x2),0,2); + + $content .= $FS; # - 1 Field Separator + $content .= $FS; # - 1 Field Separator + $content .= $FS; # - 1 Field Separator + + #----- + + $content .= '014'; # - 3 Group III Version Number: + #014=MOTO/Electronic Commerce + + $content .= '7'; # - 1 MOTO/Electronic Com. Ind: 7= Non-Authenticated + # Security transaction, such as a channel-encrypted + # transaction (e.g., ssl, DES or RSA) + + + my $message = + $STX. + $content. + $ETX. + lrc($content.$ETX) + ; + + $message = setEvenParity $message; + + $message; +} + +sub eis1080_response { + my( $self, $response) = @_; + my %response; + + $response =~ /^$STX(.{67})([\w ]{0,15})$FS([\w ]{0,4})$FS.*$ETX(.)$/ + or die "can't decode (eis1080) response: $response\n". join(' ', map { sprintf("%x", unpack('C',$_)) } split('', $response) ); + ( $response{transaction_identifier}, + $response{validation_code}, + my $lrc + ) = ($2, $3, $4); + + warn "$response\n". + join(' ', map { sprintf("%x", unpack('C',$_)) } split('', $response) ). + "\n" + if $DEBUG; + + ( + $response{record_format}, + $response{application_type}, + $response{message_delimiter}, + $response{returned_ACI}, + $response{store_number}, + $response{terminal_number}, + $response{authorization_source_code}, + $response{transaction_sequence_num}, + $response{response_code}, + $response{approval_code}, + $response{local_transaction_date}, + $response{local_transaction_time}, + $response{auth_response_text}, + $response{AVS_result_code}, + $response{retrieval_reference_num}, + $response{market_specific_data_id}, + ) = unpack "AAAAA4A4A1A4A2A6A6A6A16A1A12A1", $1; + + if ( $response{record_format} ne "E" ) { + die "unknown response record_format $response{record_format}"; + } + if ( $response{application_type} ne "4" ) { + die "unknown response record_format $response{application_type}"; + } + if ( $response{message_delimiter} ne "." ) { + die "unknown response record_format $response{message_delimiter}"; + } + + $response{is_success} = $response{response_code} =~ /^(00|85)$/; + $response{result_code} = $response{response_code}; + $response{error_message} = $response{auth_response_text}; + $response{authorization} = $response{approval_code}; + #$response{returned_ACI} = $response{returned_ACI}; + #$response{authorization_source_code} = $response{authorization_source_code}; + #$response{transaction_sequence_num} = $response{transaction_sequence_num}; + + %response; +} + +sub eis1081_request { + my( $self, $param ) = @_; + + my $batchnum_file = $self->batchnum_file; + my $counter = File::CounterFile->new($batchnum_file, '001') + or die "can't create batchnumuence file $batchnum_file: $!"; + + $counter->lock(); + my $batchnum = substr('000'.$counter->inc, -3); + $batchnum = substr('000'.$counter->inc, -3) if $batchnum eq '000'; + $counter->unlock(); + + #K-Format Header Record (Base Group) +#Byte Length Frmt Field description Content Section + # Byte Length Field: Content (section) + my $header = 'K1.ZH@@@@'; # 1 1 A/N Record Format: K (4.154) + # 2 1 NUM Application Type: 1=Single Batch + # (4.10) + # 3 1 A/N Message Delimiter: . (4.123) + # 4 1 A/N X.25 Routing ID: Z (4.226) + # 5-9 5 A/N Record Type: H@@@@ (4.155) + $header .= $self->bin; # 10-15 6 NUM Acquirer BIN (4.2) + $header .= $self->agent; # 16-21 6 NUM Agent Bank Number (4.5) + $header .= $self->can('chain') ? $self->chain : '000000'; + # 22-27 6 NUM Agent Chain Number (4.6) + $header .= $self->merchant_id; + # 28-39 12 NUM Merchant Number (4.121) + $header .= $self->store; # 40-43 4 NUM Store Number (4.187) + $header .= $self->terminal; # 44-47 4 NUM Terminal Number 9911 (4.195) + $header .= 'C'; # 48 1 A/N Device Code: C="P.C." (4.62) + #$header .= 'M'; # 48 1 A/N Device Code M="Main Frame" (4.62) + $header .= $industry_code; # 49 1 A/N Industry Code (4.94) + $header .= '840'; # 50-52 3 NUM Currency Code (4.52) + $header .= '00'; # 53-54 2 NUM Language Indicator: 00=English + # (4.104) + # ***FIXME*** + $header .= '705'; # 55-57 3 NUM Time Zone Differential (4.200) + + my $mmdd = substr(time2str('0%m%d',time),-4); + $header .= $mmdd; # 58-61 4 NUM Batch Transmission Date MMDD (4.22) + + $header .= $batchnum; # 62-64 3 NUM Batch Number 001 - 999 (4.18) + $header .= '0'; # 65 1 NUM Blocking Indicator 0=Not Blocked + # (4.23) + + die "header length should be 65!" unless length($header) == 65; + + my $message = + $STX. + $header. + $ETB. + lrc($header.$ETB) + ; + + my $zip = substr( $self->zip. " ", 0, 9 ); + + #K-Format Parameter Record (Base Group) +#Byte Length Frmt Field Description Content Section + + my $parameter = 'K1.ZP@@@@'; # 1 1 A/N Record Format: K (4.154) + # 2 1 NUM Application Type: 1=Single Batch + # (4.10) + # 3 1 A/N Message Delimiter: . (4.123) + # 4 1 A/N X.25 Routing ID: Z (4.226) + # 5-9 5 A/N Record Type: P@@@@ (4.155) + $parameter .= '840'; # 10-12 3 NUM Country Code 840 4.47 + $parameter .= $zip; # 13-21 9 A/N City Code + # Left-Justified/Space-Filled 4.43 + $parameter .= $self->mcc; # 22-25 4 NUM Merchant Category Code (4.116) + + # 26-50 25 A/N Merchant Name Left-Justified/Space-Filled (4.27.1) + $parameter .= substr($self->merchant_name.(' 'x25),0,25); + + #51-63 13 A/N Merchant City Left-Justified/Space-Filled (4.27.2) + $parameter .= substr($self->merchant_city.(' 'x13),0,13); + + # 64-65 2 A/N Merchant State (4.27.3) + $parameter .= substr($self->merchant_state.('X'x2),0,2); + + $parameter .= '00001'; # 66-70 5 A/N Merchant Location Number 00001 4.120 + + $parameter .= $self->v; # 71-78 8 NUM Terminal ID Number 00000001 4.194 + + die "parameter length should be 78 (is ". length($parameter). ")!" + unless length($parameter) == 78; + + $message .= + $STX. + $parameter. + $ETB. + lrc($parameter.$ETB) + ; + +# K-Format Detail Record (Electronic Commerce) +#Byte Size Frmt Field Description Content Section +#D@@'D' ` + my $detail = 'K1.ZD@@`D'; # 1 1 A/N Record Format: K (4.154) + # 2 1 NUM Application Type 1=Single Batch + # (4.10) + # 3 1 A/N Message Delimiter: . (4.123) + # 4 1 A/N X.25 Routing ID: Z (4.226) + # 5-9 5 A/N Record Type: D@@`D (4.155) + + $detail .= '56'; # 10-11 2 A/N Transaction Code: + # 56 = Card Not Present + # (4.205) + $detail .= 'N'; # 12 1 A/N Cardholder Identification Code N 4.32 + # (Address Verification Data or + # CPS/Card Not Present or + # Electronic Commerce) + $detail .= '@'; # 13 1 A/N Account Data Source Code @ = No Cardreader 4.1 + # @=No Cardreader + + #14-35 22 A/N Cardholder Account Number Left-Justified/Space-Filled 4.30 + $detail .= substr( $param->{card_number}.' ', 0, 22 ); + + $detail .= 'N'; # 36 1 Requested ACI (Authorization + # Characteristics Indicator): + # N (4.163) + + # 37 1 A/N Returned ACI (4.168) + $detail .= $param->{returned_ACI} || 'N'; + + # *** 38 1 A/N Authorization Source Code (4.13) + $detail .= $param->{authorization_source_code} || '6'; + + # 39-42 4 NUM Transaction Sequence Number Right-Justified/Zero-Filled (4.207) + die "missing transaction_sequence_num" + unless $param->{transaction_sequence_num}; + $detail .= $param->{transaction_sequence_num}; + + $detail .= '00'; # ###FIXME (from auth)*** 43-44 2 A/N Response Code 4.164 + + # 45-50 6 A/N Authorization Code Left-Justified/Space-Filled (4.12) + $detail .= $param->{authorization}; + + my $time = time; + + my $mmdd = substr(time2str('0%m%d',$time),-4); + $detail .= $mmdd; # 51-54 4 NUM Local Transaction Date MMDD (4.113) + + my $hhmmss = time2str('%H%M%S',$time); + $detail .= $hhmmss; # 55-60 6 NUM Local Transaction Time HHMMSS (4.114) + + $detail .= '0'; #***FIXME (from auth) 61 1 A/N AVS Result Code 4.3 + + # 62-76 15 A/N Transaction Identifier Left-Justified/Space-Filled 4.206 + $detail .= substr($param->{transaction_identifier}. (' 'x15), 0, 15); + + # 77-80 4 A/N Validation Code 4.218 + $detail .= substr($param->{validation_code}.' ', 0, 4); + + $detail .= ' '; # 81 1 A/N Void Indicator = Not Voided 4.224 + $detail .= '00'; # 82-83 2 NUM Transaction Status Code 00 4.208 + $detail .= '0'; # 84 1 A/N Reimbursement Attribute 0 4.157 + + # ICKKKKKKKK do this better + my $amount = $param->{amount}; + $amount =~ s/\.//; + $amount = '000000000000'.$amount; + $amount =~ /^\d*(\d{12})$/; + $amount = $1; + + $detail .= $amount; # 85-96 12 NUM Settlement Amount Right-Justified/Zero-Filled 4.175 + + $detail .= $amount; # 97-108 12 NUM Authorized Amount Right-Justified/Zero-Filled 4.14 + + $detail .= $amount; # 109-120 12 NUM Total Authorized Amount Right-Justified/Zero-Filled 4.201 + +# $detail .= '1'; # 121 1 A/N Purchase Identifier Format Code 1 4.150 +# +# # 122-146 25 A/N Purchase Identifier Left-Justified/Space-Filled 4.149 +# $detail .= 'Internet Services '; +# #1234567890123456789012345 + + $detail .= '0'; # 121 1 A/N Purchase Identifier Format Code 1 4.150 + + # 122-146 25 A/N Purchase Identifier Left-Justified/Space-Filled 4.149 + $detail .= ' '; + #1234567890123456789012345 + + $detail .= '01'; # ??? 147-148 2 NUM Multiple Clearing Sequence Number 4.129 + $detail .= '01'; # ??? 149-150 2 NUM Multiple Clearing Sequence Count 1.128 + $detail .= '7'; # 151 1 A/N MOTO/Electronic Commerce Indicator 7 = Channel Encrypted 4.127 + + die "detail length should be 151 (is ". length($detail). ")" + unless length($detail) == 151; + + $message .= + $STX. + $detail. + $ETB. + lrc($detail.$ETB) + ; + +# K-Format Trailer Record +#Byte Length Frmt Field Description Content Section + + my $trailer = 'K1.ZT@@@@'; +#1 1 A/N Record Format K 4.154 +#2 1 NUM Application Type 1=Single 3=Multiple Batch 4.10 +#3 1 A/N Message Delimiter . 4.123 +#4 1 A/N X.25 Routing ID Z 4.226 +#5-9 5 A/N Record Type T@@@@ 4.155 + + $trailer .= $mmdd; # 10-13 4 NUM Batch Transmission Date MMDD 4.22 + $trailer .= $batchnum; # 14-16 3 NUM Batch Number 001 - 999 4.18 + $trailer .= '000000004'; # 17-25 9 NUM Batch Record Count + #Right-Justified/Zero-Filled 4.19 + $trailer .= '0000'.$amount; # 26-41 16 NUM Batch Hashing Total + #Purchases + Returns 4.16 + $trailer .= '0000000000000000'; # 42-57 16 NUM Cashback Total 4.38 + $trailer .= '0000'.$amount; # 58-73 16 NUM Batch Net Deposit + # Purchases - Returns 4.17 + + die "trailer length should be 73!" unless length($trailer) == 73; + + $message .= + $STX. + $trailer. + $ETX. + lrc($trailer.$ETX) + ; + + #### + + $message = setEvenParity $message; + + $message; + +} + +sub eis1081_response { + my( $self, $response ) = @_; + my %response; + + $response =~ /^$STX(.{41})(.*)$ETX(.)$/ + or die "can't decode (eis1081) response: $response"; + my $remainder = $2; + my $lrc = $3; + + ( + $response{record_format}, + $response{application_type}, + $response{message_delimiter}, + $response{x25_routing_id}, + $response{record_type}, + $response{batch_record_count}, + $response{batch_net_deposit}, + $response{batch_response_code}, + $response{filler}, + $response{batch_number}, + ) = unpack "AAAAA5A9A16A2A2A3", $1; + warn "$1\n" if $DEBUG; + + if ( $response{record_format} ne "K" ) { + die "unknown response record_format $response{record_format}"; + } + if ( $response{application_type} ne "1" ) { + die "unknown response record_format $response{application_type}"; + } + if ( $response{message_delimiter} ne "." ) { + die "unknown response record_format $response{message_delimiter}"; + } + + if ( $response{is_success} = $response{batch_response_code} eq 'GB' ) { + $response{result_code} = $response{batch_response_code}; + $response{error_message} = ''; + } elsif ( $response{batch_response_code} eq 'RB' ) { + $response{result_code} = $response{batch_response_code}; + #$remainder =~ /^(.)(.{4})(.)(..)(.{32})$/ + $remainder =~ /^(.)(.{4})(.)(..)(.*)$/ + or die "can't decode (eis1081) RB response (41+ ". length($remainder). + "): $remainder"; + my( $error_type, $error_record_sequence_number, $error_record_type, + $error_data_field_number, $error_data ) = ( $1, $2, $3, $4, $5 ); + my %error_type = ( + B => 'Blocked Terminal', + C => 'Card Type Error', + D => 'Device Error', + E => 'Error in Batch', + S => 'Sequence Error', + T => 'Transmission Error', + U => 'Unknown Error', + V => 'Routing Error', + ); + my %error_record_type = ( + H => 'Header Record', + P => 'Parameter Record', + D => 'Detail Record', + T => 'Trailer Record', + ); + $response{error_message} = 'Auth sucessful but capture rejected: '. + $error_type{$error_type}. ' in '. $error_record_type{$error_record_type}. + ' #'. $error_record_sequence_number. ' field #'. $error_data_field_number. + ': '. $error_data; + } else { + $response{result_code} = $response{batch_response_code}; + $response{error_message} = $remainder; + } + + %response; +} + +1; + +__END__ + +=head1 NAME + +Business::OnlinePayment::VirtualNet - Vital VirtualNet backend for Business::OnlinePayment + +=head1 SYNOPSIS + + use Business::OnlinePayment; + + my $tx = new Business::OnlinePayment("VirtualNet", + 'merchant_id' => '999999999911', + 'store' => '0011', + 'terminal' => '9911', + 'mcc' => '5999', #merchant category code + 'bin' => '999995', #acquirer BIN (Bank Identification Number) + 'zip' => '543211420', #merchant zip (US) or assigned city code + + 'agent' => '000000', #agent bank + 'v' => '00000001', + + 'merchant_name' => 'Internet Service Provider', #25 char max + 'merchant_city' => 'Gloucester', #13 char max + 'merchant_state' => 'VA', #2 char + + 'seq_file' => '/tmp/bop-virtualnet-sequence', + 'batchnum_file' => '/tmp/bop-virtualnet-batchnum', # :/ 0-999 in 5 days + + ); + $tx->content( + type => 'CC', + login => 'test', + action => 'Authorization Only', + description => 'Business::OnlinePayment test', + amount => '49.95', + invoice_number => '100100', + name => 'Tofu Beast', + card_number => '4007000000027', + expiration => '09/02', + ); + $tx->submit(); + + if( $tx->is_success() ) { + print "Card processed successfully: ".$tx->authorization."\n"; + } else { + print "Card was rejected: ".$tx->error_message."\n"; + } + + if( $tx->is_success() ) { + + $auth = $tx->authorization; + $ordernum = $tx->order_number; + + my $capture = new Business::OnlinePayment("VirtualNet", + 'agent' => '000001', + 'chain' => '000000', #optional? + 'v' => '00000001', + + 'merchant_id' => '999999999911', + 'store' => '0011', + 'terminal' => '9911', + 'mcc' => '5999', #merchant category code + 'bin' => '999995', #acquirer BIN (Bank Identification Number) + ); + + $capture->content( + action => 'Post Authorization', + # order_number => $ordernum, + # amount => '0.01', + # authorization => $auth, + # description => 'Business::OnlinePayment::BankOfAmerica visa test', + ); + + $capture->submit(); + + if( $capture->is_success() ) { + print "Card captured successfully: ".$capture->authorization."\n"; + } else { + print "Card was rejected: ".$capture->error_message."\n"; + } + + } + +=head1 DESCRIPTION + +For detailed information see L. + +=head1 NOTE + +=head1 COMPATIBILITY + +This module implements the interface documented at +http://www.vitalps.com/sections/int/int_Interfacespecs.html + +Specifically, start with +http://www.vitalps.com/pdfs_specs/VirtualNet%020Specification%0200011.pdf +and then http://www.vitalps.com/pdfs_specs/EIS%0201080%020v6_4_1.pdf and +http://www.vitalps.com/pdfs_specs/EIS_1081_v_6_4.pdf and maybe even +http://www.vitalps.com/pdfs_specs/EIS%0201051.pdf and +http://www.vitalps.com/pdfs_specs/EIS%0201052.pdf + +=head1 AUTHOR + +Ivan Kohler + +=head1 SEE ALSO + +perl(1). L. + +=cut + diff --git a/t/bad_auth.t b/t/bad_auth.t new file mode 100644 index 0000000..aa10d3c --- /dev/null +++ b/t/bad_auth.t @@ -0,0 +1,59 @@ +BEGIN { $| = 1; print "1..1\n"; } + +use Business::OnlinePayment; + +$DEBUG = 0; +$Business::OnlinePayment::VirtualNet::DEBUG = $DEBUG; + +# Use this merchant information for testing only. +# +# Bin= 999995 Agent = 000000 Chain = 111111 Merchant = 888000002200 +# Store = 5999 Terminal = 1515 +# Mcc = 5999 . +# If you are doing AVS (address Ver ) use this address 8320 zip 85284. + +my $tx = new Business::OnlinePayment("VirtualNet",, + 'merchant_id' => '888000002200', + 'store' => '5999', + 'terminal' => '1515', + 'mcc' => '5999', #merchant category code + 'bin' => '999995', #acquirer BIN + 'zip' => '543211420', #merchant zip (US) or assigned city code + + 'agent' => '000000', + 'v' => '00000001', + + 'merchant_name' => 'Internet Service Provider', #25 char max + 'merchant_city' => 'Gloucester', #13 char max + 'merchant_state' => 'VA', #2 char + + 'seq_file' => '/tmp/bop-virtualnet-sequence', + 'batchnum_file' => '/tmp/bop-virtualnet-batchnum', # :/ 0-999 in 5 days +); +$tx->content( + type => 'CC', + action => 'Authorization only', + description => 'Business::OnlinePayment visa test', + amount => '999910.00', + invoice_number => '100100', + customer_id => 'jsk', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + card_number => '4111111111111111', + expiration => '09/03', +); +$tx->test_transaction(1); # test, dont really charge (doesn't do anything with VirtualNet) +$tx->submit(); + +if($tx->is_success()) { + print "not ok 1\n"; + warn '** ('. $tx->result_code. ') '. $tx->error_message. " **\n" if $DEBUG; + warn $tx->error_message if $DEBUG; +} else { + warn '** ('. $tx->result_code. ') '. $tx->error_message. " **\n" if $DEBUG; + print "ok 1\n"; +} diff --git a/t/bop.t b/t/bop.t new file mode 100644 index 0000000..64332c5 --- /dev/null +++ b/t/bop.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Business::OnlinePayment; +$loaded = 1; +print "ok 1\n"; diff --git a/t/credit_card.t b/t/credit_card.t new file mode 100644 index 0000000..8e2777a --- /dev/null +++ b/t/credit_card.t @@ -0,0 +1,89 @@ +BEGIN { $| = 1; print "1..2\n"; } + +use Business::OnlinePayment; + +$DEBUG = 0; +$Business::OnlinePayment::VirtualNet::DEBUG = $DEBUG; + +# Use this merchant information for testing only. +# +# Bin= 999995 Agent = 000000 Chain = 111111 Merchant = 888000002200 +# Store = 5999 Terminal = 1515 +# Mcc = 5999 . +# If you are doing AVS (address Ver ) use this address 8320 zip 85284. + +my $tx = new Business::OnlinePayment("VirtualNet", + 'merchant_id' => '888000002200', + 'store' => '5999', + 'terminal' => '1515', + 'mcc' => '5999', #merchant category code + 'bin' => '999995', #acquirer BIN + 'zip' => '543211420', #merchant zip (US) or assigned city code + + 'agent' => '000000', #agent bank + 'v' => '00000001', + + 'merchant_name' => 'Internet Service Provider', #25 char max + 'merchant_city' => 'Gloucester', #13 char max + 'merchant_state' => 'VA', #2 char + + 'seq_file' => '/tmp/bop-virtualnet-sequence', + 'batchnum_file' => '/tmp/bop-virtualnet-batchnum', # :/ 0-999 in 5 days +); + +$tx->content( + type => 'CC', + action => 'Authorization only', + description => 'Business::OnlinePayment visa test', + amount => '10.00', + invoice_number => '100100', + customer_id => 'jsk', + name => 'Tofu Beast', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + card_number => '4111111111111111', + expiration => '09/03', +); +$tx->test_transaction(1); # test, dont really charge (doesn't do anything with VirtualNet) +$tx->submit(); + +if($tx->is_success()) { + print "ok 1 (". $tx->authorization. ")\n"; + warn "(auth ok ". $tx->authorization. ")\n" if $DEBUG; +} else { + warn "(auth) ** (". $tx->result_code. ') '. $tx->error_message. "**\n" + if $DEBUG; + print "not ok 1\n"; + exit; +} + +$tx->content( + type => 'CC', + action => 'Post Authorization', + #order_number => $ordernum, + amount => '10.00', + card_number => '4111111111111111', + expiration => '09/03', + authorization => $tx->authorization, + authorization_source_code => $tx->authorization_source_code, + returned_ACI => $tx->returned_ACI, + transaction_identifier => $tx->transaction_identifier, + validation_code => $tx->validation_code, + transaction_sequence_num => $tx->transaction_sequence_num, + #description => 'Business::OnlinePayment::BankOfAmerica visa test', +); + +$tx->submit(); + +if($tx->is_success()) { + print "ok 2\n"; +} else { + warn '(capture) ** ('.$tx->result_code.') '. $tx->error_message. " **\n" + if $DEBUG; + print "not ok 2\n"; +} + diff --git a/t/load.t b/t/load.t new file mode 100644 index 0000000..c90bb23 --- /dev/null +++ b/t/load.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Business::OnlinePayment::VirtualNet; +$loaded = 1; +print "ok 1\n"; diff --git a/t/testhost.t b/t/testhost.t new file mode 100644 index 0000000..72c3a3c --- /dev/null +++ b/t/testhost.t @@ -0,0 +1,14 @@ +BEGIN { $| = 1; print "1..1\n"; } + +use Business::OnlinePayment; + +my $tx = new Business::OnlinePayment("VirtualNet"); + +$tx->testhost; + +if($tx->is_success()) { + print "ok 1\n"; +} else { + warn "*******". $tx->error_message. "*******"; + print "not ok 1\n"; +} -- 2.11.0