mirror of
https://github.com/fhem/fhem-mirror.git
synced 2024-06-17 05:40:11 +00:00
2d716378b4
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@14257 2b470e98-0d58-463d-a4d8-8e2adae1ed80
467 lines
11 KiB
Perl
467 lines
11 KiB
Perl
# $Id$
|
|
##############################################
|
|
|
|
use strict;
|
|
use warnings;
|
|
require Exporter;
|
|
use Config;
|
|
use AutoLoader;
|
|
|
|
#todo fix timeout in ms
|
|
|
|
our @ISA = qw(Exporter);
|
|
our %EXPORT_TAGS = (
|
|
'all' => [
|
|
qw(
|
|
S7AreaPE
|
|
S7AreaPA
|
|
S7AreaMK
|
|
S7AreaDB
|
|
S7AreaCT
|
|
S7AreaTM
|
|
)
|
|
]
|
|
);
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
|
|
|
our @EXPORT = qw(
|
|
S7AreaPE
|
|
S7AreaPA
|
|
S7AreaMK
|
|
S7AreaDB
|
|
S7AreaCT
|
|
S7AreaTM
|
|
);
|
|
|
|
|
|
#Base class for S7 and S5 Connections
|
|
package S7ClientBase;
|
|
|
|
# S7 ID Area (Area that we want to read/write)
|
|
use constant S7AreaPE => 0x81;
|
|
use constant S7AreaPA => 0x82;
|
|
use constant S7AreaMK => 0x83;
|
|
use constant S7AreaDB => 0x84;
|
|
use constant S7AreaCT => 0x1C;
|
|
use constant S7AreaTM => 0x1D;
|
|
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = {
|
|
|
|
Connected => 0, # = false
|
|
PDULength => 0,
|
|
MaxReadLength => 0,
|
|
RecvTimeout => 500, # 500 ms
|
|
};
|
|
|
|
return bless $self, $class;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub DESTROY {
|
|
my $self = shift;
|
|
$self->Disconnect();
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub Connect {
|
|
my ($self) = @_;
|
|
return 0;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub Disconnect {
|
|
my ($self) = @_;
|
|
if ( $self->{Connected} ) {
|
|
|
|
$self->{Connected} = 0;
|
|
$self->{PDULength} = 0;
|
|
$self->{MaxReadLength} = 0;
|
|
$self->{LastError} = 0;
|
|
}
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub ReadArea () {
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub WriteArea {
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub getPLCDateTime() {
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub BitAt {
|
|
|
|
my ( $self, $Buffer, $ByteIndex, $BitIndex ) = @_;
|
|
|
|
return 0 if ( $BitIndex > 7 );
|
|
|
|
my @mask = ( 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80 );
|
|
|
|
my @myBuffer = unpack( "C" x $ByteIndex + 1, $Buffer );
|
|
|
|
return 1 if ( ( $myBuffer[$ByteIndex] & $mask[$BitIndex] ) != 0 );
|
|
return 0;
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub ByteAt {
|
|
my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
return $myBuffer[$index];
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub WordAt {
|
|
|
|
my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
my $hi = $myBuffer[$index] << 8;
|
|
|
|
return ( $hi + $myBuffer[ $index + 1 ] );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub DWordAt {
|
|
my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
my $dw1;
|
|
|
|
$dw1 = $myBuffer[$index] << 8;
|
|
|
|
$dw1 = ( $dw1 + $myBuffer[ $index + 1 ] ) << 8;
|
|
|
|
$dw1 = ( $dw1 + $myBuffer[ $index + 2 ] ) << 8;
|
|
|
|
$dw1 = ( $dw1 + $myBuffer[ $index + 3 ] );
|
|
|
|
return $dw1;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub FloatAt {
|
|
my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
my @bytes = (
|
|
$myBuffer[$index],
|
|
$myBuffer[ $index + 1 ],
|
|
$myBuffer[ $index + 2 ],
|
|
$myBuffer[ $index + 3 ]
|
|
);
|
|
|
|
if ( $Config::Config{byteorder} =~ /^1/ )
|
|
{ #take care of the machines byte order
|
|
return unpack( 'f', pack( 'C4', reverse @bytes ) );
|
|
}
|
|
return unpack( 'f', pack( 'C4', @bytes ) );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub ShortAt {
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
|
|
my $b = $self->ByteAt( \@Buffer, $index );
|
|
|
|
if ( ( $b & 0x80 ) != 0 ) {
|
|
|
|
return -( ( ~$b & 0xff ) + 1 );
|
|
}
|
|
return $b;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub IntegerAt {
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# my $w = $self->WordAt( $Buffer, $index );
|
|
|
|
my $w = $self->WordAt( \@Buffer, $index );
|
|
|
|
return ( $w & 0x8000 ) ? -( ( ( ~$w ) & 0xffff ) + 1 ) : $w;
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub DintAt {
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
|
|
my $dw = $self->DWordAt( \@Buffer, $index );
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
|
|
# my $dw = $self->DWordAt( $Buffer, $index );
|
|
|
|
return ( $dw & 0x80000000 ) ? -( ( ~$dw & 0xffffffff ) + 1 ) : $dw;
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub GetU8from {
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->ByteAt( \@Buffer, $index );
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->ByteAt( $Buffer, $index );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub GetS8from {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return ShortAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->ShortAt( \@Buffer, $index );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub GetU16from {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->WordAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->WordAt( \@Buffer, $index );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub GetS16from {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->IntegerAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->IntegerAt( \@Buffer, $index );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub GetU32from {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->DWordAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->DWordAt( \@Buffer, $index );
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub GetS32from {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->DintAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->DintAt( \@Buffer, $index );
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub GetFloatfrom {
|
|
|
|
# my ( $self, $Buffer, $index ) = @_;
|
|
# return $self->FloatAt( $Buffer, $index );
|
|
my $self = $_[0];
|
|
my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren
|
|
my $index = $_[2];
|
|
return $self->FloatAt( \@Buffer, $index );
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub setByteAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
my @myBuffer = unpack( "C" x length($Buffer), $Buffer );
|
|
|
|
$myBuffer[$index] = $value % 256;
|
|
|
|
return pack( "C" x length($Buffer), @myBuffer );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub setWordAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
my @myBuffer = unpack( "C" x length($Buffer), $Buffer );
|
|
|
|
$myBuffer[$index] = $value >> 8;
|
|
$myBuffer[ $index + 1 ] = $value % 256;
|
|
|
|
return pack( "C" x length($Buffer), @myBuffer );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub setDWordAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
my @myBuffer = unpack( "C" x length($Buffer), $Buffer );
|
|
|
|
$myBuffer[ $index + 3 ] = $value % 256;
|
|
$value = $value >> 8;
|
|
$myBuffer[ $index + 2 ] = $value % 256;
|
|
$value = $value >> 8;
|
|
$myBuffer[ $index + 1 ] = $value % 256;
|
|
$value = $value >> 8;
|
|
$myBuffer[$index] = $value % 256;
|
|
|
|
return pack( "C" x length($Buffer), @myBuffer );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub setFloatAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
my @myBuffer = unpack( "C" x length($Buffer), $Buffer );
|
|
|
|
my @bytes = unpack( 'C4', pack( 'f', $value ) );
|
|
if ( $Config::Config{byteorder} =~ /^1/ )
|
|
{ #take care of the machines byte order
|
|
$myBuffer[$index] = $bytes[3];
|
|
$myBuffer[ $index + 1 ] = $bytes[2];
|
|
$myBuffer[ $index + 2 ] = $bytes[1];
|
|
$myBuffer[ $index + 3 ] = $bytes[0];
|
|
}
|
|
else {
|
|
$myBuffer[$index] = $bytes[0];
|
|
$myBuffer[ $index + 1 ] = $bytes[1];
|
|
$myBuffer[ $index + 2 ] = $bytes[2];
|
|
$myBuffer[ $index + 3 ] = $bytes[3];
|
|
}
|
|
|
|
return pack( "C" x length($Buffer), @myBuffer );
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub setShortAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
$value = ( ( ~( -$value ) ) & 0xff ) + 1 if ( $value < 0 );
|
|
return $self->setByteAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub setIntegerAt {
|
|
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
$value = ( ( ~( -$value ) ) & 0xffff ) + 1 if ( $value < 0 );
|
|
return $self->setWordAt( $Buffer, $index, $value );
|
|
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub setDintAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
$value = ( ( ~( -$value ) ) & 0xffffffff ) + 1 if ( $value < 0 );
|
|
return $self->setDWordAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub Put8At {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
return $self->setByteAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub Put16At {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
return $self->setIntegerAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub Put32At {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
return $self->setDintAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub PutFloatAt {
|
|
my ( $self, $Buffer, $index, $value ) = @_;
|
|
return $self->setFloatAt( $Buffer, $index, $value );
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------------------
|
|
sub setRecvTimeout {
|
|
|
|
my ( $self, $newRecvTimeout ) = @_;
|
|
|
|
$self->{RecvTimeout} = $newRecvTimeout;
|
|
}
|
|
#-----------------------------------------------------------------------------
|
|
|
|
sub version {
|
|
return "1.1";
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------
|
|
|
|
|
|
|
|
sub getErrorStr {
|
|
|
|
}
|
|
|
|
1;
|
|
|
|
=pod
|
|
=item summary abstract interface layer S7 / S5
|
|
=item summary_DE abstract interface layer S7 / S5
|
|
=begin html
|
|
|
|
<p><a name="S7_Client"></a></p>
|
|
<h3>S7_Client</h3>
|
|
<ul>
|
|
<ul>abstract interface layer S7 / S5</ul>
|
|
</ul>
|
|
=end html
|
|
=begin html_DE
|
|
|
|
<p><a name="S7_Client"></a></p>
|
|
<h3>S7_Client</h3>
|
|
<ul>
|
|
<ul>abstract interface layer S7 / S5</ul>
|
|
</ul>
|
|
=end html_DE
|
|
|
|
=cut
|