2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-03 16:56:54 +00:00

44_S7:speed optimisations

git-svn-id: https://svn.fhem.de/fhem/trunk@14908 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
charlie71 2017-08-16 06:15:16 +00:00
parent 5fb28f8b68
commit 7722ea85b5
4 changed files with 349 additions and 28 deletions

View File

@ -264,6 +264,7 @@ sub S7_ARead_Parse($$) {
pack( "H2" x $length, split( ",", $hexbuffer ) ) );
#my $b = pack( "C" x $length, @Writebuffer );
my $now = gettimeofday();
foreach my $clientName (@clientList) {
my $h = $defs{$clientName};
@ -320,11 +321,76 @@ sub S7_ARead_Parse($$) {
$myI = $myI * $multi + $offset;
#my $myResult;
my $reading="state";
main::readingsSingleUpdate( $h, "state", $myI, 1 );
# main::readingsSingleUpdate( $h, $reading, $myI, 1 );
# main::readingsSingleUpdate($h,"value",$myResult, 1);
#check event-onchange-reading
#code wurde der datei fhem.pl funktion readingsBulkUpdate entnommen und adaptiert
my $attreocr= AttrVal($h->{NAME}, "event-on-change-reading", undef);
my @a;
if($attreocr) {
@a = split(/,/,$attreocr);
$hash->{".attreocr"} = \@a;
}
# determine whether the reading is listed in any of the attributes
my @eocrv;
my $eocr = $attreocr &&
( @eocrv = grep { my $l = $_; $l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef} @a);
# check if threshold is given
my $eocrExists = $eocr;
if( $eocr
&& $eocrv[0] =~ m/.*:(.*)/ ) {
my $threshold = $1;
if($myI =~ m/([\d\.\-eE]+)/ && looks_like_number($1)) { #41083, #62190
my $mv = $1;
my $last_value = $hash->{".attreocr-threshold$reading"};
if( !defined($last_value) ) {
$h->{".attreocr-threshold$reading"} = $mv;
} elsif( abs($mv - $last_value) < $threshold ) {
$eocr = 0;
} else {
$h->{".attreocr-threshold$reading"} = $mv;
}
}
}
my $changed = !($attreocr)
|| ($eocr && ($myI ne ReadingsVal($h->{NAME},$reading,"")));
my $attrminint = AttrVal($h->{NAME}, "event-min-interval", undef);
my @aa;
if($attrminint) {
@aa = split(/,/,$attrminint);
}
my @v = grep { my $l = $_;
$l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef
} @aa;
if(@v) {
my (undef, $minInt) = split(":", $v[0]);
my $le = $h->{".lastTime$reading"};
if($le && $now-$le < $minInt) {
if(!$eocr || ($eocr && $myI eq ReadingsVal($h->{NAME},$reading,""))){
$changed = 0;
#} else {
# $hash->{".lastTime$reading"} = $now;
}
} else {
#$hash->{".lastTime$reading"} = $now;
$changed = 1 if($eocrExists);
}
}
if ($changed == 1) {
main::readingsSingleUpdate( $h, $reading, $myI, 1 );
}
}
}

View File

@ -59,7 +59,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -77,7 +77,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -95,7 +95,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -109,7 +109,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -122,7 +122,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -130,7 +130,7 @@ sub S7_AWrite_Define($$) {
}
else {
my $msg =
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_DRead {AI|AM|AQ|NAI|NAQ}";
"wrong syntax : define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <address> \n Only for Logo7 or Logo8:\n define <name> S7_AWrite {AI|AM|AQ|NAI|NAQ}";
Log3 undef, 2, $msg;
return $msg;
@ -422,6 +422,7 @@ sub S7_AWrite_Parse($$) {
pack( "H2" x $length, split( ",", $hexbuffer ) ) );
#my $b = pack( "C" x $length, @Writebuffer );
my $now = gettimeofday();
foreach my $clientName (@clientList) {
my $h = $defs{$clientName};
@ -465,7 +466,75 @@ sub S7_AWrite_Parse($$) {
. $h->{DATATYPE} . ")";
}
main::readingsSingleUpdate( $h, "state", $myI, 1 );
#main::readingsSingleUpdate( $h, "state", $myI, 1 );
my $reading="state";
#check event-onchange-reading
#code wurde der datei fhem.pl funktion readingsBulkUpdate entnommen und adaptiert
my $attreocr= AttrVal($h->{NAME}, "event-on-change-reading", undef);
my @a;
if($attreocr) {
@a = split(/,/,$attreocr);
$hash->{".attreocr"} = \@a;
}
# determine whether the reading is listed in any of the attributes
my @eocrv;
my $eocr = $attreocr &&
( @eocrv = grep { my $l = $_; $l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef} @a);
# check if threshold is given
my $eocrExists = $eocr;
if( $eocr
&& $eocrv[0] =~ m/.*:(.*)/ ) {
my $threshold = $1;
if($myI =~ m/([\d\.\-eE]+)/ && looks_like_number($1)) { #41083, #62190
my $mv = $1;
my $last_value = $hash->{".attreocr-threshold$reading"};
if( !defined($last_value) ) {
$h->{".attreocr-threshold$reading"} = $mv;
} elsif( abs($mv - $last_value) < $threshold ) {
$eocr = 0;
} else {
$h->{".attreocr-threshold$reading"} = $mv;
}
}
}
my $changed = !($attreocr)
|| ($eocr && ($myI ne ReadingsVal($h->{NAME},$reading,"")));
my $attrminint = AttrVal($h->{NAME}, "event-min-interval", undef);
my @aa;
if($attrminint) {
@aa = split(/,/,$attrminint);
}
my @v = grep { my $l = $_;
$l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef
} @aa;
if(@v) {
my (undef, $minInt) = split(":", $v[0]);
my $le = $h->{".lastTime$reading"};
if($le && $now-$le < $minInt) {
if(!$eocr || ($eocr && $myI eq ReadingsVal($h->{NAME},$reading,""))){
$changed = 0;
#} else {
# $hash->{".lastTime$reading"} = $now;
}
} else {
#$hash->{".lastTime$reading"} = $now;
$changed = 1 if($eocrExists);
}
}
if ($changed == 1) {
main::readingsSingleUpdate( $h, $reading, $myI, 1 );
}
}
}
}
@ -616,6 +685,9 @@ sub S7_AWrite_Parse($$) {
Note: the required memory area (start &ndash; start + datatypelength) need to be with in the configured PLC writing of the physical module.</ul>
</ul>
</ul>
<p>Logo 7 / Logo 8</p>
<p style="padding-left: 60px;">For Logo7 / Logo 8 also a short notation is supportet:</p>
<p><code>define &lt;name&gt; S7_AWrite {AI|AM|AQ|NAI|NAQ}X</code></p>
<p><strong>Set</strong><br /><br /><code>set &lt;name&gt; S7_AWrite &lt;value&gt;</code></p>
<ul>
<ul>
@ -661,6 +733,9 @@ Note: the required memory area (start &ndash; start + datatypelength) need to be
Note: the required memory area (start &ndash; start + datatypelength) need to be with in the configured PLC writing of the physical module.</ul>
</ul>
</ul>
<p>Logo 7 / Logo 8</p>
<p style="padding-left: 60px;">For Logo7 / Logo 8 also a short notation is supportet:</p>
<p><code>define &lt;name&gt; S7_AWrite {AI|AM|AQ|NAI|NAQ}X</code></p>
<p><strong>Set</strong><br /><br /><code>set &lt;name&gt; S7_AWrite &lt;value&gt;</code></p>
<ul>
<ul>

View File

@ -267,12 +267,40 @@ sub S7_DRead_Parse_new($$) {
my $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s );
Log3 $name, 6, "$name S7_DRead_Parse update $n ";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
main::readingsSingleUpdate( $h, "state", "on", 1 );
my $valueText = "";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
$valueText = "on";
}
else {
main::readingsSingleUpdate( $h, "state", "off", 1 );
$valueText = "off";
}
if (ReadingsVal($h->{NAME},"state","") ne $valueText) {
main::readingsSingleUpdate( $h, "state", $valueText, 1 );
} else {
my $reading="state";
#value not changed check event-min-interval attribute
my $attrminint = AttrVal($name, "event-min-interval", undef);
if($attrminint) {
my @a = split(/,/,$attrminint);
}
my @v = grep { my $l = $_;
$l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef} @a;
if(@v) {
my (undef, $minInt) = split(":", $v[0]);
my $now = gettimeofday();
my $le = $hash->{".lastTime$reading"};
if($le && $now-$le >= $minInt) {
main::readingsSingleUpdate( $h, $reading, $valueText, 1 );
}
}
}
}
}
@ -329,6 +357,7 @@ sub S7_DRead_Parse($$) {
my @Writebuffer = unpack( "C" x $length,
pack( "H2" x $length, split( ",", $hexbuffer ) ) );
my $now = gettimeofday();
foreach my $clientName (@clientList) {
my $h = $defs{$clientName};
@ -351,15 +380,91 @@ sub S7_DRead_Parse($$) {
Log3 $name, 6, "$name S7_DRead_Parse update $clientName ";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
main::readingsSingleUpdate( $h, "state", "on", 1 );
# if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
# main::readingsSingleUpdate( $h, "state", "on", 1 );
# }
# else {
# main::readingsSingleUpdate( $h, "state", "off", 1 );
# }
my $valueText = "";
my $reading="state";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
$valueText = "on";
}
else {
main::readingsSingleUpdate( $h, "state", "off", 1 );
$valueText = "off";
}
#check event-onchange-reading
#code wurde der datei fhem.pl funktion readingsBulkUpdate entnommen und adaptiert
my $attreocr= AttrVal($h->{NAME}, "event-on-change-reading", undef);
my @a;
if($attreocr) {
@a = split(/,/,$attreocr);
$hash->{".attreocr"} = \@a;
}
# determine whether the reading is listed in any of the attributes
my @eocrv;
my $eocr = $attreocr &&
( @eocrv = grep { my $l = $_; $l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef} @a);
# check if threshold is given
my $eocrExists = $eocr;
if( $eocr
&& $eocrv[0] =~ m/.*:(.*)/ ) {
my $threshold = $1;
if($valueText =~ m/([\d\.\-eE]+)/ && looks_like_number($1)) { #41083, #62190
my $mv = $1;
my $last_value = $hash->{".attreocr-threshold$reading"};
if( !defined($last_value) ) {
$h->{".attreocr-threshold$reading"} = $mv;
} elsif( abs($mv - $last_value) < $threshold ) {
$eocr = 0;
} else {
$h->{".attreocr-threshold$reading"} = $mv;
}
}
}
my $changed = !($attreocr)
|| ($eocr && ($valueText ne ReadingsVal($h->{NAME},$reading,"")));
my $attrminint = AttrVal($h->{NAME}, "event-min-interval", undef);
my @aa;
if($attrminint) {
@aa = split(/,/,$attrminint);
}
my @v = grep { my $l = $_;
$l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef
} @aa;
if(@v) {
my (undef, $minInt) = split(":", $v[0]);
my $le = $h->{".lastTime$reading"};
if($le && $now-$le < $minInt) {
if(!$eocr || ($eocr && $valueText eq ReadingsVal($h->{NAME},$reading,""))){
$changed = 0;
#} else {
# $hash->{".lastTime$reading"} = $now;
}
} else {
#$hash->{".lastTime$reading"} = $now;
$changed = 1 if($eocrExists);
}
}
if ($changed == 1) {
main::readingsSingleUpdate( $h, $reading, $valueText, 1 );
}
}
# }

View File

@ -391,6 +391,8 @@ sub S7_DWrite_setABit($$) {
if ( int(@clientList) > 0 ) {
my @Writebuffer = unpack( "C" x $length,
pack( "H2" x $length, split( ",", $hexbuffer ) ) );
my $now = gettimeofday();
foreach my $clientName (@clientList) {
my $h = $defs{$clientName};
@ -409,18 +411,91 @@ sub S7_DWrite_setABit($$) {
Log3 $name, 5, "$name S7_DWrite_Parse update $clientName ";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
main::readingsSingleUpdate( $h, "state", "on", 1 );
# if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
# main::readingsSingleUpdate( $h, "state", "on", 1 );
# }
# else {
# main::readingsSingleUpdate( $h, "state", "off", 1 );
# }
my $valueText = "";
my $reading="state";
if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) {
$valueText = "on";
}
else {
main::readingsSingleUpdate( $h, "state", "off", 1 );
$valueText = "off";
}
}
# }
#check event-onchange-reading
#code wurde der datei fhem.pl funktion readingsBulkUpdate entnommen und adaptiert
my $attreocr= AttrVal($h->{NAME}, "event-on-change-reading", undef);
my @a;
if($attreocr) {
@a = split(/,/,$attreocr);
$hash->{".attreocr"} = \@a;
}
# determine whether the reading is listed in any of the attributes
my @eocrv;
my $eocr = $attreocr &&
( @eocrv = grep { my $l = $_; $l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef} @a);
# check if threshold is given
my $eocrExists = $eocr;
if( $eocr
&& $eocrv[0] =~ m/.*:(.*)/ ) {
my $threshold = $1;
if($valueText =~ m/([\d\.\-eE]+)/ && looks_like_number($1)) { #41083, #62190
my $mv = $1;
my $last_value = $hash->{".attreocr-threshold$reading"};
if( !defined($last_value) ) {
$h->{".attreocr-threshold$reading"} = $mv;
} elsif( abs($mv - $last_value) < $threshold ) {
$eocr = 0;
} else {
$h->{".attreocr-threshold$reading"} = $mv;
}
}
}
my $changed = !($attreocr)
|| ($eocr && ($valueText ne ReadingsVal($h->{NAME},$reading,"")));
my $attrminint = AttrVal($h->{NAME}, "event-min-interval", undef);
my @aa;
if($attrminint) {
@aa = split(/,/,$attrminint);
}
my @v = grep { my $l = $_;
$l =~ s/:.*//;
($reading=~ m/^$l$/) ? $_ : undef
} @aa;
if(@v) {
my (undef, $minInt) = split(":", $v[0]);
my $le = $h->{".lastTime$reading"};
if($le && $now-$le < $minInt) {
if(!$eocr || ($eocr && $valueText eq ReadingsVal($h->{NAME},$reading,""))){
$changed = 0;
#} else {
# $hash->{".lastTime$reading"} = $now;
}
} else {
#$hash->{".lastTime$reading"} = $now;
$changed = 1 if($eocrExists);
}
}
if ($changed == 1) {
main::readingsSingleUpdate( $h, $reading, $valueText, 1 );
}
}
}
}
else {