package SAP::Rfc;

use strict;

use vars qw($VERSION);
$VERSION = '0.95';

use SAP::Iface;

use constant RFCIMPORT     => 0;
use constant RFCEXPORT     => 1;
use constant RFCTABLE      => 2;

use constant RFCTYPE_CHAR  => 0;
use constant RFCTYPE_DATE  => 1;
use constant RFCTYPE_BCD   => 2;
use constant RFCTYPE_TIME  => 3;
use constant RFCTYPE_BYTE  => 4;
use constant RFCTYPE_NUM   => 6;
use constant RFCTYPE_FLOAT => 7;
use constant RFCTYPE_INT   => 8;
use constant RFCTYPE_INT2  => 9;

## Ensure that the temp directory exists before Inline is invoked
#BEGIN { `mkdir -p /tmp/_Inline/saprfc` if ! -d '/tmp/_Inline/saprfc'; };

# Config for C compiler - the directories may need 
#   altering - these directories follow the typical 
#   installation path of the SAP RFCSDK under Linux
use Inline ( C=> Config =>
#                DIRECTORY => '/tmp/_Inline/saprfc',
                INC => '-I/usr/sap/rfcsdk/include',
#                LIBS => '-lm -ldl -lpthread -L/usr/sap/rfcsdk/lib -lrfc' );
                LIBS => '-lm -ldl -lpthread -L/usr/sap/rfcsdk/lib -lrfccm' );
#  This change will point to the new SAP threaded RFC library librfccm.so
#    Either should do, but librfccm is probably better on other UNIXs

# Config for Inline::MakeMaker
use Inline C=> 'DATA',
                NAME => 'SAP::Rfc',
                VERSION => '0.95';


# Globals
my $loginfile = './testconn';

# sysinfo structure size
my @SYSINFO = (
    { NAME => 'RFCPROTO',   LEN  => 3 },
    { NAME => 'RFCCHARTYP', LEN  => 4 },
    { NAME => 'RFCINTTYP',  LEN  => 3 },
    { NAME => 'RFCFLOTYP',  LEN  => 3 },
    { NAME => 'RFCDEST',    LEN  => 32 },
    { NAME => 'RFCHOST',    LEN  => 8 },
    { NAME => 'RFCSYSID',   LEN  => 8 },
    { NAME => 'RFCDATABS',  LEN  => 8 },
    { NAME => 'RFCDBHOST',  LEN  => 32 },
    { NAME => 'RFCDBSYS',   LEN  => 10 },
    { NAME => 'RFCSAPRL',   LEN  => 4 },
    { NAME => 'RFCMACH',    LEN  => 5 },
    { NAME => 'RFCOPSYS',   LEN  => 10 },
    { NAME => 'RFCTZONE',   LEN  => 6 },
    { NAME => 'RFCDAYST',   LEN  => 1 },
    { NAME => 'RFCIPADDR',  LEN  => 15 },
    { NAME => 'RFCKERNRL',  LEN  => 4 },
    { NAME => 'RFCHOST2',   LEN  => 32 },
    { NAME => 'RFCSI_RESV', LEN  => 12 }
);

 
#  valid login parameters
my $VALID =  {
    CLIENT => 1,
    PASSWD => 1,
    LANG => 1,
    LCHECK => 1,
    USER => 1,
    ASHOST => 1,
    GWHOST => 1,
    GWSERV => 1,
    MSHOST => 1,
    GROUP => 1,
    R3NAME => 1,
    DEST => 1,
    SYSNR => 1,
    TPNAME => 1,
    TPHOST => 1,
    TRACE => 1,
    ABAP_DEBUG => 1,
    USE_SAPGUI => 1,
    TYPE => 1
  };


# Global debug flag
my $DEBUG = undef;



# Tidy up open Connection when DESTROY Destructor Called
sub DESTROY {
    my $self = shift;
    MyDisconnect( $self->{'handle'} )
          if exists $self->{'handle'};
}


# Construct a new SAP::Rfc Object.
sub new {

    my @keys = ();
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my @rest = @_;
    if ( scalar @rest == 1 ){
	$loginfile = $rest[0] if $rest[0];
	if (-f $loginfile){
	    open (FIL,"<$loginfile")
		or die "$! : could not open login file $loginfile";
	    my @file = <FIL>;
	    close FIL;
	    map { push @keys, split "\t",$_ } @file;
	    chomp @keys;
	}
    };
    
    my $self = {
	INTERFACES => {},
	CLIENT => "000",
	USER   => "SAPCPIC",
	PASSWD => "ADMIN",
	LANG   => "EN",
	LCHECK   => "0",
	@keys,
	@rest
	};


# validate the login parameters
    map { delete $self->{$_} unless exists $VALID->{$_} } keys %{$self};

# create the connection string and login to SAP
    my $conn = MyConnect( login_string( $self ) );

    die "Unable to connect to SAP" unless $conn =~ /^\d+$/;
    $self->{HANDLE} = $conn;

# create the object and return it
    bless ($self, $class);
    return $self;
}


# return a formated connection string for login
sub login_string {

  my $self = shift;
  my $connect = undef;
  $self->{USER} = uc( $self->{USER} );
  $self->{PASSWD} = uc( $self->{PASSWD} );

# create the login string but only return valid parameters
  map { $connect.= $_ . "=" . $self->{$_} . " " } keys %{$self};

  return $connect;
}



# method to return the current date in ABAP DATE format
sub sapdate{

  my @date = localtime;
  return pack("A4 A2 A2", ($date[5] + 1900,
      sprintf("%02d",$date[4] + 1), sprintf("%02d",$date[3])));

}


# method to return the current time in ABAP TIME format
sub saptime{

  my @date = localtime;
  return pack("A2 A2 A2", (sprintf("%02d",$date[2]),
                           sprintf("%02d",$date[1]),
			   sprintf("%02d",$date[0])));

}


# method to access aggregate functions SAP::Interface
sub iface{

  my $self = shift;
  die "No Interface supplied to RFC " if ! @_;
  my $iface = shift;
  return $self->{INTERFACES}->{$iface};

}


# method to find the structure of an interface
sub discover{
  my $self = shift;
  die "No Interface supplied to RFC " if ! @_;
  my $iface = shift;
  die "RFC is NOT connected for interface discovery!"
     if ! is_connected( $self );
  my $info = $self->sapinfo();

  my $if = {
      'FUNCNAME' => { 'TYPE' => RFCEXPORT,
		      'VALUE' => $iface,
		      'INTYPE' => RFCTYPE_CHAR,
		      'LEN' => length($iface) }, 
      'PARAMS_P'    => { 'TYPE' => RFCTABLE,
			 'VALUE' => [],
			 'INTYPE' => RFCTYPE_BYTE,
			 'LEN' => 215 } 
  }; 

  my $ifc = MyRfcCallReceive( $self->{HANDLE},
			      "RFC_GET_FUNCTION_INTERFACE_P",
			      $if );
  
  return  undef if $ifc->{'__RETURN_CODE__'} != 0;

  my $interface = new SAP::Iface(NAME => $iface);
  for my $row ( @{ $ifc->{'PARAMS_P'} } ){
      my ($type, $name, $tabname, $field, $datatype,
          $pos, $off, $intlen, $decs, $default, $text ) =
# record structure changes from release 3.x to 4.x 
	      unpack( ( $info->{RFCSAPRL} =~ /^[4-9]\d\w\s$/ ) ?
		      "A A30 A30 A30 A A4 A6 A6 A6 A21 A79 A1" :
		      "A A30 A10 A10 A A4 A6 A6 A6 A21 A79", $row );
      $name =~ s/\s//g;
      $tabname =~ s/\s//g;
      $field =~ s/\s//g;
      $intlen = int($intlen);
      $decs = int($decs);
      # if the character value default is in quotes - remove quotes
      if ($default =~ /^\'(.*?)\'\s*$/){
	  $default = $1;
	  # if the value is an SY- field - we have some of them in sapinfo
      } elsif ($default =~ /^SY\-(\w+)\W*$/) {
	  $default = 'RFC'.$1;
	  if ( exists $info->{$default} ) {
	      $default = $info->{$default};
	  } else {
	      $default = undef;
	  };
      };
      my $structure = "";
      if ($datatype eq "C"){
	  # Character
	  $datatype = RFCTYPE_CHAR;
	  $default = " " if $default =~ /^SPACE\s*$/;
#	  print STDERR "SET $name TO $default \n";
      } elsif ($datatype eq "X"){
	  # Integer
	  $datatype = RFCTYPE_BYTE;
	  $default = pack("H*", $default) if $default;
      } elsif ($datatype eq "I"){
	  # Integer
	  $datatype = RFCTYPE_INT;
	  $default = int($default) if $default;
      } elsif ($datatype eq "s"){
	  # Short Integer
	  $datatype = RFCTYPE_INT2;
	  $default = int($default) if $default;
      } elsif ($datatype eq "D"){
	  # Date
	  $datatype = RFCTYPE_DATE;
	  $default = '00000000';
	  $intlen = 8;
      } elsif ($datatype eq "T"){
	  # Time
	  $datatype = RFCTYPE_TIME;
	  $default = '000000';
	  $intlen = 6;
      } elsif ($datatype eq "P"){
	  # Binary Coded Decimal eg. CURR QUAN etc
	  $datatype = RFCTYPE_BCD;
	  #$default = 0;
      } elsif ($datatype eq "N"){
	  #  Numchar
	  $datatype = RFCTYPE_NUM;
	  #$default = 0;
	  $default = sprintf("%0".$intlen."d", $default) 
	      if $default == 0 || $default =~ /^[0-9]+$/;
      } elsif ($datatype eq "F"){
	  #  Float
	  $datatype = RFCTYPE_FLOAT;
	  #$default = 0;
      } elsif ( ($datatype eq " " or ! $datatype ) and $type ne "X"){
	  # do a structure object
	  $structure = structure( $self, $tabname );
	  $datatype = RFCTYPE_BYTE;
      } else {
	  # Character
	  $datatype = RFCTYPE_CHAR;
	  $default = " " if $default =~ /^SPACE\s*$/;
      };
      $datatype = RFCTYPE_CHAR if ! $datatype;
      if ($type eq "I"){
	  #  Export Parameter - Reverse perspective
	  $interface->addParm( 
			       TYPE => RFCEXPORT,
			       INTYPE => $datatype, 
			       NAME => $name, 
			       STRUCTURE => $structure, 
			       DEFAULT => $default,
			       VALUE => $default,
			       DECIMALS => $decs,
			       LEN => $intlen);
      } elsif ( $type eq "E"){
	  #  Import Parameter - Reverse perspective
	  $interface->addParm( 
			       TYPE => RFCIMPORT,
			       INTYPE => $datatype, 
			       NAME => $name, 
			       STRUCTURE => $structure, 
			       VALUE => undef,
			       DECIMALS => $decs,
			       LEN => $intlen);
      } elsif ( $type eq "T"){
	  #  Table
	  $interface->addTab(
			     # INTYPE => $datatype, 
			     INTYPE => RFCTYPE_BYTE, 
			     NAME => $name,
			     STRUCTURE => $structure, 
			     LEN => $intlen);
      } else {
	  # This is an exception definition
	  $interface->addException( $name );
      };
  };
  return $interface;

}


# method to return a structure object of SAP::Structure type
sub structure{

  my $self = shift;
  my $struct = shift;
  die "RFC is NOT connected for structure discovery!"
     if ! is_connected( $self );
  # do RFC call to obtain structure 
  if ($DEBUG){
    print "RFC CALL for STRUCTURE: $struct \n";
  };
  my $info = $self->sapinfo();

  my $iface = {
      'TABNAME' => { 'TYPE' => RFCEXPORT,
		     'VALUE' => $struct,
		     'INTYPE' => RFCTYPE_CHAR,
		     'LEN' => length($struct) }, 
      'FIELDS'    => { 'TYPE' => RFCTABLE,
		       'VALUE' => [],
		       'INTYPE' => RFCTYPE_BYTE,
		       'LEN' => 83 } 
  }; 

  my $str = MyRfcCallReceive( $self->{HANDLE},
			      "RFC_GET_STRUCTURE_DEFINITION_P",
			      $iface );
  
  return  undef if $str->{'__RETURN_CODE__'} != 0;
  
  $struct = SAP::Struc->new( NAME => $struct );
  map {
      my ($tabname, $field, $pos, $off, $intlen, $decs, $exid ) =
# record structure changes from 3.x to 4.x
	  unpack( ( $info->{RFCSAPRL} =~ /^[4-9]\d\w\s$/ ) ?
		  "A30 A30 A4 A6 A6 A6 A" : "A10 A10 A4 A6 A6 A6 A", $_ );
      $struct->addField( 
			 NAME     => $field,
			 LEN      => $intlen,
			 OFFSET   => $off,
			 DECIMALS => $decs,
			 INTYPE   => $exid
			 )
      }  ( @{ $str->{'FIELDS'} } );
  return $struct;

}

#  get the handle
sub handle{

  my $self = shift;
  return  $self->{HANDLE};
  
}


#  test the open connection status
sub is_connected{

  my $self = shift;
  my $ping = MyRfcCallReceive( $self->{HANDLE}, "RFC_PING", {} );
  
  return  $ping->{'__RETURN_CODE__'} == 0 ? 1 : undef;
  
}

# Call The RFCSI_EXPORT Function module to
#  get the instance information of the connected system
sub sapinfo {
  my $return = "";
  my $output = "";

  my $self = shift;

  if ( ! exists $self->{SYSINFO} ){
    die "SAP Connection Not Open for SYSINFO "
      if ! is_connected( $self );

  my $sysinfo = MyRfcCallReceive( $self->{HANDLE}, "RFC_SYSTEM_INFO",
				  {   'RFCSI_EXPORT' => {
				      'TYPE' => RFCIMPORT,
				      'VALUE' => '',
				      'INTYPE' => RFCTYPE_CHAR,
				      'LEN' => 200 }
				  }
				  );
  
    return  undef if $sysinfo->{'__RETURN_CODE__'} != 0;

    my $pos = 0;
    my $info = {};
    map {
	$info->{$_->{NAME}} = 
	    substr($sysinfo->{'RFCSI_EXPORT'},$pos, $_->{LEN});
	$pos += $_->{LEN}
    } @SYSINFO;


    $self->{RETURN} = $return;
    $self->{SYSINFO} = $info;
  }

  return  $self->{SYSINFO};

}


# Call The Function module
sub callrfc {
  my $self = shift;
  my $iface = shift;
  my $ref = ref($iface);
  die "this is not an Interface Object!" 
     unless $ref eq "SAP::Iface" and $ref;

  die "SAP Connection Not Open for RFC call "
     if ! is_connected( $self );

  my $result = MyRfcCallReceive( $self->{HANDLE}, $iface->name, $iface->iface);

  if ($DEBUG){
      use  Data::Dumper;
      print "RFC CALL: ", $iface->name(), " RETURN IS: ".Dumper( $result )." \n";
  };
  
  if ( $result->{'__RETURN_CODE__'} != 0 ){
      die "RFC call falied: ".$result->{'__RETURN_CODE__'};
  } else {
      map {
	  $_->intvalue( intoext( $_, $result->{$_->name()} ) )
	  } ( $iface->parms() );
      $iface->emptyTables();
      map { my $tab = $_;
	    map { $tab->addRow( $_ ) }
	        ( @{$result->{$tab->name()}} )
	} ( $iface->tabs() );
  }
}


# convert internal data types to externals
sub intoext{
    my $parm = shift;
    my $value = shift;

    if ( $parm->intype() == RFCTYPE_INT ){
	return unpack("l", $value);
    } elsif ( $parm->intype() == RFCTYPE_FLOAT ){
	return unpack("d",$value);
    } elsif ( $parm->intype() == RFCTYPE_BCD ){
	#  All types of BCD
	my @flds = split(//, unpack("H*",$value));
	if ( $flds[$#flds] eq 'd' ){
	    splice( @flds,0,0,'-');
	} else {
	    splice( @flds,0,0,'+');
	}
	pop( @flds );
	splice(@flds,$#flds - ( $parm->decimals - 1 ),0,'.')
	    if $parm->decimals > 0;
	return join('', @flds);
    } else {
	return $value;
    }

}


# Close the Current Open Handle
sub close {
  my $self = shift;
  if ( exists $self->{HANDLE} ) {
      MyDisconnect( $self->{HANDLE} );
      delete $self->{HANDLE};
      delete $self->{SYSINFO};
      return 1;
  } else {
      return undef;
  };
}





=head1 NAME

SAP::Rfc - Perl extension for performing RFC Function calls against an SAP R/3
System.  Please refer to the README file found with this distribution.

=head1 SYNOPSIS

  use SAP::Rfc;
  $rfc = new SAP::Rfc(
		      ASHOST   => 'myhost',
		      USER     => 'ME',
		      PASSWD   => 'secret',
		      LANG     => 'EN',
		      CLIENT   => '200',
		      SYSNR    => '00',
		      TRACE    => '1' );

my $it = $rfc->discover("RFC_READ_TABLE");

$it->QUERY_TABLE('TRDIR');
$it->ROWCOUNT( 2000 );
$it->OPTIONS( ["NAME LIKE 'RS%'"] );

$rfc->callrfc( $it );

print "NO. PROGS: ".$it->tab('DATA')->rowCount()." \n";
print join("\n",( $it->DATA ));

$rfc->close();



=head1 DESCRIPTION

  The best way to discribe this package is to give a brief over view, and
  then launch into several examples.
  The SAP::Rfc package works in concert with several other packages that
  also come with same distribution, these are SAP::Iface, SAP::Parm,
  SAP::Tab, and SAP::Struc.  These come
  together to give you an object oriented programming interface to
  performing RFC function calls to SAP from a UNIX based platform with
  your favourite programming language - Perl.
  A SAP::Rfc object holds together one ( and only one ) connection to an
  SAP system at a time.  The SAP::Rfc object can hold one or many SAP::Iface
  objects, each of which equate to the definition of an RFC Function in
  SAP ( trans SE37 ). Each SAP::Iface object holds one or many
  SAP::Parm, and/or SAP::Tab objects, corresponding to
  the RFC Interface definition in SAP ( SE37 ).
  For all SAP::Tab objects, and for complex SAP::Parm objects,
   a SAP::Struc object can be defined.  This equates to a
  structure definition in the data dictionary ( SE11 ).
  Because the manual definition of interfaces and structures is a boring
  and tiresome exercise, there are specific methods provided to 
  automatically discover, and add the appropriate interface definitions
  for an RFC Function module to the SAP::Rfc object ( see methods
  discover, and structure of SAP::Rfc ).


=head1 METHODS:

$rfc->PARM_NAME( 'a value ')
  The parameter or tables can be accessed through autoloaded method calls - this can be useful for setting or getting the parameter values.


discover
  $iface = $rfc->discover('RFC_READ_REPORT');
  Discover an RFC interface definition, and automaticlly add it to an SAP::Rfc object.  This will also define all associated SAP::Parm, SAP::Tab, and SAP::Struc objects.


structure
  $str = $rfc->structure('QTAB');
  Discover and return the definition of a valid data dictionary structure.  This could be subsequently used with an SAP::Parm, or SAP::Tab object.



is_connected
  if ($rfc->is_connected()) {
  } else {
  };
  Test that the SAP::Rfc object is connected to the SAP system.


sapinfo
  %info = $rfc->sapinfo();
  map { print "key: $_ = ", $info{$_}, "\n" }
        sort keys %info;
  Return a hash of the values supplied by the RFC_SYSTEM_INFO function module.  This function is only properly called once, and the data is cached until the RFC connection is closed - then it will be reset next call.
  


callrfc
  $rfc->callrfc('RFC_READ_TABLE');
  Do the actual RFC call - this installs all the Export, Import, and Table Parameters in the actual C library of the XS extension, does the RFC call, Retrieves the table contents, and import parameter contents, and then cleans the libraries storage space again.


close
  $rfc->close();
  Close the current open RFC connection to an SAP system, and then reset cached sapinfo data.



=head1 AUTHOR

Piers Harding, piers@ompa.net.

But Credit must go to all those that have helped.


=head1 SEE ALSO

perl(1), SAP::Iface(3).

=cut



1;

__DATA__

__C__


#include <saprfc.h>
#include <sapitab.h>

#define MAX_PARA 64

#define RFCIMPORT     0
#define RFCEXPORT     1
#define RFCTABLE      2



/* standard error call back handler - installed into connnection object */
static void  DLL_CALL_BACK_FUNCTION  rfc_error( char * operation ){

  RFC_ERROR_INFO_EX  error_info;
  
  fprintf( stderr, "RFC Call/Exception: %s\n", operation );
  RfcLastErrorEx(&error_info);
  fprintf( stderr, "\nGroup       Error group %d", error_info.group );
  fprintf( stderr, "\nKey         %s", error_info.key );
  fprintf( stderr, "\nMessage     %s\n", error_info.message );
  exit(0);

}



/* build a connection to an SAP system */
SV*  MyConnect(char* connectstring){

    RFC_ENV            new_env;
    RFC_HANDLE         handle;
    RFC_ERROR_INFO_EX  error_info;
    
    new_env.allocate = NULL;
    new_env.errorhandler = rfc_error;
    RfcEnvironment( &new_env );
    
    // fprintf(stderr, "CONNECT: %s\n", connectstring);
    handle = RfcOpenEx(connectstring,
		       &error_info);

    if (handle == RFC_HANDLE_NULL){
	RfcLastErrorEx(&error_info);
	fprintf(stderr, "GROUP \t %d \t KEY \t %s \t MESSAGE \t %s \0",
		error_info.group, error_info.key, error_info.message );
	exit(0);
    };
 
    return newSViv( ( int ) handle );
    
}



/* Disconnect from an SAP system */
int  MyDisconnect(SV* sv_handle){

    RFC_HANDLE         handle = SvIV( sv_handle );
    
    RfcClose( handle ); 
    return 1;

}


/* copy the value of a parameter to a new pointer variable to be passed back onto the 
   parameter pointer argument */
static void * MyValue( SV* type, SV* value, SV* length, int copy ){

    char * ptr;
    int i_value;
    double d_value;

    int len = SvIV( length );
    
    ptr = malloc( len + 1 );
    if ( ptr == NULL )
	return 0;
    memset(ptr, 0, len + 1);
    switch ( SvIV( type ) ){
//      case RFCTYPE_INT:
//      case RFCTYPE_FLOAT:
      default:
/*  All the other SAP internal data types
        case RFCTYPE_CHAR:
        case RFCTYPE_BYTE:
        case RFCTYPE_NUM:
        case RFCTYPE_BCD:
        case RFCTYPE_DATE:
        case RFCTYPE_TIME: */
        if ( copy == TRUE ){
          Copy(SvPV( value, len ), ptr, len, char);
	};
        break;
    };
    return ptr;

}



/* build the RFC call interface, do the RFC call, and then build a complex
  hash structure of the results to pass back into perl */
SV* MyRfcCallReceive(SV* sv_handle, SV* sv_function, SV* iface){


   RFC_PARAMETER      myexports[MAX_PARA];
   RFC_PARAMETER      myimports[MAX_PARA];
   RFC_TABLE          mytables[MAX_PARA];
   RFC_RC             rc;
   RFC_HANDLE         handle;
   char *             function;
   char *             exception;
   RFC_ERROR_INFO_EX  error_info;

   int                tab_cnt, 
                      imp_cnt,
                      exp_cnt,
                      irow,
                      h_index,
                      a_index,
                      i,
                      j;

   AV*                array;
   HV*                h_parms;
   HV*                p_hash;
   HE*                h_entry;
   SV*                h_key;
   SV*                sv_type;

   HV*                hash = newHV();


   tab_cnt = 0;
   exp_cnt = 0;
   imp_cnt = 0;

   handle = SvIV( sv_handle );
   function = SvPV( sv_function, PL_na );

   /* get the RFC interface definition hash  and iterate   */
   h_parms =  (HV*)SvRV( iface );
   h_index = hv_iterinit( h_parms );
   for (i = 0; i < h_index; i++) {

     /* grab each parameter hash */
       h_entry = hv_iternext( h_parms );
       h_key = hv_iterkeysv( h_entry );
       p_hash = (HV*)SvRV( hv_iterval(h_parms, h_entry) );
       sv_type = *hv_fetch( p_hash, (char *) "TYPE", 4, FALSE );

       /* determine the interface parameter type and build a definition */
       switch ( SvIV(sv_type) ){
	   case RFCIMPORT:
	     /* build an import parameter and allocate space for it to be returned into */
	   myimports[imp_cnt].name = malloc( strlen( SvPV(h_key, PL_na)) + 1 );
	   if ( myimports[imp_cnt].name == NULL )
	       return 0;
	   memset(myimports[imp_cnt].name, 0, strlen( SvPV(h_key, PL_na)) + 1);
	   Copy( SvPV(h_key, PL_na), myimports[imp_cnt].name, strlen( SvPV(h_key, PL_na)), char);
	   myimports[imp_cnt].nlen = strlen( SvPV(h_key, PL_na));
	   myimports[imp_cnt].addr = MyValue(  *hv_fetch(p_hash, (char *) "INTYPE", 6, FALSE),
					       *hv_fetch(p_hash, (char *) "VALUE", 5, FALSE),
					       *hv_fetch(p_hash, (char *) "LEN", 3, FALSE), FALSE );
	   myimports[imp_cnt].leng = SvIV( *hv_fetch( p_hash, (char *) "LEN", 3, FALSE ) );
	   myimports[imp_cnt].type = SvIV( *hv_fetch( p_hash, (char *) "INTYPE", 6, FALSE ) );
	   ++imp_cnt;
	   break;

	   case RFCEXPORT:
	     /* build an export parameter and pass the value onto the structure */
	   myexports[exp_cnt].name = malloc( strlen( SvPV(h_key, PL_na)) + 1 );
	   if ( myexports[exp_cnt].name == NULL )
	       return 0;
	   memset(myexports[exp_cnt].name, 0, strlen( SvPV(h_key, PL_na)) + 1);
	   Copy( SvPV(h_key, PL_na), myexports[exp_cnt].name, strlen( SvPV(h_key, PL_na)), char);
	   myexports[exp_cnt].nlen = strlen( SvPV(h_key, PL_na));
	   myexports[exp_cnt].addr = MyValue(  *hv_fetch(p_hash, (char *) "INTYPE", 6, FALSE),
					       *hv_fetch(p_hash, (char *) "VALUE", 5, FALSE),
					       *hv_fetch(p_hash, (char *) "LEN", 3, FALSE), TRUE );
	   myexports[exp_cnt].leng = SvIV( *hv_fetch( p_hash, (char *) "LEN", 3, FALSE ) );
	   myexports[exp_cnt].type = SvIV( *hv_fetch( p_hash, (char *) "INTYPE", 6, FALSE ) );
	   ++exp_cnt;

	   break;

	   case RFCTABLE:
	     /* construct a table parameter and copy the table rows on to the table handle */
	   mytables[tab_cnt].name = malloc( strlen( SvPV(h_key, PL_na)) + 1 );
	   if ( mytables[tab_cnt].name == NULL )
	       return 0;
	   memset(mytables[tab_cnt].name, 0, strlen( SvPV(h_key, PL_na)) + 1);
	   Copy( SvPV(h_key, PL_na), mytables[tab_cnt].name, strlen( SvPV(h_key, PL_na)), char);
	   mytables[tab_cnt].nlen = strlen( SvPV(h_key, PL_na));
	   mytables[tab_cnt].leng = SvIV( *hv_fetch( p_hash, (char *) "LEN", 3, FALSE ) );
	   mytables[tab_cnt].ithandle = 
	       ItCreate( mytables[tab_cnt].name,
			 SvIV( *hv_fetch( p_hash, (char *) "LEN", 3, FALSE ) ), 0 , 0 );
	   if ( mytables[tab_cnt].ithandle == NULL )
	       return 0; 

	   array = (AV*) SvRV( *hv_fetch( p_hash, (char *) "VALUE", 5, FALSE ) );
	   a_index = av_len( array );
	   for (j = 0; j <= a_index; j++) {
	       Copy(  SvPV( *av_fetch( array, j, FALSE ), PL_na ),
		      ItAppLine( mytables[tab_cnt].ithandle ),
		      mytables[tab_cnt].leng,
		      char );
	   };

	   tab_cnt++;

	   break;
	 default:
	   fprintf(stderr, "    I DONT KNOW WHAT THIS PARAMETER IS: %s \n", SvPV(h_key, PL_na));
           exit(0);
	   break;
       };

   };

   /* tack on a NULL value parameter to each type to signify that there are no more */
   myexports[exp_cnt].name = NULL;
   myexports[exp_cnt].nlen = 0;
   myexports[exp_cnt].leng = 0;
   myexports[exp_cnt].addr = NULL;
   myexports[exp_cnt].type = 0;

   myimports[imp_cnt].name = NULL;
   myimports[imp_cnt].nlen = 0;
   myimports[imp_cnt].leng = 0;
   myimports[imp_cnt].addr = NULL;
   myimports[imp_cnt].type = 0;

   mytables[tab_cnt].name = NULL;
   mytables[tab_cnt].ithandle = NULL;
   mytables[tab_cnt].nlen = 0;
   mytables[tab_cnt].leng = 0;
   mytables[tab_cnt].type = 0;


   /* do the actual RFC call to SAP */
   rc =  RfcCallReceive( handle, function,
				    myexports,
				    myimports,
				    mytables,
				    &exception );

   /* check the return code - if necessary construct an error message */
   if ( rc != RFC_OK ){
       RfcLastErrorEx( &error_info );
     if (( rc == RFC_EXCEPTION ) ||
         ( rc == RFC_SYS_EXCEPTION )) {
       hv_store(  hash, (char *) "__RETURN_CODE__", 15,
		  newSVpvf( "EXCEPT\t%s\tGROUP\t%d\tKEY\t%s\tMESSAGE\t%s", exception, error_info.group, error_info.key, error_info.message ),
		  0 );
     } else {
       hv_store(  hash, (char *) "__RETURN_CODE__", 15,
		  newSVpvf( "EXCEPT\t%s\tGROUP\t%d\tKEY\t%s\tMESSAGE\t%s","RfcCallReceive", error_info.group, error_info.key, error_info.message ),
		  0 );
     };
   } else {
       hv_store(  hash,  (char *) "__RETURN_CODE__", 15, newSVpvf( "%d", RFC_OK ), 0 );
   };


   /* free up the used memory for export parameters */
   for (exp_cnt = 0; exp_cnt < MAX_PARA; exp_cnt++){
       if ( myexports[exp_cnt].name == NULL ){
	   break;
       } else {
	   free(myexports[exp_cnt].name);
       };
       myexports[exp_cnt].name = NULL;
       myexports[exp_cnt].nlen = 0;
       myexports[exp_cnt].leng = 0;
       myexports[exp_cnt].type = 0;
       if ( myexports[exp_cnt].addr != NULL ){
	   free(myexports[exp_cnt].addr);
       };
       myexports[exp_cnt].addr = NULL;
   };

   
   /* retrieve the values of the import parameters and free up the memory */
   for (imp_cnt = 0; imp_cnt < MAX_PARA; imp_cnt++){
       if ( myimports[imp_cnt].name == NULL ){
	   break;
       };
       if ( myimports[imp_cnt].name != NULL ){
         switch ( myimports[imp_cnt].type ){
//	 case RFCTYPE_INT:
//	 case RFCTYPE_FLOAT:
	 default:
	   /*  All the other SAP internal data types
	       case RFCTYPE_CHAR:
	       case RFCTYPE_BYTE:
	       case RFCTYPE_NUM:
	       case RFCTYPE_BCD:
	       case RFCTYPE_DATE:
	       case RFCTYPE_TIME: */
	   hv_store(  hash, myimports[imp_cnt].name, myimports[imp_cnt].nlen, newSVpv( myimports[imp_cnt].addr, myimports[imp_cnt].leng ), 0 );
	   break;
	 };
         free(myimports[imp_cnt].name);
       };
       myimports[imp_cnt].name = NULL;
       myimports[imp_cnt].nlen = 0;
       myimports[imp_cnt].leng = 0;
       myimports[imp_cnt].type = 0;
       if ( myimports[imp_cnt].addr != NULL ){
	   free(myimports[imp_cnt].addr);
       };
       myimports[imp_cnt].addr = NULL;

   };
   
   /* retrieve the values of the table parameters and free up the memory */
   for (tab_cnt = 0; tab_cnt < MAX_PARA; tab_cnt++){
       if ( mytables[tab_cnt].name == NULL ){
	   break;
       };
       if ( mytables[tab_cnt].name != NULL ){
	   hv_store(  hash, mytables[tab_cnt].name, mytables[tab_cnt].nlen, newRV_noinc( (SV*) array = newAV() ), 0);
	   /*  grab each table row and push onto an array */
	   for (irow = 1; irow <=  ItFill(mytables[tab_cnt].ithandle); irow++){
	       av_push( array, newSVpv( ItGetLine( mytables[tab_cnt].ithandle, irow ), mytables[tab_cnt].leng ) );
	   };
	   
	   free(mytables[tab_cnt].name);
       };
       mytables[tab_cnt].name = NULL;
       if ( mytables[tab_cnt].ithandle != NULL ){
	   ItFree( mytables[tab_cnt].ithandle );
       };
       mytables[tab_cnt].ithandle = NULL;
       mytables[tab_cnt].nlen = 0;
       mytables[tab_cnt].leng = 0;
       mytables[tab_cnt].type = 0;

   };
   
   return newRV_noinc( (SV*) hash);

}