From f6d99b60b0527f29a651dab438cc6628f538ed7b Mon Sep 17 00:00:00 2001
From: charlie71born <>
Date: Thu, 15 Dec 2016 17:57:02 +0000
Subject: [PATCH] 44_S7: Perl Warings fixed
git-svn-id: https://svn.fhem.de/fhem/trunk@12784 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
fhem/FHEM/44_S7.pm | 1253 --------------------------------------------
1 file changed, 1253 deletions(-)
diff --git a/fhem/FHEM/44_S7.pm b/fhem/FHEM/44_S7.pm
index 47ce2d895..cc582d389 100644
--- a/fhem/FHEM/44_S7.pm
+++ b/fhem/FHEM/44_S7.pm
@@ -1101,1259 +1101,6 @@ sub S7_readFromPLC($) { #S5 OK
1;
-=pod
-=begin html
-
-
-S7
-
-This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported).
-The TCP communication module is based on settimino (http://settimino.sourceforge.net)
-
-You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
-
-
-For the communication the following modules have been implemented:
-
-- S7 … sets up the communication channel to the PLC
-- S7_ARead … Is used for reading integer Values from the PLC
-- S7_AWrite … Is used for write integer Values to the PLC
-- S7_DRead … Is used for read bits
-- S7_DWrite … Is used for writing bits.
-
-
-
-Reading work flow:
-
-
-
-The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set.
-
-
-Writing work flow:
-
-
-At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
-
-(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
-
-Note: The S7 module will send always the whole data block to the PLC.
-When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
-
-
-
-
-Define
-
-define <name> S7 <PLC_address> <rack> <slot> [<Interval>]
-
-define logo S7 10.0.0.241 2 0
-
-
-- PLC_address … IP address of the S7 PLC (For S5 see below)
-- rack … rack of the PLC
-- slot … slot of the PLC
-- Interval … Intervall how often the modul should check if a reading is required
-
-
-Note: For Siemens logo you should use a alternative (more simply configuration method):
-define logo S7 LOGO7 10.0.0.241
-
-
-
-Note: For Siemens S5 you must use a alternative (more simply configuration method):
-define logo S7 S5 /dev/tty1
-
-in this case the PLC_address is the serial port number
-
-
-
-Attr
-The following attributes are supported:
-
-- MaxMessageLength
-
-MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
-
-=end html
-
-=begin html_DE
-
-
-
-S7
-
-This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported).
-The TCP communication module is based on settimino (http://settimino.sourceforge.net)
-
-You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
-
-
-For the communication the following modules have been implemented:
-
-- S7 … sets up the communication channel to the PLC
-- S7_ARead … Is used for reading integer Values from the PLC
-- S7_AWrite … Is used for write integer Values to the PLC
-- S7_DRead … Is used for read bits
-- S7_DWrite … Is used for writing bits.
-
-
-
-Reading work flow:
-
-
-
-The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set.
-
-
-Writing work flow:
-
-
-At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
-
-(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
-
-Note: The S7 module will send always the whole data block to the PLC.
-When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
-
-
-
-
-Define
-
-define <name> S7 <PLC_address> <rack> <slot> [<Interval>]
-
-define logo S7 10.0.0.241 2 0
-
-
-- PLC_address … IP address of the S7 PLC (For S5 see below)
-- rack … rack of the PLC
-- slot … slot of the PLC
-- Interval … Intervall how often the modul should check if a reading is required
-
-
-Note: For Siemens logo you should use a alternative (more simply configuration method):
-define logo S7 LOGO7 10.0.0.241
-
-
-
-Note: For Siemens S5 you must use a alternative (more simply configuration method):
-define logo S7 S5 /dev/tty1
-
-in this case the PLC_address is the serial port number
-
-
-
-Attr
-The following attributes are supported:
-
-- MaxMessageLength
-
-MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
-=end html_DE
-
-=cut
-
-package main;
-
-use strict;
-use warnings;
-
-#use Devel::NYTProf; #profiler
-
-require "44_S7_S7Client.pm";
-require "44_S7_S5Client.pm";
-
-my %gets = (
- "S7TCPClientVersion" => "",
- "PLCTime" => ""
-);
-
-my %sets = (
- "intervall" => ""
-);
-
-my @areasconfig = (
- "ReadInputs-Config", "ReadOutputs-Config",
- "ReadFlags-Config", "ReadDB-Config",
- "WriteInputs-Config", "WriteOutputs-Config",
- "WriteFlags-Config", "WriteDB-Config"
-);
-my @s7areas = (
- &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA, &S7ClientBase::S7AreaMK,
- &S7ClientBase::S7AreaDB, &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA,
- &S7ClientBase::S7AreaMK, &S7ClientBase::S7AreaDB
-);
-my @areaname =
- ( "inputs", "outputs", "flags", "db", "inputs", "outputs", "flags", "db" );
-
-#####################################
-sub S7_Initialize($) { #S5_OK
-
- my $hash = shift @_;
-
- # Provider
- $hash->{Clients} = ":S7_DRead:S7_ARead:S7_AWrite:S7_DWrite:";
- my %matchList = (
- "1:S7_DRead" => "^DR",
- "2:S7_DWrite" => "^DW",
- "3:S7_ARead" => "^AR",
- "4:S7_AWrite" => "^AW"
- );
-
- $hash->{MatchList} = \%matchList;
-
- # Consumer
- $hash->{DefFn} = "S7_Define";
- $hash->{UndefFn} = "S7_Undef";
- $hash->{GetFn} = "S7_Get";
- $hash->{SetFn} = "S7_Set";
-
- $hash->{AttrFn} = "S7_Attr";
- $hash->{AttrList} = "MaxMessageLength Intervall " . $readingFnAttributes;
-
- # $hash->{AttrList} = join( " ", @areasconfig )." PLCTime";
-}
-
-#####################################
-sub S7_connect($) {
- my $hash = shift @_;
-
- my $name = $hash->{NAME};
-
- if ( $hash->{STATE} eq "connected to PLC" ) {
- Log3( $name, 2, "$name S7_connect: allready connected!" );
- return;
- }
-
- Log3( $name, 4,
- "S7: $name connect PLC_address="
- . $hash->{plcAddress}
- . ", LocalTSAP="
- . $hash->{LocalTSAP}
- . ", RemoteTSAP="
- . $hash->{RemoteTSAP}
- . " " );
-
- if ( !defined( $hash->{S7PLCClient} ) ) {
- S7_reconnect($hash);
- return;
- }
-
- $hash->{STATE} = "disconnected";
- main::readingsSingleUpdate( $hash, "state", "disconnected", 1 );
- my $res;
-
- if ( $hash->{S7TYPE} eq "S5" ) {
- eval {
- local $SIG{__DIE__} = sub {
- my ($s) = @_;
- Log3( $hash, 0, "S7_connect: $s" );
- $res = -1;
- };
- $res =
- $hash->{S7PLCClient}->S5ConnectPLCAS511( $hash->{plcAddress} );
- };
- }
- else {
- $hash->{S7PLCClient}
- ->SetConnectionParams( $hash->{plcAddress}, $hash->{LocalTSAP},
- $hash->{RemoteTSAP} );
-
- eval {
- local $SIG{__DIE__} = sub {
- my ($s) = @_;
- Log3( $hash, 0, "S7_connect: $s" );
- $res = -1;
- };
- $res = $hash->{S7PLCClient}->Connect();
- };
- }
-
- if ($res) {
- Log3( $name, 2, "S7_connect: $name Could not connect to PLC ($res)" );
- return;
- }
-
- my $PDUlength = $hash->{S7PLCClient}->{PDULength};
- $hash->{maxPDUlength} = $PDUlength;
-
- Log3( $name, 3,
- "$name S7_connect: connect to PLC with maxPDUlength=$PDUlength" );
-
- $hash->{STATE} = "connected to PLC";
- main::readingsSingleUpdate( $hash, "state", "connected to PLC", 1 );
-
- return undef;
-
-}
-
-#####################################
-sub S7_disconnect($) { #S5 OK
- my $hash = shift @_;
- my ( $ph, $res, $di );
- my $name = $hash->{NAME};
- my $error = "";
-
- $hash->{S7PLCClient}->Disconnect() if ( defined( $hash->{S7PLCClient} ) );
- $hash->{S7PLCClient} = undef; #PLC Client freigeben
-
- $hash->{STATE} = "disconnected";
- main::readingsSingleUpdate( $hash, "state", "disconnected", 1 );
-
- Log3( $name, 2, "$name S7 disconnected" );
-
-}
-
-#####################################
-sub S7_reconnect($) { #S5 OK
- my $hash = shift @_;
- S7_disconnect($hash) if ( defined( $hash->{S7PLCClient} ) );
-
- if ( $hash->{S7TYPE} eq "S5" ) {
- $hash->{S7PLCClient} = S5Client->new();
- }
- else {
- $hash->{S7PLCClient} = S7Client->new();
- }
- InternalTimer( gettimeofday() + 3, "S7_connect", $hash, 1 )
- ; #wait 3 seconds for reconnect
-}
-
-#####################################
-sub S7_Define($$) { # S5 OK
- my ( $hash, $def ) = @_;
- my @a = split( "[ \t][ \t]*", $def );
-
- my ( $name, $PLC_address, $LocalTSAP, $RemoteTSAP, $res, $PDUlength, $rack,
- $slot );
-
- $name = $a[0];
-
- if ( uc $a[2] eq "S5" ) {
- $hash->{S7TYPE} = "S5";
- $PLC_address = $a[3];
- if (@a > 4) {
- $hash->{Interval} = $a[4];
- } else {
- $hash->{Interval} = 1;
- }
- $LocalTSAP = -1;
- $RemoteTSAP = -1;
-
- $PDUlength = 240;
-
- }
- elsif ( uc $a[2] eq "LOGO7" || uc $a[2] eq "LOGO8" ) {
- $PLC_address = $a[3];
- $LocalTSAP = 0x0100;
- $RemoteTSAP = 0x0200;
- if (@a > 4) {
- $hash->{Interval} = $a[4];
- } else {
- $hash->{Interval} = 1;
- }
- if ( uc $a[2] eq "LOGO7" ) {
- $hash->{S7TYPE} = "LOGO7";
- }
- else {
- $hash->{S7TYPE} = "LOGO8";
- }
- $PDUlength = 240;
-
- }
- else {
-
- $PLC_address = $a[2];
-
- $rack = int( $a[3] );
- return "invalid rack parameter (0 - 15)"
- if ( $rack < 0 || $rack > 15 );
-
- $slot = int( $a[4] );
- return "invalid slot parameter (0 - 15)"
- if ( $slot < 0 || $slot > 15 );
-
- $hash->{Interval} = 1;
- if ( int(@a) == 6 ) {
- $hash->{Interval} = int( $a[5] );
- return "invalid intervall parameter (1 - 86400)"
- if ( $hash->{Interval} < 1 || $hash->{Interval} > 86400 );
- }
- $LocalTSAP = 0x0100;
- $RemoteTSAP = ( &S7Client::S7_PG << 8 ) + ( $rack * 0x20 ) + $slot;
-
- $PDUlength = 0x3c0;
-
- $hash->{S7TYPE} = "NATIVE";
- }
-
- $hash->{plcAddress} = $PLC_address;
- $hash->{LocalTSAP} = $LocalTSAP;
- $hash->{RemoteTSAP} = $RemoteTSAP;
- $hash->{maxPDUlength} = $PDUlength; #initial PDU length
-
- Log3 $name, 4,
-"S7: define $name PLC_address=$PLC_address,LocalTSAP=$LocalTSAP, RemoteTSAP=$RemoteTSAP ";
-
- $hash->{STATE} = "disconnected";
- main::readingsSingleUpdate( $hash, "state", "disconnected", 1 );
-
- S7_connect($hash);
-
- InternalTimer( gettimeofday() + $hash->{Interval},
- "S7_GetUpdate", $hash, 0 );
-
- return undef;
-}
-
-#####################################
-sub S7_Undef($) { #S5 OK
- my $hash = shift;
-
- RemoveInternalTimer($hash);
-
- S7_disconnect($hash);
-
- delete( $modules{S7}{defptr} );
-
- return undef;
-}
-
-
-#####################################
-sub S7_Set($@) {
-
-
-}
-
-
-#####################################
-sub S7_Get($@) { #S5 OK
- my ( $hash, @a ) = @_;
- return "Need at least one parameters" if ( @a < 2 );
- return "Unknown argument $a[1], choose one of "
- . join( " ", sort keys %gets )
- if ( !defined( $gets{ $a[1] } ) );
- my $name = shift @a;
- my $cmd = shift @a;
-
- ARGUMENT_HANDLER: {
- $cmd eq "S7TCPClientVersion" and do {
-
- return $hash->{S7PLCClient}->version();
- last;
- };
- $cmd eq "PLCTime" and do {
- return $hash->{S7PLCClient}->getPLCDateTime();
- last;
- };
- }
-
-}
-
-#####################################
-sub S7_Attr(@) {
- my ( $cmd, $name, $aName, $aVal ) = @_;
-
- my $hash = $defs{$name};
-
- # $cmd can be "del" or "set"
- # $name is device name
- # aName and aVal are Attribute name and value
-
- if ( $cmd eq "set" ) {
- if ( $aName eq "MaxMessageLength" ) {
-
- if ( $aVal < $hash->{S7PLCClient}->{MaxReadLength} ) {
-
- $hash->{S7PLCClient}->{MaxReadLength} = $aVal;
-
- Log3( $name, 3, "$name S7_Attr: setting MaxReadLength= $aVal" );
- }
- } elsif ($aName eq "MaxMessageLength") {
- if ( $aVal >= 1 ) {
-
- $hash->{Interval} = $aVal;
-
- Log3( $name, 3, "$name S7_Attr: setting Intervall= $aVal" );
- }
- }
- ###########
-
- if ( $aName eq "WriteInputs-Config"
- || $aName eq "WriteOutputs-Config"
- || $aName eq "WriteFlags-Config"
- || $aName eq "WriteDB-Config" )
- {
- my $PDUlength = $hash->{maxPDUlength};
-
- my @a = split( "[ \t][ \t]*", $aVal );
- if ( int(@a) % 3 != 0 || int(@a) == 0 ) {
- Log3( $name, 3,
- "S7: Invalid $aName in attr $name $aName $aVal: $@" );
- return
-"Invalid $aName $aVal \n Format: [ ]";
- }
- else {
-
- for ( my $i = 0 ; $i < int(@a) ; $i++ ) {
- if ( $a[$i] ne int( $a[$i] ) ) {
- my $s = $a[$i];
- Log3( $name, 3,
-"S7: Invalid $aName in attr $name $aName $aVal ($s is not a number): $@"
- );
- return "Invalid $aName $aVal: $s is not a number";
- }
- if ( $i % 3 == 0 && ( $a[$i] < 0 || $a[$i] > 1024 ) ) {
- Log3( $name, 3,
- "S7: Invalid $aName db. valid db 0 - 1024: $@" );
- return
- "Invalid $aName length: $aVal db: valid db 0 - 1024";
-
- }
- if ( $i % 3 == 1 && ( $a[$i] < 0 || $a[$i] > 32768 ) ) {
- Log3( $name, 3,
-"S7: Invalid $aName startposition. valid startposition 0 - 32768: $@"
- );
- return
-"Invalid $aName startposition: $aVal db: valid startposition 0 - 32768";
-
- }
- if ( $i % 3 == 2
- && ( $a[$i] < 1 || $a[$i] > $PDUlength ) )
- {
- Log3( $name, 3,
-"S7: Invalid $aName length. valid length 1 - $PDUlength: $@"
- );
- return
-"Invalid $aName lenght: $aVal: valid length 1 - $PDUlength";
- }
-
- }
-
- return undef if ( $hash->{STATE} ne "connected to PLC" );
-
- #we need to fill-up the internal buffer from current PLC values
- my $hash = $defs{$name};
-
- my $res =
- S7_getAllWritingBuffersFromPLC( $hash, $aName, $aVal );
- if ( int($res) != 0 ) {
-
- #quit because of error
- return $res;
- }
-
- }
- }
- }
- return undef;
-}
-
-#####################################
-
-sub S7_getAreaIndex4AreaName($) { #S5 OK
- my ($aName) = @_;
-
- my $AreaIndex = -1;
- for ( my $j = 0 ; $j < int(@areaname) ; $j++ ) {
- if ( $aName eq $areasconfig[$j] || $aName eq $areaname[$j] ) {
- $AreaIndex = $j;
- last;
- }
- }
- if ( $AreaIndex < 0 ) {
- Log3( undef, 2, "S7_Attr: Internal error invalid WriteAreaIndex" );
- return "Internal error invalid WriteAreaIndex";
- }
- return $AreaIndex;
-
-}
-
-#####################################
-sub S7_WriteToPLC($$$$$$) {
- my ( $hash, $areaIndex, $dbNr, $startByte, $WordLen, $dataBlock ) = @_;
-
- my $PDUlength = -1;
- if ( defined $hash->{maxPDUlength} ) {
- $PDUlength = $hash->{maxPDUlength};
- }
- my $name = $hash->{NAME};
-
- my $res = -1;
- my $Bufferlength = 59999;
- $Bufferlength = length($dataBlock);
-
- if ( $Bufferlength <= $PDUlength ) {
- if ( $hash->{STATE} eq "connected to PLC" ) {
-
- my $bss = join( ", ", unpack( "H2" x $Bufferlength, $dataBlock ) );
- Log3( $name, 5,
-"$name S7_WriteToPLC: Write Bytes to PLC: $areaIndex, $dbNr,$startByte , $Bufferlength, $bss"
- );
-
- eval {
- local $SIG{__DIE__} = sub {
- my ($s) = @_;
- print "DIE:$s";
- Log3( $hash, 0, "DIE:$s" );
- $res = -2;
- };
-
- if ( $hash->{S7TYPE} eq "S5" ) {
- $res = $hash->{S7PLCClient}->S5WriteS5Bytes(
- $s7areas[$areaIndex], $dbNr, $startByte, $Bufferlength,
- $dataBlock
- );
- }
- else {
- $res =
- $hash->{S7PLCClient}
- ->WriteArea( $s7areas[$areaIndex], $dbNr, $startByte,
- $Bufferlength, $WordLen, $dataBlock );
- }
-
- };
- if ( $res != 0 ) {
- my $error = $hash->{S7PLCClient}->getErrorStr($res);
-
- my $msg = "$name S7_WriteToPLC WriteArea error: $res=$error";
- Log3( $name, 3, $msg );
-
- S7_reconnect($hash); #lets try a reconnect
- return ( -2, $msg );
- }
- }
- else {
- my $msg = "$name S7_WriteToPLC: PLC is not connected ";
-
- Log3( $name, 3, $msg );
-
- S7_reconnect($hash); #lets try a reconnect
-
- return ( -2, $msg );
- }
-
- }
- else {
- my $msg =
-"S7_WriteToPLC: wrong block length $Bufferlength (max length $PDUlength)";
- Log3( $name, 3, $msg );
- return ( -1, $msg );
- }
-}
-#####################################
-sub S7_WriteBitToPLC($$$$$) {
- my ( $hash, $areaIndex, $dbNr, $bitPosition, $bitValue ) = @_;
-
- my $PDUlength = -1;
- if ( defined $hash->{maxPDUlength} ) {
- $PDUlength = $hash->{maxPDUlength};
- }
- my $name = $hash->{NAME};
-
- my $res = -1;
- my $Bufferlength = 1;
-
- if ( $Bufferlength <= $PDUlength ) {
- if ( $hash->{STATE} eq "connected to PLC" ) {
-
- my $bss = join( ", ", unpack( "H2" x $Bufferlength, $bitValue ) );
- Log3( $name, 5,
-"$name S7_WriteBitToPLC: Write Bytes to PLC: $areaIndex, $dbNr, $bitPosition , $Bufferlength, $bitValue"
- );
-
- eval {
- local $SIG{__DIE__} = sub {
- my ($s) = @_;
- print "DIE:$s";
- Log3 $hash, 0, "DIE:$s";
- $res = -2;
- };
-
- if ( $hash->{S7TYPE} eq "S5" ) {
-
- #todo fix S5 Handling
- }
- else {
- $res =
- $hash->{S7PLCClient}
- ->WriteArea( $s7areas[$areaIndex], $dbNr, $bitPosition,
- $Bufferlength, &S7Client::S7WLBit, chr($bitValue) );
- }
- };
- if ( $res != 0 ) {
- my $error = $hash->{S7PLCClient}->getErrorStr($res);
-
- my $msg = "$name S7_WriteBitToPLC WriteArea error: $res=$error";
- Log3 $name, 3, $msg;
-
- S7_reconnect($hash); #lets try a reconnect
- return ( -2, $msg );
- }
- }
- else {
- my $msg = "$name S7_WriteBitToPLC: PLC is not connected ";
- Log3 $name, 3, $msg;
- return ( -1, $msg );
- }
-
- }
- else {
- my $msg =
-"S7_WriteBitToPLC: wrong block length $Bufferlength (max length $PDUlength)";
- Log3 $name, 3, $msg;
- return ( -1, $msg );
- }
-}
-
-#####################################
-#sub S7_WriteBlockToPLC($$$$$) {
-# my ( $hash, $areaIndex, $dbNr, $startByte, $dataBlock ) = @_;
-#
-#
-# return S7_WriteToPLC($hash, $areaIndex, $dbNr, $startByte, &S7Client::S7WLByte, $dataBlock);
-#
-#}
-#####################################
-
-sub S7_ReadBlockFromPLC($$$$$) {
- my ( $hash, $areaIndex, $dbNr, $startByte, $requestedLength ) = @_;
-
- my $PDUlength = -1;
- if ( defined $hash->{maxPDUlength} ) {
- $PDUlength = $hash->{maxPDUlength};
- }
- my $name = $hash->{NAME};
- my $readbuffer = "";
- my $res = -1;
-
- if ( $requestedLength <= $PDUlength ) {
- if ( $hash->{STATE} eq "connected to PLC" ) {
-
- eval {
- local $SIG{__DIE__} = sub {
- my ($s) = @_;
- print "DIE:$s";
- Log3 $hash, 0, "DIE:$s";
- $res = -2;
- };
-
- if ( $hash->{S7TYPE} eq "S5" ) {
- ( $res, $readbuffer ) =
- $hash->{S7PLCClient}
- ->S5ReadS5Bytes( $s7areas[$areaIndex], $dbNr, $startByte,
- $requestedLength );
- }
- else {
- ( $res, $readbuffer ) =
- $hash->{S7PLCClient}
- ->ReadArea( $s7areas[$areaIndex], $dbNr, $startByte,
- $requestedLength, &S7Client::S7WLByte );
- }
- };
-
- if ( $res != 0 ) {
-
- my $error = $hash->{S7PLCClient}->getErrorStr($res);
- my $msg =
- "$name S7_ReadBlockFromPLC ReadArea error: $res=$error";
- Log3( $name, 3, $msg );
-
- S7_reconnect($hash); #lets try a reconnect
- return ( -2, $msg );
- }
- else {
-
- #reading was OK
- return ( 0, $readbuffer );
- }
- }
- else {
- my $msg = "$name S7_ReadBlockFromPLC: PLC is not connected ";
- Log3( $name, 3, $msg );
- return ( -1, $msg );
-
- }
- }
- else {
- my $msg =
-"$name S7_ReadBlockFromPLC: wrong block length (max length $PDUlength)";
- Log3( $name, 3, $msg );
- return ( -1, $msg );
- }
-}
-
-#####################################
-
-sub S7_setBitInBuffer($$$) { #S5 OK
- my ( $bitPosition, $buffer, $newValue ) = @_;
-
- my $Bufferlength = ( length($buffer) + 1 ) / 3;
- my $bytePosition = int( $bitPosition / 8 );
-
-# Log3 undef, 3, "S7_setBitInBuffer in: ".length($buffer)." , $Bufferlength , $bytePosition , $bitPosition";
-
- if ( $bytePosition < 0 || $bytePosition > $Bufferlength - 1 ) {
-
- #out off buffer request !!!!!
- # Log3 undef, 3, "S7_setBitInBuffer out -1 : ".length($buffer);
-
- return ( -1, undef );
- }
-
- my @Writebuffer = unpack( "C" x $Bufferlength,
- pack( "H2" x $Bufferlength, split( ",", $buffer ) ) );
-
- my $intrestingBit = $bitPosition % 8;
-
- if ( $newValue eq "on" || $newValue eq "trigger" ) {
- $Writebuffer[$bytePosition] |= ( 1 << $intrestingBit );
- }
- else {
- $Writebuffer[$bytePosition] &= ( ( ~( 1 << $intrestingBit ) ) & 0xff );
- }
-
- my $resultBuffer = join(
- ",",
- unpack(
- "H2" x $Bufferlength,
- pack( "C" x $Bufferlength, @Writebuffer )
- )
- );
-
- $Bufferlength = length($resultBuffer);
-
- # Log3 undef, 3, "S7_setBitInBuffer out: $Bufferlength";
-
- return ( 0, $resultBuffer );
-}
-
-#####################################
-sub S7_getBitFromBuffer($$) { #S5 OK
- my ( $bitPosition, $buffer ) = @_;
-
- my $Bufferlength = ( length($buffer) * 3 ) - 1;
- my $bytePosition = int( $bitPosition / 8 );
- if ( $bytePosition < 0 || $bytePosition > length($Bufferlength) ) {
-
- #out off buffer request !!!!!
- return "unknown";
- }
- my @Writebuffer = unpack( "C" x $Bufferlength,
- pack( "H2" x $Bufferlength, split( ",", $buffer ) ) );
-
- my $intrestingByte = $Writebuffer[$bytePosition];
- my $intrestingBit = $bitPosition % 8;
-
- if ( ( $intrestingByte & ( 1 << $intrestingBit ) ) != 0 ) {
-
- return "on";
- }
- else {
- return "off";
- }
-
-}
-
-#####################################
-sub S7_getAllWritingBuffersFromPLC($$$) { #S5 OK
-
- #$hash ... from S7 physical modul
- #$writerConfig ... writer Config
- #$aName ... area name
-
- my ( $hash, $aName, $writerConfig ) = @_;
-
- Log3( $aName, 4, "S7: getAllWritingBuffersFromPLC called" );
-
- my @a = split( "[ \t][ \t]*", $writerConfig );
-
- my $PDUlength = $hash->{maxPDUlength};
-
- my @writingBuffers = ();
- my $readbuffer;
-
- my $writeAreaIndex = S7_getAreaIndex4AreaName($aName);
- return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) );
-
- my $nr = int(@a);
-
- # Log3 undef, 4, "S7: getAllWritingBuffersFromPLC $nr";
-
- my $res;
- for ( my $i = 0 ; $i < int(@a) ; $i = $i + 3 ) {
- my $readbuffer;
- my $res;
-
- my $dbnr = $a[$i];
- my $startByte = $a[ $i + 1 ];
- my $requestedLength = $a[ $i + 2 ];
-
- ( $res, $readbuffer ) =
- S7_ReadBlockFromPLC( $hash, $writeAreaIndex, $dbnr, $startByte,
- $requestedLength );
- if ( $res == 0 ) { #reading was OK
- my $hexbuffer =
- join( ",", unpack( "H2" x length($readbuffer), $readbuffer ) );
- push( @writingBuffers, $hexbuffer );
- }
- else {
-
- #error in reading so just return the error MSG
- return $readbuffer;
- }
- }
-
- if ( int(@writingBuffers) > 0 ) {
- $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} =
- join( " ", @writingBuffers );
- }
- else {
- $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} = undef;
- }
- return 0;
-}
-
-#####################################
-sub S7_GetUpdate($) {
- my ($hash) = @_;
- my $name = $hash->{NAME};
- Log3( $name, 4, "S7: $name GetUpdate called ..." );
-
- my $res = S7_readFromPLC($hash);
-
- if ( $res == 0 ) {
- InternalTimer( gettimeofday() + $hash->{Interval},
- "S7_GetUpdate", $hash, 1 );
- }
- else {
-
- #an error has occoured --> 10sec break
- InternalTimer( gettimeofday() + 10, "S7_GetUpdate", $hash, 1 );
- }
-
-}
-
-#####################################
-sub S7_dispatchMsg($$$$$$$$) {
- my ( $hash, $msgprefix, $areaIndex, $dbNr, $startByte, $hexbuffer, $length,
- $clientsNames )
- = @_;
-
- my $name = $hash->{NAME};
- my $dmsg =
- $msgprefix . " "
- . $areaname[$areaIndex] . " "
- . $dbNr . " "
- . $startByte . " "
- . $length . " "
- . $name . " "
- . $hexbuffer . " "
- . $clientsNames;
-
- Log3( $name, 5, $name . " S7_dispatchMsg " . $dmsg );
-
- Dispatch( $hash, $dmsg, {} );
-
-}
-#####################################
-sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { #S5 OK
- my (
- $hash, $area, $dbnr,
- $blockstartpos, $blocklength, $hasAnalogReading,
- $hasDigitalReading, $hasAnalogWriting, $hasDigitalWriting,
- $clientsNames
- ) = @_;
-
- my $name = $hash->{NAME};
- my $state = $hash->{STATE};
- my $areaIndex = S7_getAreaIndex4AreaName($area);
-
- Log3( $name, 4,
- $name
- . " READ Block AREA="
- . $area . " ("
- . $areaIndex
- . "), DB ="
- . $dbnr
- . ", ADDRESS="
- . $blockstartpos
- . ", LENGTH="
- . $blocklength );
-
- if ( $state ne "connected to PLC" ) {
- Log3 $name, 3, "$name is disconnected ? --> reconnect";
- S7_reconnect($hash); #lets try a reconnect
- #@nextreadings[ $i / 4 ] = $now + 10; #retry in 10s
- return -2;
- }
-
- my $res;
- my $readbuffer;
-
- ( $res, $readbuffer ) =
- S7_ReadBlockFromPLC( $hash, $areaIndex, $dbnr, $blockstartpos,
- $blocklength );
-
- if ( $res == 0 ) {
-
- #reading was OK
- my $length = length($readbuffer);
- my $hexbuffer = join( ",", unpack( "H2" x $length, $readbuffer ) );
-
- #dispatch to reader
- S7_dispatchMsg( $hash, "AR", $areaIndex, $dbnr, $blockstartpos,
- $hexbuffer, $length, $clientsNames )
- if ( $hasAnalogReading > 0 );
- S7_dispatchMsg( $hash, "DR", $areaIndex, $dbnr, $blockstartpos,
- $hexbuffer, $length, $clientsNames )
- if ( $hasDigitalReading > 0 );
-
- #dispatch to writer
- S7_dispatchMsg( $hash, "AW", $areaIndex, $dbnr, $blockstartpos,
- $hexbuffer, $length, $clientsNames )
- if ( $hasAnalogWriting > 0 );
- S7_dispatchMsg( $hash, "DW", $areaIndex, $dbnr, $blockstartpos,
- $hexbuffer, $length, $clientsNames )
- if ( $hasDigitalWriting > 0 );
- return 0;
- }
- else {
-
- #reading failed
- return -1;
- }
-
-}
-#####################################
-sub S7_getReadingsList($) { #S5 OK
- my ($hash) = @_;
- my $name = $hash->{NAME};
-
- my @readings;
-
- # Jetzt suchen wir alle Readings
- my @mykeys;
- my %logoClients;
-
- @mykeys =
- grep $defs{$_}{TYPE} =~ /^S7_/ && $defs{$_}{IODev}{NAME} eq $hash->{NAME},
- keys(%defs);
- @logoClients{@mykeys} =
- @defs{@mykeys}; #jetzt haben wir alle clients in logoClients
-
- #we need to find out the unique areas
- my %tmphash = map { $logoClients{$_}{AREA} => 1 } keys %logoClients;
- my @uniqueArea = keys %tmphash;
-
- foreach my $Area (@uniqueArea) {
- my %logoClientsArea;
- @mykeys =
- grep $defs{$_}{TYPE} =~ /^S7_/
- && $defs{$_}{IODev}{NAME} eq $hash->{NAME}
- && $defs{$_}{AREA} eq $Area, keys(%defs);
- @logoClientsArea{@mykeys} = @defs{@mykeys};
-
- #now we findout which DBs are used (unique)
- %tmphash = map { $logoClientsArea{$_}{DB} => 1 } keys %logoClientsArea;
- my @uniqueDB = keys %tmphash;
-
- foreach my $DBNr (@uniqueDB) {
-
- #now we filter all readinfy by DB!
- my %logoClientsDB;
-
- @mykeys =
- grep $defs{$_}{TYPE} =~ /^S7_/
- && $defs{$_}{IODev}{NAME} eq $hash->{NAME}
- && $defs{$_}{AREA} eq $Area
- && $defs{$_}{DB} == $DBNr, keys(%defs);
- @logoClientsDB{@mykeys} = @defs{@mykeys};
-
- #next step is, sorting all clients by ADDRESS
- my @positioned = sort {
- $logoClientsDB{$a}{ADDRESS} <=> $logoClientsDB{$b}{ADDRESS}
- } keys %logoClientsDB;
-
- my $blockstartpos = -1;
- my $blocklength = 0;
-
- my $hasAnalogReading = 0;
- my $hasDigitalReading = 0;
- my $hasAnalogWriting = 0;
- my $hasDigitalWriting = 0;
- my $clientsName = "";
-
- for ( my $i = 0 ; $i < int(@positioned) ; $i++ ) {
- if ( $blockstartpos < 0 ) {
-
- #we start a new block
- $blockstartpos =
- int( $logoClientsDB{ $positioned[$i] }{ADDRESS} );
- $blocklength = $logoClientsDB{ $positioned[$i] }{LENGTH};
-
- $hasAnalogReading++
- if (
- $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_ARead" );
- $hasDigitalReading++
- if (
- $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DRead" );
- $hasAnalogWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_AWrite" );
- $hasDigitalWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_DWrite" );
-
- $clientsName = $logoClientsDB{ $positioned[$i] }{NAME};
-
- }
- else {
-
- if ( $logoClientsDB{ $positioned[$i] }{ADDRESS} +
- $logoClientsDB{ $positioned[$i] }{LENGTH} -
- $blockstartpos <=
- $hash->{S7PLCClient}->{MaxReadLength} )
- {
-
- #extend existing block
- if (
- int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ) +
- $logoClientsDB{ $positioned[$i] }{LENGTH} -
- $blockstartpos > $blocklength )
- {
- $blocklength =
- int( $logoClientsDB{ $positioned[$i] }{ADDRESS} )
- + $logoClientsDB{ $positioned[$i] }{LENGTH} -
- $blockstartpos;
-
- $hasAnalogReading++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_ARead" );
- $hasDigitalReading++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_DRead" );
- $hasAnalogWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_AWrite" );
- $hasDigitalWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_DWrite" );
-
- }
- $clientsName .=
- "," . $logoClientsDB{ $positioned[$i] }{NAME};
- }
- else {
-
- #block would exeed MaxReadLength
-
- #read and dispatch block from PLC
- #block in liste speichern
- push(
- @readings,
- [
- $logoClientsDB{ $positioned[$i] }{AREA},
- $logoClientsDB{ $positioned[$i] }{DB},
- $blockstartpos,
- $blocklength,
- $hasAnalogReading,
- $hasDigitalReading,
- $hasAnalogWriting,
- $hasDigitalWriting,
- $clientsName
- ]
- );
-
- $hasAnalogReading = 0;
- $hasDigitalReading = 0;
- $hasAnalogWriting = 0;
- $hasDigitalWriting = 0;
-
- #start new block new time
- $blockstartpos =
- int( $logoClientsDB{ $positioned[$i] }{ADDRESS} );
- $blocklength =
- $logoClientsDB{ $positioned[$i] }{LENGTH};
-
- $hasAnalogReading++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_ARead" );
- $hasDigitalReading++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_DRead" );
- $hasAnalogWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_AWrite" );
- $hasDigitalWriting++
- if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq
- "S7_DWrite" );
-
- $clientsName = $logoClientsDB{ $positioned[$i] }{NAME};
- }
-
- }
-
- }
- if ( $blockstartpos >= 0 ) {
-
- #read and dispatch block from PLC
-
- push(
- @readings,
- [
- $logoClientsDB{ $positioned[ int(@positioned) - 1 ] }
- {AREA},
- $logoClientsDB{ $positioned[ int(@positioned) - 1 ] }
- {DB},
- $blockstartpos,
- $blocklength,
- $hasAnalogReading,
- $hasDigitalReading,
- $hasAnalogWriting,
- $hasDigitalWriting,
- $clientsName
- ]
- );
-
- }
- }
- }
- @{ $hash->{ReadingList} } = @readings;
- return 0;
-
-}
-
-#####################################
-sub S7_readFromPLC($) { #S5 OK
- my ($hash) = @_;
- my $name = $hash->{NAME};
- my $res;
-
- if ( ( !defined( $hash->{dirty} ) ) || $hash->{dirty} == 1 ) {
- S7_getReadingsList($hash);
- $hash->{dirty} = 0;
- }
-
- my @readingList = @{ $hash->{ReadingList} };
-
- for ( my $i = 0 ; $i < int(@readingList) ; $i++ ) {
- my @readingSet = @{ $readingList[$i] };
- $res = S7_readAndDispatchBlockFromPLC(
- $hash, $readingSet[0], $readingSet[1], $readingSet[2],
- $readingSet[3], $readingSet[4], $readingSet[5], $readingSet[6],
- $readingSet[7], $readingSet[8]
- );
-
- return $res if ( $res != 0 );
- }
- return 0;
-}
-
-1;
-
=pod
=item summary basic interface to a SIEMENS S7 / S5
=item summary_DE Schnittstelle zu einer Siemens S7 / S5