package RFC::PLC;
# $Id: PLC.pm,v 1.22 2022/05/24 08:18:12 sqko Exp $
#################################################################
#
#
#              RFC::PLC
#
# This class is a modbus communication interface class thats read and write from a modbus device  
# the class do not implement any of the RFC classes and can therefore 
# be used as a stand alone interface for TCP modbus communication.
# the class is constructed as a singleton class with the IP as the key
# to the singleton
# meaning when instantiate an instance of this class the IP will be checked
# for already exist and if not a new object will be obtained.
#
# this means that all interfacing to a specific modbus device with that IP_address
# will go through the same object
#
# the PLC class is constructed as a interface/data object containing
# a data structure of of Modbus  addresses and the data associated with this address is saved
# if a read() cmd as been executed  
# the data structure is dynamic and new addresses to read can be added by running the member function 
# addDataAdr() with augments, if successful the address will now be read with the read() CMD  
# to get data from the structure just run getSingleReading() with the adrName key as argument
#
# Design criterium for the modbus stack:  in order for this class to work properly with the modbus stack server
# the stack should be build in sets of 16 bit words, for example a byte should always come in pairs of 2
# bytes after each other so the offset address grow with 2, datatype BOOL is also considered as a byte/single element
# always avoid to place a 16bit datatype or longer at an odd offset address
# 
# To obtain an instance of this class call the constructors 
# like:
#
# $id = RFC::PLC->new(%)
#
# where the argument hash must have at least the 'IP_address' key defined (with the PLC's IP address)
# Additional possible hash keys are: port (TCP-IP port), readStartAddress, dataQuantity and subNAME 
#
#
# Example of use:
#
# -- $id = RFC::PLC->new(IP_address => '10.0.1.216'); \\
# -- $id->addDataAdr("PLC_Date_and_time", 28, 72,'UDINT'); \\
# -- $id->read();  \\
# -- print scalar(localtime($id->getSingleReading("PLC_Date_and_time")));
#
#
# The RFC::PLC module member functions is definedd below:
#
#
#
#
#
#
#
# $id->addDataAdr($$$$)           Adds a data item to the data list. Arguments (in roder of alignment):
#                                 $adrName = hash key name of the modbus adrress ! 
#                                 should be an unique name as it is used as the key in the datastructure. 
# 				  $adr = the modbus stack address number of the variable to read starting 
#                                 from 1 = first data element of the stack	
# 				  $Offset = the modbus stack offset number
# 				  $dataType which must be one of the following types: 
#                                 'BOOL', 'BYTE', 'DINT', 'DWORD', 'INT', 'LREAL', 'REAL', 'SINT', 'TIME', 
#                                 'UDINT', 'UINT', 'USINT', 'WORD'
#                                 Example call. $testPLC->addDataAdr("DI24_Analog", 125, 384,'INT');
# $id->print()	 		  use for debugging, print out obejct configuration 
#                                 (datastruct, name, modbus adr, etc. ) to stdout  										
# $id->getName()   		  get the subName of the obejct 
# $id->getIP()			  get the Ip address of the modbus server
# $id->checkAdrNameExists()	  return 1 if name exists in the data structure
# $id->read()			  execute a modbus stack read of the full data structure, 
#                                 return 1 if succesfully with out any errors
# $id->getSingleReading($)  	  returns the last read value of the address key name specified if exist 
#                                 remember to run read() before to get a new data set
# $id->getReadings()		  get the whole data structure  remember to run read() before
# $id->getRawBytes()		  return the last read byte string 
# $id->getLastModbusMsg()	  return last status msg of the modbus
# $id->getlastModbusException()	  return last Modbus exception
#
#	------------WRITE section------------------------------------- 
#	modbus writing supports up to 16 bit(2byte) register and coil(BOOL) writing,
#	in the case of 1 byte writing this can only be done by writing to the whole 16 bit word and therefore the value of the second byte in the word
# 	will be overwritten with zero value if not known else the last know set value will be set but only if added to the @adrstructOut where the last written value
# 	is stored,   		
# 	its planed to update the modbus driver to support writing to multiple registers at once by adding the write_registers function code, 
#	but for now we see if this will be of any needs in the future.  
#	plese note that reading and writing at the same modbus adr. may not give the same value as this is controlled by the modbus slave ex. 
#       the PLC and if the same variable point 
#	at the same IN and Out register address in the modbus device.
#	writing member functions
#  
#  $id->addDataAdrWrite($$$$)			add a modbus stack writing address, after adding a an adr. the modbus adr can be write to by 
#						calling the write() with the address name and a set value.
#						arg: $adrName, $adr	,$Offset,$dataTybe
#						valid data types: BOOL,BYTE,UDINT,SINT,INT,UINT WORD,
#  $id->setNewValue($$)			        arg:  "adr_name" "new value"  followed by a writeAllAdr() cmd or Write()
#  $id->write_raw($$$)				write to a none specified modbus stack address by raw address 
#						arg: $address = stackAdr,  $type = BOOL or 16 bit INT data type, $value = num  
#  $id->write($$)				arg: $dataAdrName , $value
#  $id->convToOutputFormat($$) 			Privat member function that converts input numbers of different type to the modbus data format 
#					        ex. a signed INT will be converted to its corresponding unsigned decimal value
#						arg: $dataType, $value
#  $id->getOutStructData($$)			get adrstruct data by address name and hash key name
#						Arg: $dataAdrName = name of an existing data adr in the @adrstructOut 
#						$hashName = key name in the @adrstructOut  
# $id->getOutStructDataKeyElement($$$)	         function that search in the @adrstructOut by a $keyValue in any of the hash struct column selected by the $HashKeyName,   	  
#					        and if found returns the value of the $hashName, else returns undef 
#		     				arg: $HashKeyName , $keyValue, $hashName
#
#
#
#
#################################################################

use strict;
use warnings;
use lib '../blib/lib';
use Protocol::Modbus;
use Carp;
use POSIX;

# code look up tables
my %exceptionCode = ( 	0x01 => 'ILLEGAL_FUNCTION_CODE',
			0x02 => 'ILLEGAL_DATA_ADDRESS',
			0x03 => 'ILLEGAL_DATA_VALUE',
			0x04 => 'SERVER_FAILURE',
			0x05 => 'ACKNOWLEDGE' ,
			0x06 => 'SERVER_BUSY',
			0x0A => 'GATEWAY_PROBLEM1',
			0x0B => 'GATEWAY_PROBLEM2',
    );


my %functionCode = ( 	0x01 	=> 'FUNC_READ_COILS' ,
			0x02 	=>	'FUNC_READ_INPUTS',
			0x03 	=>	'FUNC_READ_HOLD_REGISTERS',  
			0x04 	=>  'FUNC_READ_INPUT_REGISTERS', 
			0x05 	=>	'FUNC_WRITE_COIL'	,
			0x06 	=>  'FUNC_WRITE_REGISTER',
			0x07 	=>	'FUNC_READ_EXCEPTION_STATUS' ,
			0x08	=> 	'FUNC_DIAGNOSTICS' ,
			0x0B	=>	'FUNC_GET_COMM_EVENT_COUNTER',
			0x0C	=>  'FUNC_GET_COMM_EVENT_LOG',
			0x0F	=>	'FUNC_WRITE_COILS',
			0x10	=>	'FUNC_WRITE_REGISTERS',
			0x11	=>	'FUNC_REPORT_SLAVE_ID',
			0x1406	=>	'FUNC_READ_FILE_RECORD',
			0x1506	=>	'FUNC_WRITE_FILE_RECORD',
			0x16 	=>	'FUNC_MASK_WRITE_REGISTER',
			0x17	=>	'FUNC_RW_MULTIPLE_REGISTERS',
			0x18	=> 	'FUNC_READ_FIFO_QUEUE',
			0x2B0D	=>	'FUNC_CANOPEN_GEN_REFERENCE',
			0x2B0E	=>	'FUNC_READ_DEVICE_ID',
    );



my %singleton = ();		# this object is a singleton (!! there can only be one instance) 


sub new()
{
    my($obj, %args) = @_;
    my $class = ref($obj) || $obj;
    # check if IP exist and if modbus device allready instanced 
    if( ! exists $args{IP_address} )
    { 
	croak("PLC fail to load modbus: missing agument IP_address ");
	return(undef);
    }
    
    # make new instance
    my $self  = {
	IP_address => undef,
	port => 502,
	readStartAdress => 0,	#
	dataQuantity => 0,
	writeStartAdress =>0,
	writeQuantity => 0,
	subNAME => "defaultName",
	%args,			# overwrite defult settings
	};
	my $deviceName = $args{IP_address} . ':' . $self->{port} ;		# use IP + port to prevent singleton conf bug with wrong port num
    return $singleton{$deviceName} if exists $singleton{$deviceName}; 
    #print " $deviceName \n";
    bless ($self , $class) ;
    
    my @adrStructIn = ( );
    my @adrstructOut = ();   # write adrstruct
    #push @adrStructIn, { adrName => "something", adr => 0, type => "INT" , value => undef};
    $self->{_adrStructIn} = \@adrStructIn;  # mske \@adrStructIn
    $self->{_adrstructOut} = \@adrstructOut;  # mske \@adrStructOut
    my @readSections = ( );		# List of section to read   push @{$self->{_readSections}}, { StartAdr => startValue , Quantity => dataQuan };	
    $self->{_readSections} = \@readSections;
    
    my @writeSections = ( );		# List of section to write   push @{$self->{_writeSections}}, { StartAdr => startValue , Quantity => dataQuan };	
    $self->{_writeSections} = \@writeSections;
    
    
    my $modbus = Protocol::Modbus->new(driver=>'TCP');
    $self->{_modbusClass} = $modbus;
    # Create transport class
    my $trs = Protocol::Modbus::Transport->new(
	driver  => 'TCP',			# for now only TCP
	address => $self->{IP_address},
	port    => $self->{port},
	timeout => 2,
	);
    $self->{_TransportOBJ} = $trs;
    $self->{_modbusMSG} = 'no msg ';
    $self->{_lastModbusException_desc} = ' no Exception';
    $singleton{$deviceName} = $self;
    return $self;
}

sub addDataAdr()
{
    my $self = $_[0];
    my $adrName = $_[1];
    my $adr = $_[2] ;			# -1 to correct PLC modbus table  starting adr 1 = 0
    my $Offset = $_[3] ;	# byte offset
    my $dataTybe = $_[4];
    # add element to read
    my $dataSize = &getTypeSize($dataTybe);
    #my @adrStructIn = @{$self->{_adrStructIn}};
    
    # should add if check adr or name is not already used in _adrStructIn  in order not to have dobbelt instance of the same or perhaps dont care.
    push @{$self->{_adrStructIn}}, { adrName => $adrName, adr => $adr, offset => $Offset , dataSize => $dataSize ,type => $dataTybe , value => 0};
    my $Nquenty = 0;
    
    if(($dataSize == 1 ) && ($Offset % 2)) #byte + odd
    {
	#tjek om den er lige eller ulige og træk -1 fra hvis ulige
	# odd so second byte in the 16 bit word =  (offset - 1)/2 is the quantity number 
	$Nquenty = ceil(($Offset + $dataSize)/2);
	
	# tjek om det giver problemmer med at finde ny startAdr  eller os lav om så der kun kan læses BOOl + 2 byte
	
    }
    else{
	$Nquenty = ceil(($Offset / 2)  + ($dataSize/2));  # 16 bit elements including this adress  
    }
    # update end adr to read
    if ($self->{dataQuantity} < $Nquenty) {  $self->{dataQuantity} =  $Nquenty;}
    #
    #  calculate size
    # update holdingList
    # update new start read and end read adrss of the modbus stack
    # make new transaction
    @{$self->{_adrStructIn}} = grep { defined } @{$self->{_adrStructIn}};
    $self->prepareDatasetToRead(); #  write or update read sections 
}

sub prepareDatasetToRead()	# local function 
{
    my $self = $_[0];
    my @adrStructIn = @{$self->{_adrStructIn}};
    undef @{$self->{_readSections}};		# clean the Readsection  #push @{$self->{_readSections}}, { StartAdr => , Quantity => };	 !! syntaxs may not work  need check
    
    my $readStartAdress = $self->{readStartAdress};
    my $dataQuantity = $self->{dataQuantity};
    my $NdataQuantity = $dataQuantity ;   
    my $MaxQuantity = 120; # max words per/read
    #push @{$self->{_readSections}}, { StartAdr => , Quantity => , Npadding =>};			#  list of readSection 
    
    my $Npadding = 0;
    
    while($NdataQuantity > 0) # generate read sections 
    {
	if($NdataQuantity > $MaxQuantity)
	{
	    
	    push @{$self->{_readSections}}, { StartAdr => $readStartAdress, Quantity => $MaxQuantity , Npadding => $Npadding};			#  add to list of readSection 
	    $NdataQuantity = $NdataQuantity - $MaxQuantity;
	}
	else
	{
	    push @{$self->{_readSections}}, { StartAdr => $readStartAdress, Quantity => $NdataQuantity , Npadding => $Npadding};	# set only if not excist
	    $NdataQuantity = $NdataQuantity - $NdataQuantity;  #  or just set to zero :) 
	}
	
	my $nearestOffset = $dataQuantity ;
	my $foundFlag = 0;
	foreach(@adrStructIn) # check if next start Adr is known and make new start adr
	{
	    #print " run foreach $_->{offset} \n";
	    
	    if( ($_->{offset} /2)  == $dataQuantity-$NdataQuantity)
	    {
		$readStartAdress = $_->{adr}; #set next start adr
		#print " found exact new ADR $readStartAdress \n";
		$foundFlag = 1;
		last;  # break loop  found the new start adr.
		
	    }
	};
	if( ! $foundFlag )
	{
	    foreach(@adrStructIn) 
	    {
		if( (($_->{offset}/2) >= $dataQuantity-$NdataQuantity) && (( $_->{offset} /2) <= $nearestOffset) ) # then find next closest 
		{
		    if(($_->{offset} % 2 ) && ($_->{dataSize} == 1 )){	 						
								# if odd and 1 byte datatype  and odd offset  set new adr -1  and
			# and substrat -1 from
			$readStartAdress = $_->{adr}-1;  # set start adr
			$nearestOffset = ($_->{offset}-1) /2;		# store the offset parred with the start adr for next compare
			$Npadding = (  $dataQuantity-$NdataQuantity - ($_->{offset}-1)/2) *-4 ; #fordi det hex  4h = 16 bits word
		    }
		    else{
			$readStartAdress = $_->{adr};  # set start adr
			$nearestOffset = $_->{offset} /2;		# store the offset parred with the start adr for next compare
			$Npadding = (  $dataQuantity-$NdataQuantity - $_->{offset}/2) *-4 ; #fordi det hex  4h = 16 bits word
		    }
		    
						#print " set new startADR:  $readStartAdress \n";
		    
		}
		
	    };
	    $NdataQuantity = $dataQuantity - $nearestOffset; 
	}
    }
    @{$self->{_readSections}} = grep { defined } @{$self->{_readSections}};  # clean for emty elements 
}


sub print()
{
    my $self = $_[0];
    print " Name: $self->{subNAME} \n";
    print " readStartAdress: $self->{readStartAdress} \n"; 
    print " Data Quantity: $self->{dataQuantity} \n"; 
    my @adrStructIn = @{$self->{_adrStructIn}};
    my @readSections = @{$self->{_readSections}};
    
    #@adrStructIn = grep { defined } @adrStructIn;
    if(@adrStructIn)
    {
	foreach(@adrStructIn)
	{
	    print " name: " . $_->{adrName} . " dataType: " . $_->{type} . " adr: " . $_->{adr} . " offset: " . $_->{offset} . " dataSize: " . $_->{dataSize} ;
	    
	    print "\n";
	    
	}
    }
    else{ print " no modbus stack adress added please run: obj->addDataAdr(args) \n";}
    foreach(@readSections)
    {
	print "  startAdr: " . $_->{StartAdr} . "  dataQuantity: " . $_->{Quantity} . "  Npadding:  " . $_->{Npadding};
	
	print "\n";
	
    };
    # print " Data type: $self->{dataType} \n";
    # print "IP address: $self->{IP_address} \n";
    # print "Stack address: $self->{stack_Address_Num} \n";
    # print " Read start address: $self->{readStartAdress} \n";
    # print " Quantity  : $self->{dataSize} \n";
    
}
sub getName()
{
    my $self = $_[0];
    return $self->{subNAME};
    
}

sub getAdrSetting()
{
    my $self = $_[0];
    
}

sub getIP()
{
    my $self = $_[0];
    return $self->{IP_address};
}

sub checkAdrNameExists()
{
    my $self = $_[0];
    my $newName = $_[0];
    my @adrStructIn = @{$self->{_adrStructIn}};
    if(@adrStructIn)
    {
	foreach(@adrStructIn)
	{
	    if($_->{adrName} eq $newName)
	    {
		return 1;
	    }
	}
    }
    return 0;
}


sub read()
{
    my $self = $_[0];
    my @readSections = @{$self->{_readSections}}; 
    my $modbus =    $self->{_modbusClass} ;
    my $trs    =    $self->{_TransportOBJ} ;
    #
    $self->{_rawData} = ''; # define
    foreach(@readSections)
    {
	# if dataQuantity longer than 120 else just run normal
	my $req = $modbus->readHoldRegistersRequest(
	    address  =>  $_->{StartAdr} ,			
	    quantity =>   $_->{Quantity},	
	    );
	
	# Open a new modbus transaction...
	my $trn = $modbus->transaction($trs, $req);
	#$self->{_request} = $req;
	my $res; 
	# execute transaction 
	eval { $res = $trn->execute(); } || do {
	    my $e = $@;
	    if ($e) {
		$self->{_modbusMSG} = $e ;
		$self->{_lastModbusException_desc} = " No valid modbus exception see modbusMsg";
		#warn "func raised an exception: $@";
		return 0;
	    } 
	};
	if( defined($res) && 'Modbus generic response' ne $res->stringify())
	{
	    # something went wrong
	    $self->{_modbusMSG} = $res->stringify();		# store modbus exception with code number
	    $self->{_lastModbusException_desc} = "Modbus Exception " . $functionCode{$res->function} . " Code: " . $exceptionCode{$res->code} ;  # 
	 return 0;
	}
	$trn->close();	
	select(undef, undef, undef, 0.02);  # sleep 0.01 sec  give the PLC time before next transaction to increase    
	# add try catch  and correct quantiti if failing...
	
	#my $padded =('0') x $_->{Npadding};
	
	## catch when PLC do not response 
	eval { $self->{_rawData} = $self->{_rawData} .('0') x $_->{Npadding} . join('', @{ $res->registers() })} || do {
	    my $e = $@;
	    if ($e) {
		#$self->{_modbusMSG} = $e ;
		#$self->{_lastModbusException_desc} = " No valid modbus exception see modbusMsg";
		#warn "func raised an exception: $@";
		return 0;
	    } ;  # 
	};
    };
    $self->processData(); # return $self->{_rawData} ;
    ### end  function read()
    
    return 1;	
}

sub getSingleReading() # returns the value of the adr name passed - please run read() before
{
    my $self = $_[0];
    my $dataAdrName = $_[1];
    #my $refadrStruct = \@{$self->{_adrStructIn}};
    foreach(@{$self->{_adrStructIn}})
    {
	if ($_->{adrName} eq $dataAdrName){
	    return $_->{value};
	}
    }
}

sub getReadings()
{
	my $self = $_[0];
	return @{$self->{_adrStructIn}};
}

sub getRawBytes()
{
    my $self = $_[0];
    # my @sizeBYTE = ( "BYTE","SINT","USINT");   
    # if(grep {$_ eq $self->{dataType} } @sizeBYTE){
    # return $self->sepByte()
    # }
    # else {	return $self->{_rawData};}
    return $self->{_rawData};
}

sub getLastModbusMsg()
{
    my $self = $_[0];
    return $self->{_modbusMSG};
}

sub getlastModbusException()
{
    my $self = $_[0];
    return $self->{_lastModbusException_desc};
}



sub getTypeSize()   ### local function to calculate size of the data type
{
    my $dataType = $_[0];
    my @oneByteDataType = ("BYTE", "BOOL","SINT","USINT");
    my @oneUnitDataTypes = ("INT", "UINT","WORD");
    my @toUnitsDataTypes = ("UDINT", "REAL","DWORD");
    my @fourUnitDataTypes = ( "LREAL", "TIME");
    
    my $size ;
    if (grep {$_ eq $dataType } @oneUnitDataTypes) {
	$size = 2; # byte
    }
    elsif (grep {$_ eq $dataType } @toUnitsDataTypes) {
	$size = 4;	# byte
    }
    elsif (grep {$_ eq $dataType } @fourUnitDataTypes) {
	$size = 8;  # byte
    }
    elsif(grep {$_ eq $dataType } @oneByteDataType) {
	$size = 1;  # byte
    }
    else{ $size = 0;} # data type not known 
    return $size;
}


sub processData()
{
    my $self = $_[0];
    
    foreach(@{$self->{_adrStructIn}})
    {
	my $bytePack = grabBytePack($_, $self->{_rawData});
	#print "byte pack to convert = $bytePack \n";
	my $prosData = 0;  # evt = 32768
	my $type = $_->{type};
      CASE:
	{
	    $type eq "REAL" and do  { $prosData = sprintf ("%.4f", unpack "f", reverse pack "H*", $bytePack);	last CASE;}; 
	    $type eq "LREAL" and do { $prosData = unpack "d", reverse pack "H*", $bytePack; last CASE;}; 
	    $type eq "UINT" and do   { $prosData = hex( $bytePack);							last CASE;}; 
	    $type eq "BYTE" and do { $prosData = unpack('C',pack 'C', hex($bytePack) );		last CASE;}; 
	    $type eq "SINT" and do {  $prosData = unpack('c',pack 'c', hex($bytePack ) );	last CASE;};   # signed  byte 
	    $type eq "USINT" and do {  $prosData = unpack('C',pack 'C', hex($bytePack ) );	last CASE;};   # unsigned  byte
	    $type eq "INT"  and do { $prosData = unpack('s',pack 's', hex($bytePack));		last CASE;}; 	# 16 bit int
	    $type eq "DINT" and do {$prosData = unpack('l',pack 'l', hex($bytePack)); 		last CASE;}; 	# 32 bit int
	    $type eq "UDINT" and do { $prosData = unpack('L',pack 'L', hex($bytePack));  		last CASE;};   # 32 bit unsigned int
	    $type eq "WORD" and do { $prosData = unpack('S',pack 'S', hex($bytePack));  		last CASE;};   # 16 bit unsigned
	    $type eq "DWORD" and do {  $prosData = unpack('L',pack 'L', hex($bytePack));		last CASE;}; 	# 32 bit word
	    $type eq "TIME" and do {$prosData = hex( $bytePack); 							last CASE;};  	#  64 bit data type maybe wrong 
	    $type eq "BOOL" and do {$prosData = unpack('C',pack 'C', hex($bytePack));		last CASE;}; 
	    
	}
	#print " value = $prosData \n";
	$_->{value} = $prosData;
    };
    #return $prosData;
}

# grap the the upper case or lower case byte depending of the address requested when byte sharing modbus 16 bit word
sub sepByte() 		# perhaps change name !!!
{
    my $self = $_[0];
    #print "$self->{readStartAdress} \n";
    #print "$self->{stack_Address_Num} \n";
    if ($self->{readStartAdress} != $self->{stack_Address_Num}  ){	# -1 = adjust stack num offset see setup function
	return substr ($self->{_rawData} ,2,2)	# read last/Low Byte		
    } 
    else {	return 	substr ($self->{_rawData} ,0,2)	# read first/high Byte
		    
    }
}

sub grabBytePack()
{
# $_->{adrName} . " dataType: " . $_->{type} . " adr: " . $_->{adr} . " offset: " . $_->{offset} . " dataSize: " . $_->{dataSize} ;
    my $dataStructElement = $_[0];
    my $rawData = $_[1];
    return substr ($rawData , $dataStructElement->{offset}*2, $dataStructElement->{dataSize}*2);
}
sub addDataAdrWrite()		# can maybe be implemented in one funktion: addDataAdr() with a read or write flag input
{
    my $self = $_[0];
    my $adrName = $_[1];
    my $adr = $_[2] ;			# -1 to correct PLC modbus table  starting adr 1 = 0
    my $Offset = $_[3] ;	# byte offset
    my $dataTybe = $_[4];	 #	valid types: BOOL,BYTE,UDINT,SINT,INT,UINT WORD,  
    # add element to read
    my $dataSize = &getTypeSize($dataTybe);
    #my @adrStructOut = @{$self->{_adrStructOut}};
    # add if adr or name is not already used in _adrStructOut  or perhaps dont care.
    push @{$self->{_adrStructOut}}, { adrName => $adrName, adr => $adr, offset => $Offset , dataSize => $dataSize ,type => $dataTybe , value => 0};
    @{$self->{_adrStructOut}} = grep { defined } @{$self->{_adrStructOut}};
    # remember to set value = number if write sussec 
}

sub getOutStructDataKeyElement()
{
    my $self = $_[0];
    my $HashKeyName = $_[1];
    my $keyValue = $_[2];
    my $hashName = $_[3];			# valid names: 'adr', 'offset' , 'datasize', 'type', 'value'
    
    foreach(@{$self->{_adrStructOut}})
    {
	if ($_->{$HashKeyName} eq $keyValue){
	    return $_->{$hashName};
	}
	
    }
    return undef;	
}

sub getOutStructData()
{
    my $self = $_[0];
    my $dataAdrName = $_[1];
    my $hashName = $_[2];			# valid names: 'adr', 'offset' , 'datasize', 'type', 'value'
    foreach(@{$self->{_adrStructOut}})
    {
	if ($_->{adrName} eq $dataAdrName){
	    return $_->{$hashName};
	}
	
    }
}

sub convToOutputFormat()
{
    my $self = $_[0];
    my $datatype = $_[1];	
    my $value = $_[2];	

  CASE:
    {
	$datatype eq "UINT" and do    { $value = $value;    last CASE;};
	$datatype eq "BYTE" and do { $value = unpack('C',pack 'C', $value	);     last CASE;};
	$datatype eq "SINT" and do {  $value = unpack('c',pack 'c', $value );	     last CASE;};  # signed  byte 
	$datatype eq "USINT" and do {  $value = unpack('C',pack 'C', $value);	     last CASE;};  # unsigned  byte
	$datatype eq "INT" and do  { $value = unpack('s',pack 's', $value	);   last CASE;};	# 16 bit int
	$datatype eq "DINT" and do {$value = unpack('l',pack 'l', $value); 	      last CASE;};	# 32 bit int
	$datatype eq "WORD" and do { $value = unpack('S',pack 'S', $value);  	 last CASE;};   # 16 bit unsigned
	
    }
    return $value;
    
#    switch ($dataType) {	
	#case ("REAL")	{ $prosData = sprintf ("%.4f", unpack "f", reverse pack "H*", $value);	} 
	#case ("LREAL")	{ $prosData = unpack "d", reverse pack "H*", $value; }
#
#	case ("UINT")    { $value = $value;									}
#	case ("BYTE") { $value = unpack('C',pack 'C', $value	);				}
#	case ("SINT") {  $value = unpack('c',pack 'c', $value );				}  # signed  byte 
#	case ("USINT") {  $value = unpack('C',pack 'C', $value);				}  # unsigned  byte
#	case ("INT")  { $value = unpack('s',pack 's', $value	);				}	# 16 bit int
#	case ("DINT") {$value = unpack('l',pack 'l', $value); 				}	# 32 bit int
	#case ("UDINT") { $prosData = unpack('L',pack 'L', $value);  		}  # 32 bit unsigned int
#	case ("WORD") { $value = unpack('S',pack 'S', $value);  		}   # 16 bit unsigned
	#case ("DWORD") {  $prosData = unpack('L',pack 'L', $value);		}	# 32 bit word
	#case ("TIME") {$prosData = hex( $bytePack); 							} 	#  64 bit data type maybe wrong 
	#case ("BOOL") {$prosData = unpack('C',pack 'C', $value);		}
 #   }
}


sub write()
{
    my $self = $_[0];
    my $dataAdrName = $_[1];
    my $value = $_[2];
    # if register is of BYTE type size  the address is shared of 2 BYTE's	and one can only write both of them at once
    # will need to read both BYTE and write both again ex. A = AA  B = FF   word = AAFF   to alter B to BB one need to write
    #  AABB = 43707
    
    #
    
    #my $refadrStruct = \@{$self->{_adrStructIn}};
    # remember to set value => = number if write sussec 
    
    foreach(@{$self->{_adrStructOut}})
    {
	if ($_->{adrName} eq $dataAdrName){
	    if($_->{type} eq 'BOOL'){
		my $OK = $self->write_raw($_->{adr}, $_->{type}, $value);
		
		$_->{value} = $value if($OK);			# maybe first when sussesful write
		return($OK);
	    }
	    else{
		$value = $self->convToOutputFormat($_->{type},$value);
		
		if($_->{dataSize} > 1){	# greater than 1 byte data type write the normal INT way
		    
		    my $OK = $self->write_raw($_->{adr}, 'INT', $value);
		    $_->{value} = $value if($OK);			# store  the transmitted value for no reson in this case
		    return($OK);
		}
		if($_->{dataSize} == 1){#1 byte type  check the add before or after depending if the adr is odd or even
		    if($_->{offset} % 2 ){  # odd write to the address before and add the value in that register to $value
			
			my $oddValue = $self->getOutStructDataKeyElement('offset',($_->{offset}-1),'value');
			my $tempValue =	$value ;
			$tempValue =  $value + $oddValue * 256  if defined( $oddValue); #rewrite past value to the oddByte
			
			my $OK = $self->write_raw($_->{adr}-1, 'INT', $tempValue);
			$_->{value} = $value if($OK);
			return($OK);
		    }
		    else{  # must be even alter the first byte element
			my $evenValue = $self->getOutStructDataKeyElement('offset',($_->{offset}+1),'value');
			my $tempValue =	$value * 256;
			$tempValue =  $value * 256 + $evenValue if defined($evenValue);
			my $OK = $self->write_raw($_->{adr}, 'INT', $tempValue);
			$_->{value} = $value if($OK);
			return($OK); 
		    }
		}
	    }
	}
    }
}

sub write_raw()
{
    my $self = $_[0];
    my $address = $_[1];
    my $type = $_[2];		# 'BOOL'   or  INT
    my $value = $_[3];
    
    my $modbus =    $self->{_modbusClass} ;
    my $trs    =    $self->{_TransportOBJ} ;
    
    my $req = undef;	
    if($type eq 'BOOL'){
	$req = $modbus->writeCoilRequest(
	    address  => $address,
	    value    => $value,
	    );
    }
    elsif($type eq 'INT'){
	$req = $modbus->writeRegisterRequest(
	    address  => $address,
		value    => $value,
	    );
    }
    else{ print " no type selected no wriiting done \n";
	  return 0; }; # not valid data type
    
# Open a new modbus transaction...
    my $trn = $modbus->transaction($trs, $req);
    
# ... issue the request and get response
    my $res = $trn->execute();
    $self->{_modbusMSG} = $res->stringify() ;
    if($res->stringify() =~ m/Exception/ )	# fail
    {
	print "modbus transaction failed \n";
	
	$self->{_lastModbusException_desc} = " modbus transaction failed";
	return 0;
    }
    elsif($res->stringify() =~ m/response/){
	
	return 1;
    }
    else{ # hmm 
	$self->{_lastModbusException_desc} = "something went wrong";
	return 0;	
    }    
}

1;
