Business-OnlinePayment-VirtualNet

 view release on metacpan or  search on metacpan

VirtualNet.pm  view on Meta::CPAN

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

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 .= '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)
  $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)

VirtualNet.pm  view on Meta::CPAN

  $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',



( run in 1.757 second using v1.01-cache-2.11-cpan-39bf76dae61 )