package Business::OnlinePayment::VirtualNet3;
# Vital certification (search for certification)
# - 0-29 Address Verification Data
# keep from downgrading when you use a street number w/ zip
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 Business::OnlinePayment);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = '0.02';

$DEBUG ||= 0;

use vars qw( $STX $ETX $FS $GS $ETB );
$STX = pack("C", 0x02 );
$ETX = pack("C", 0x03 );
$FS = pack("C", 0x1c );
$GS = pack("C", 0x1d );
$ETB = pack("C", 0x17 );
#$EOT = pack("C", 0x04 );

my $industry_code = 'D';	# Direct Marketing
#my $industry_code = 'F';	# Restaurant
#my $industry_code = 'R';	# Retail

sub set_defaults {
    my $self = shift;
#	$self->server('ssl2.vitalps.net'); 	# Production
#	$self->port('5003'); 				# Production
#	$self->server('ssltest.tnsi.com'); 	# Development Testing
#	$self->port('5004'); 				# Development Testing
#	$self->server('ssltestn.tnsi.com');	# Official Certification
#	$self->port('5004'); 				# Official Certification
	$self->path('');
#	$self->server('ssl2.vitalps.net'); # product Amex re-route
    $self->path('/transaction.vital');
	# Certification/Production
	$self->server('ssl.pgs.wcom.net'); # Production URL 1.0 SSL
#	$self->server('ssl1.vitalps.net'); # BACKUP Production URL 1.0 SSL
    $self->port('443');
    $self->path('/scripts/gateway.dll?transact');
	#$self->server('ssltest.tnsi.com'); # Testing URL 1.0 SSL
    #$self->port('443');
    
    $self->build_subs(qw( authorization_source_code returned_ACI
                          transaction_sequence_num transaction_identifier
                          validation_code local_transaction_date
                          local_transaction_time AVS_result_code reference));
}

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'});

    #? 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' ) {
      $message = $self->eis1081_request( \%content );
      $mimetype = 'x-Visa-II/x-settle';
    }

    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 "VirtualNet protocol error: $page";
    }

    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

    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' ) {
      %response = $self->eis1081_response( $page );
    }

    for my $field ( qw( is_success result_code error_message authorization
                        authorization_source_code returned_ACI
                        transaction_identifier validation_code
                        transaction_sequence_num local_transaction_date
                        local_transaction_time AVS_result_code reference) ) {
      $self->$field($response{$field});
    }

}

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 "VirtualNet protocol error: $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) 

  $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 $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:
                				#			0=single, 2=multi,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 .= 'Q';                # 30    1    Device Code:
                                  #          Q="Third party software developer"
  #$content .= 'C';                # 30    1    Device Code: C="P.C."
  #$content .= 'M';                # 30    1    Device Code: M="Main Frame"
   if ($self->group3_version_num eq 'R') { $industry_code = 'R'; }
  $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
  $content .= $self->timezone;              # 49-51 3    Time Zone Differential:
  									#			705=EST,706=CST,707=MST,708=PST
  $content .= $self->mcc;         # 52-55 4    Merchant Category Code: 5999
  $content .= 'Y';                # 56    1    Requested ACI (Authorization
                                  #            Characteristics Indicator):
                                  #            Y=Device is CPS capable
  $content .= $seq;               # 57-60 4    Tran Sequence Number
  						# (direct mktg)
  if ($self->group3_version_num ne 'R')
  {  $content .= '56';               # 61-62 2    Auth Transaction Code:
  }
  else { $content .= '54';	}
                                  #            56=Card Not Present 
                                  #				54=Purchase
  if ($self->group3_version_num ne 'R')
  {  $content .= 'N';                # 63    1    Cardholder ID Code: N=AVS
  	
  }
  else {	if ($self->swipe_data ne '')
  			{	$content .= '@';	}
  			else { $content .= 'M';	}
  		}	  # 	M - w/ address for retail if manual (no swipe)
                                  #            (Address Verification Data or
                                  #            CPS/Card Not Present or
                                  #            Electronic Commerce)
                                  #				@ for signature (retail)
  if (($self->group3_version_num eq 'R')&&($self->swipe_data ne ''))
  { $content .= 'H'; }
  else { $content .= 'X'; }       # 64    1    Account Data Source:
                                  #            @=No Cardreader
                                  # 'H' track1
                                  # 'D' track2
  die "content-length should be 64!".length($content) unless length($content) == 64;

  # - 5-76 Customer Data Field: Acct#<FS>ExpDate<FS>
  if (($self->group3_version_num eq 'R')&&($self->swipe_data ne ''))
  # add swipe data
  	{	# % front
  		# line ?
  		# line end
  		my $swipe_track = $self->swipe_data;
  		$swipe_track =~ s/^%//;
  		$swipe_track =~ s/\r//g;
  		$swipe_track =~ s/\?.*$//g;
  		$content .= uc($swipe_track);
  	}
 else { 
  $content .= $param->{card_number}. $FS. $exp. $FS;
	}
  # - 1 Field Separator
  $content .= $FS;
if (($self->group3_version_num eq 'R')&&($self->swipe_data eq '')) # leave out address for swipe
{
  # - 0-29 Address Verification Data
#$content .= substr($self->{cust_city}, 0, 4)." ". substr($self->{cust_zip}, 0, 5);
#$content .= '8320 85284'; # hard-coded street address for Vital Certification
#$content .= '85284';
# comment line above and uncomment line below to go to production
$content .= substr($self->{cust_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

  #-----
### RETAIL - begin area not needed 
# retail swipe, just base
# retail manual address, cvv
# group 14 
if (($self->group3_version_num ne 'R')&&($self->swipe_data eq ''))
{
  $content .= '014'; # - 3 Group III Version Number:
                     #014=MOTO/Electronic Commerce
	
  $content .= $self->group3_version_num;
  # - 1 MOTO/Electronic Com. Ind: 7= Non-Authenticated
                   # Security transaction, such as a channel-encrypted
                   # transaction (e.g., ssl, DES or RSA)
          # only different DM / E-comm
  $content .= $GS; # Group Separator
  $content .= '007'; # - 3 Group III Version Number:group 3 v 7 (CVV2)
 
  if ($param->{card_number} =~ m/^3\d\d\d\d\d\d\d\d\d\d\d\d\d\d/)
   { $content .= '11'.$param->{cvv}; } # amex cvv
  	else { $content .= '11 '.$param->{cvv}; }
$content .= $GS; # Group Separator
}
## RETAIL - end area not needed
# unless manually entered Retail
else { 
	if ($self->swipe_data eq '')
	{	$content .= '007'; # - 3 Group III Version Number:group 3 v 7 (CVV2)
  if ($param->{card_number} =~ m/^3\d\d\d\d\d\d\d\d\d\d\d\d\d\d/)
   { $content .= '11'.$param->{cvv}; } # amex cvv
  	else { $content .= '11 '.$param->{cvv}; }
$content .= $GS; # Group Separator
		}
	}
## Developer and Version always required

  $content .= '020'; # - 3 Group III Version Number:
                     #014=MOTO/Electronic Commerce
  $content .= '001131B002'; # developer id/version
  $content .= $FS; # - 1 Field Separator
  $content .= $FS; # - 1 Field Separator
  
  my $message = 
    $STX.
    $content.
    $ETX.
    lrc($content.$ETX)
  ;

  $message = setEvenParity $message;

  $message;
}

sub eis1080_response {
  my( $self, $response) = @_;
  my %response;
$response =~ /^$STX(.{41})(.*)$ETX(.)$/;
  my $remainder = $2;
  $remainder =~ /(.*) +(.*)$/;
  $remainder = $1;
  #$response =~ /^$STX(.{67})([\w ]{0,15})$FS([\w ]{0,4})$FS.*$ETX(.)$/
  $response =~ /^$STX(.{67})([\w ]{0,15})$FS([\w ]{0,4})$FS(\d{3}).*$ETX(.)$/
    or die "\nAuthorization response: $remainder\n". join(' ', map { sprintf("%x", unpack('C',$_)) } split('', $response) );
  ( $response{transaction_identifier},
    $response{validation_code},
    my $group3version,
    my $lrc
  ) = ($2, $3, $4, $5);

#  die "group iii version $group3version ne 014"
#    unless $group3version eq '014';

  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{reference} =  $response{approval_code};
  %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->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 .= 'Q';             # 48    1  A/N Device Code:
                              #       Q="Third party software developer" (4.62)
  #$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)
     if ($self->group3_version_num eq 'R') { $industry_code = 'R'; }
  $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 .= $self->timezone;           # 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;
# daily batches have variable length
  my $message = 
    $STX.
    $header.
    $ETB.
    lrc($header.$ETB)
  ;
#'19123'
  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
     # prob                          #    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; #'00000001';  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)
  ;

my $batch_hash_total = 0;
my $batch_net_deposit = 0;
my $batch_records;
my $loc_id = $self->location_id;
{	$batch_records = $self->batchrecs;
}

my @master_keys = keys(%$batch_records);
my $detail = '';

my $batch_item_count = 3;
foreach my $master_key (@master_keys)
{	# K-Format Detail Record (Electronic Commerce)
#Byte Size Frmt Field Description Content Section
#D@@'D'  `
#location_id, r, group3_version_num, action, amount, invoice_number, name, card_number, expiration, cvv, swipe_data, cust_zip, authorization, authorization_source_code, returned_ACI, transaction_identifier, validation_code, transaction_sequence_num, local_transaction_date, local_transaction_time, AVS_result_code, reference
my $transaction_code = '56';
my $batch_rec_array = $batch_records->{"$master_key"};
my $location_id = $batch_rec_array->[0];
my $r = $batch_rec_array->[1];
my $group3_version_num = $batch_rec_array->[2];
my $action = $batch_rec_array->[3];
my $amount_orig = $batch_rec_array->[4];
my $invoice_number = $batch_rec_array->[5];
my $name = $batch_rec_array->[6];
my $card_number = $batch_rec_array->[7];
my $expiration = $batch_rec_array->[8];
my $cvv = $batch_rec_array->[9];
my $swipe_data = $batch_rec_array->[10];
my $cust_zip = $batch_rec_array->[11];
my $authorization = $batch_rec_array->[12];
my $authorization_source_code = $batch_rec_array->[13];
my $returned_ACI = $batch_rec_array->[14];
my $transaction_identifier = $batch_rec_array->[15];
my $validation_code = $batch_rec_array->[16];
my $transaction_sequence_num = $batch_rec_array->[17];
my $local_transaction_date = $batch_rec_array->[18];
my $local_transaction_time = $batch_rec_array->[19];
my $AVS_result_code = $batch_rec_array->[20];
my $reference = $batch_rec_array->[21];
if ($group3_version_num eq 'R') # group3_version_num
		{ $transaction_code = '54'; }
if ($action eq 'Credit') # action
		{	$transaction_code = 'CR';
			$returned_ACI = ' ';
			$transaction_identifier = '000000000000000';
			$invoice_number = '000000000000000';
			$validation_code = '';
		}

  if (($transaction_code eq 'CR')||($group3_version_num eq 'R'))
  	{	$detail = 'K1.ZD@@@@'; # credits/retail only base group
  	}
  else 
  {   $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 .= $transaction_code; # 'CR','56','54'
  # 10-11 2 A/N Transaction Code:
                                 #             56 = Card Not Present
  if (($transaction_code eq 'CR')||($group3_version_num eq 'R'))
  {	if (($swipe_data ne '')||($transaction_code eq 'CR'))
  			{	$detail .= '@';	}
  			else { $detail .= 'M';	}
  }	#             (4.205)
  # M for bad mag stripe read
  else { $detail .= 'N'; }# 12 1 A/N Cardholder Identification Code N 4.32
                                 #            (Address Verification Data or
                                 #            CPS/Card Not Present or
                                 #            Electronic Commerce)
  if (($group3_version_num eq 'R')&&($swipe_data ne ''))
  	{ $detail .= 'H';
  	my $swipe_track = $swipe_data;
  		$swipe_track =~ s/^%//;
  		$swipe_track =~ s/\r//g;
  		$swipe_track =~ s/\?.*$//g;
  		$swipe_track =~ s/ +//g;
  		if (uc($swipe_track) =~ m/^[A-Z](\d+)\^/)
  			{	$card_number = $1;	}
  	}	# H track 1 data D track2 data
  	else {  $detail .= 'X'; } # X manual key  
  # H swipe
  		# 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( $card_number.'                        ', 0, 22 );
  $detail .= 'Y';                # 36    1    Requested ACI (Authorization
                                 #            Characteristics Indicator):
                                 #            N (4.163)
  # 37 1 A/N Returned ACI (4.168)
  $detail .= $returned_ACI || ' ';

  # *** 38 1 A/N Authorization Source Code (4.13)
if ($transaction_code eq 'CR') { $detail .= '9'; }
else { $detail .= $authorization_source_code || '6'; }

  # 39-42 4 NUM Transaction Sequence Number Right-Justified/Zero-Filled (4.207)
  if ($transaction_code eq 'CR') {
  	  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();
  $detail .= $seq;
  }
  else {	die "missing transaction_sequence_num"
    unless $transaction_sequence_num;
  $detail .= $transaction_sequence_num;
  }
  if ($transaction_code eq 'CR')
  { $detail .= '  '; }
  else
  { $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)
  if ($transaction_code eq 'CR') { $detail .= '      '; }
  else { $detail .= $authorization; }

  # 51-54 4 NUM Local Transaction Date MMDD (4.113)
  if ($transaction_code eq 'CR') { my $thisVal = $mmdd;
  	chomp($thisVal);
  	$detail .= $thisVal;
  }
  else {  die "missing local_transaction_date"
    unless $local_transaction_date;
  $detail .= substr($local_transaction_date, 0, 4);
	}
  # 55-60 6 NUM Local Transaction Time HHMMSS (4.114)
  if ($transaction_code eq 'CR') { my $thisVal = `date "+%H%M%S"`;
  	chomp($thisVal);
  	$detail .= $thisVal;
  }
  else {  die "missing local_transaction_time"
    unless $local_transaction_time;
  #die "length of local_transaction_time ". $param->{local_transaction_time}.
  #    " != 6"
  #  unless length($param->{local_transaction_time}) == 6;
  $detail .= $local_transaction_time;
  	}
  #(from auth) 61 1 A/N AVS Result Code 4.3
  if ($transaction_code eq 'CR') { $detail .= '0'; }
  else { if ($AVS_result_code eq '') { $AVS_result_code = '0'; }
  $detail .= $AVS_result_code;
	}
  # 62-76 15 A/N Transaction Identifier Left-Justified/Space-Filled 4.206
  $transaction_identifier =
    length($transaction_identifier)
      ? substr($transaction_identifier. (' 'x15), 0, 15)
      : '000000000000000';
  $detail .= $transaction_identifier;

  # 77-80 4 A/N Validation Code 4.218
  $detail .= substr($validation_code.'    ', 0, 4);
  
  $detail .= ' '; # 81 1 A/N Void Indicator <SPACE> = 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

  my $amount = $amount_orig;
  my $amount_hash = $amount_orig;
  my $amount_net = $amount_orig;
  $batch_hash_total += $amount_hash*1;
  if ($transaction_code eq 'CR') { $amount_net = (-1)*$amount_net; }
  $batch_net_deposit += $amount_net*1;
  
  $amount =~ s/\.//;
  $amount = substr('000000000000'.$amount,-12);

  $detail .= $amount; # 85-96 12 NUM Settlement Amount
                      # Right-Justified/Zero-Filled 4.175
if ($transaction_code eq 'CR')
{	$detail .= '000000000000';	}
else { $detail .= $amount; # 97-108 12 NUM Authorized Amount
		# Right-Justified/Zero-Filled 4.14
}
# - end of base group
# credit

#if ($self->group3_version_num eq 'R')
#{	$detail .= '000000000000';	} # 109-120 12 NUM Gratuity Amount
		# Right-Justified/Zero-Filled 4.94 (restaurant only)

if (($transaction_code ne 'CR')&&($group3_version_num ne 'R'))
{
  $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
				# 1 FOR RETAIL/ECOMMERCE
  # 122-146 25 A/N Purchase Identifier Left-Justified/Space-Filled 4.149
  # amex use first 9, space fill to 25
  # Purchase_Identifier
  $detail .= substr( $invoice_number.'                         ', 0, 25 );
             #1234567890123456789012345
$detail .= '00'; # ??? 147-148 2 NUM Multiple Clearing Sequence Number 4.129
$detail .= '00'; # ???  149-150 2 NUM Multiple Clearing Sequence Count 1.128
  $detail .= $group3_version_num;
  # 151 1 A/N MOTO/Electronic Commerce Indicator 7 = Channel Encrypted 4.127
	# 1 for Direct Marketing
  die "detail length should be 151 (is ". length($detail). ")"
    unless length($detail) == 151;
}
  $message .= 
    $STX.
    $detail.
    $ETB.
    lrc($detail.$ETB)
  ;
  $batch_item_count++;
}



$batch_hash_total = $batch_hash_total*100;
 $batch_hash_total =~ s/\.//;
 $batch_hash_total = substr('000000000000'.$batch_hash_total,-12);
$batch_net_deposit = $batch_net_deposit*100;
 $batch_net_deposit =~ s/\.//;
 $batch_net_deposit = substr('000000000000'.$batch_net_deposit,-12);

# 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
  $batch_item_count = substr('000000000'.$batch_item_count,-9);
  $trailer .= $batch_item_count;        # 17-25  9 NUM Batch Record Count
                                  #Right-Justified/Zero-Filled    4.19
  $trailer .= '0000'.$batch_hash_total;    
  					# 26-41 16 NUM Batch Hashing Total
                    #Purchases + Returns    4.16
  $trailer .= '0000000000000000'; # 42-57 16 NUM Cashback Total 4.38
  $trailer .= '0000'.$batch_net_deposit;    
  					# 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',
      P => 'Vital Residency Requirement Error',
      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 successful 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    => '4111111111111111',
      expiration     => '09/03',
  );
  $tx->submit();

  if( $tx->is_success() ) {
      print "Card authorized successfully: ".$tx->authorization."\n";
  } else {
      print "Error: ".$tx->error_message."\n";
  }

 if( $tx->is_success() ) {

      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(
        type           => 'CC',
        action         => 'Post Authorization',
        amount         => '49.95',
        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,
        local_transaction_date    => $tx->local_transaction_date,
        local_transaction_time    => $tx->local_transaction_time,
        AVS_result_code           => $tx->AVS_result_code,
        #description    => 'Business::OnlinePayment::VirtualNet test',

          action         => 'Post Authorization',
      #    order_number   => $ordernum,
      #    amount         => '0.01',
      #    authorization  => $auth,
      #    description    => 'Business::OnlinePayment::VirtualNet test',
      );

      $capture->submit();

      if( $capture->is_success() ) { 
          print "Card captured successfully\n";
      } else {
          print "Error: ".$capture->error_message."\n";
      }

  }

=head1 DESCRIPTION

For detailed information see L<Business::OnlinePayment>.

=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 <ivan-virtualnet@420.am>

=head1 SEE ALSO

perl(1). L<Business::OnlinePayment>.

=cut