98_Modbus.pm: smaller changes

git-svn-id: https://svn.fhem.de/fhem/trunk@19979 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2019-08-10 12:52:27 +00:00
parent 8e6b7b834e
commit f0895e86d0

View File

@ -133,19 +133,21 @@
# 2019-02-09 optimized logging in level 4/5 # 2019-02-09 optimized logging in level 4/5
# 2019-02-19 little bug fix (warning) # 2019-02-19 little bug fix (warning)
# 2019-04-05 add a require for DevIO also in LDInitialize to be on the safe side ... # 2019-04-05 add a require for DevIO also in LDInitialize to be on the safe side ...
# 2019-04-15 add ModbusReadingsFn to allow the manipulation of readings in a derived module, # 2019-04-15 add ModbusReadingsFn to allow the manipulation of readings in a derived module,
# allow parseInfo and deviceInfo in device hash with priority over module hash # allow parseInfo and deviceInfo in device hash with priority over module hash
# 2019-04-17 better logging # 2019-04-17 better logging
# 2019-05-11 convert multiple spaces, tabs or newlines in maps to just one blank
# 2019-06-01 fix bug where disabling tcp master results in mass log (Close, ready, close ...)
# #
# #
# #
# #
# ToDo / Ideas # ToDo / Ideas
# Allow parseInfo in device Hash with priority over Module Hash # Allow parseInfo in device Hash with priority over Module Hash
# Allow setting of a _Setup function in the ModbusXY initialize function to be called after init done and not disabled # Allow setting of a _Setup function in the ModbusXY initialize function to be called after init done and not disabled
# this can then modify the parseInfo Hash depending of a model variant or an offset # this can then modify the parseInfo Hash depending of a model variant or an offset
# maybe call whenever startUpdateTime is called as well and _setup has not been caled yet? # maybe call whenever startUpdateTime is called as well and _setup has not been caled yet?
# or do it depending on a certain object which is requested during normal getupdate? as expr? # or do it depending on a certain object which is requested during normal getupdate? as expr?
# #
# learn objects in passive mode # learn objects in passive mode
# #
@ -326,7 +328,7 @@ sub ModbusLD_GetIOHash($);
sub ModbusLD_DoRequest($$$;$$$$); sub ModbusLD_DoRequest($$$;$$$$);
sub ModbusLD_StartUpdateTimer($); sub ModbusLD_StartUpdateTimer($);
my $Modbus_Version = '4.1.2 - 17.4.2019'; my $Modbus_Version = '4.1.4 - 1.6.2019';
my $Modbus_PhysAttrs = my $Modbus_PhysAttrs =
"queueDelay " . "queueDelay " .
"queueMax " . "queueMax " .
@ -840,6 +842,7 @@ sub ModbusLD_Attr(@)
} }
} }
$hash->{".updateSetGet"} = 1; $hash->{".updateSetGet"} = 1;
Log3 $name, 5, "$name: attr change set updateGetSetList to 1";
if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN) if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN)
# disable on a logical device (not physical here!) # disable on a logical device (not physical here!)
@ -883,8 +886,8 @@ sub ModbusLD_UpdateGetSetList($)
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $modHash = $modules{$hash->{TYPE}}; my $modHash = $modules{$hash->{TYPE}};
my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo}); my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo});
my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo}); my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo});
if (AttrVal($name, "enableControlSet", 1)) { # spezielle Sets freigeschaltet (since 4.0 1 by default) if (AttrVal($name, "enableControlSet", 1)) { # spezielle Sets freigeschaltet (since 4.0 1 by default)
if ($hash->{MODE} && $hash->{MODE} eq 'master') { if ($hash->{MODE} && $hash->{MODE} eq 'master') {
@ -935,8 +938,8 @@ sub ModbusLD_UpdateGetSetList($)
} }
} }
} }
#Log3 $name, 5, "$name: UpdateSetList: setList=$hash->{'.setList'}"; Log3 $name, 5, "$name: UpdateSetList: setList=$hash->{'.setList'}";
#Log3 $name, 5, "$name: UpdateSetList: getList=$hash->{'.getList'}"; Log3 $name, 5, "$name: UpdateSetList: getList=$hash->{'.getList'}";
$hash->{".updateSetGet"} = 0; $hash->{".updateSetGet"} = 0;
return; return;
} }
@ -1647,8 +1650,8 @@ sub Modbus_Close($;$$)
} }
Log3 $name, 5, "$name: Close called from " . Modbus_Caller() . Log3 $name, 5, "$name: Close called from " . Modbus_Caller() .
($noState || $noDelete ? " with " : "") . ($noState ? "noState" : "") . ($noState || $noDelete ? " with " : "") . ($noState ? "noState" : "") . # set state?
($noState && $noDelete ? " and " : "") . ($noDelete ? "noDelete" : ""); ($noState && $noDelete ? " and " : "") . ($noDelete ? "noDelete" : ""); # command delete on connection device?
delete $hash->{LASTOPEN}; # reset so next open will actually call OpenDev delete $hash->{LASTOPEN}; # reset so next open will actually call OpenDev
if ($hash->{TCPChild}) { if ($hash->{TCPChild}) {
@ -1676,8 +1679,9 @@ sub Modbus_Close($;$$)
delete $hash->{CONNECTHASH}; delete $hash->{CONNECTHASH};
Log3 $name, 4, "$name: Close deleted CONNECTHASH"; Log3 $name, 4, "$name: Close deleted CONNECTHASH";
} }
} elsif (DevIo_IsOpen($hash)) { } else {
Log3 $name, 4, "$name: Close connection with DevIo_CloseDev"; Log3 $name, 4, "$name: Close connection with DevIo_CloseDev";
# close even if it was not open yet but on ready list (need to remove entry from readylist)
DevIo_CloseDev($hash); DevIo_CloseDev($hash);
} }
@ -1706,7 +1710,7 @@ sub Modbus_Ready($)
if($hash->{STATE} eq "disconnected") { if($hash->{STATE} eq "disconnected") {
if (IsDisabled($name)) { if (IsDisabled($name)) {
Log3 $name, 3, "$name: ready called but $name is disabled - don't try to reconnect"; Log3 $name, 3, "$name: ready called but $name is disabled - don't try to reconnect - call Modbus_close";
Modbus_Close($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected Modbus_Close($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected
return; return;
} }
@ -1740,7 +1744,7 @@ sub Modbus_HandleServerConnection($)
$chash->{PROTOCOL} = $hash->{PROTOCOL}; $chash->{PROTOCOL} = $hash->{PROTOCOL};
$chash->{MODE} = $hash->{MODE}; $chash->{MODE} = $hash->{MODE};
$chash->{RELAY} = $hash->{RELAY}; $chash->{RELAY} = $hash->{RELAY};
$chash->{CHILDOF} = $hash; # point to parent device to get object definitions from there $chash->{CHILDOF} = $hash; # point to parent device to get object definitions from there
$chash->{IODev} = $chash; $chash->{IODev} = $chash;
$chash->{TCPConn} = 1; $chash->{TCPConn} = 1;
$chash->{TCPChild} = 1; $chash->{TCPChild} = 1;
@ -2467,14 +2471,14 @@ sub ModbusLD_ParseObj($$) {
} }
} }
if (!$outOfBounds) { if (!$outOfBounds) {
if (!Modbus_TryCall($logHash, 'ModbusReadingsFn', $reading, $val)) { if (!Modbus_TryCall($logHash, 'ModbusReadingsFn', $reading, $val)) {
Log3 $name, 4, "$name: ParseObj assigns value $val to reading $rname of device $device"; Log3 $name, 4, "$name: ParseObj assigns value $val to reading $rname of device $device";
if ($dev eq $logHash) { if ($dev eq $logHash) {
readingsBulkUpdate($dev, $rname, $val); # assign value to one of this devices readings readingsBulkUpdate($dev, $rname, $val); # assign value to one of this devices readings
} else { } else {
readingsSingleUpdate($dev, $rname, $val, 1); # assign value to reading - another Fhem device readingsSingleUpdate($dev, $rname, $val, 1); # assign value to reading - another Fhem device
} }
} }
$logHash->{gotReadings}{$reading} = $val; $logHash->{gotReadings}{$reading} = $val;
} else { } else {
Log3 $name, 4, "$name: ParseObj ignores value $val because it is out of bounds ($setmin / $setmax) for reading $rname of device $device"; Log3 $name, 4, "$name: ParseObj ignores value $val because it is out of bounds ($setmin / $setmax) for reading $rname of device $device";
@ -2487,10 +2491,10 @@ sub ModbusLD_ParseObj($$) {
$dataPtr->{ERRCODE} = $code if ($code); $dataPtr->{ERRCODE} = $code if ($code);
} }
} else { } else {
if (!Modbus_TryCall($logHash, 'ModbusReadingsFn', $reading, $val)) { if (!Modbus_TryCall($logHash, 'ModbusReadingsFn', $reading, $val)) {
Log3 $name, 4, "$name: ParseObj assigns value $val to $reading"; Log3 $name, 4, "$name: ParseObj assigns value $val to $reading";
readingsBulkUpdate($logHash, $reading, $val); readingsBulkUpdate($logHash, $reading, $val);
} }
$logHash->{gotReadings}{$reading} = $val; $logHash->{gotReadings}{$reading} = $val;
$logHash->{lastRead}{$key} = gettimeofday(); # used for pollDelay checking by getUpdate (mode master) $logHash->{lastRead}{$key} = gettimeofday(); # used for pollDelay checking by getUpdate (mode master)
} }
@ -3721,8 +3725,8 @@ sub ModbusLD_GetUpdate($) {
my $hash = $defs{$name}; # logisches Device, da GetUpdate aus dem logischen Modul per Timer gestartet wird my $hash = $defs{$name}; # logisches Device, da GetUpdate aus dem logischen Modul per Timer gestartet wird
my $modHash = $modules{$hash->{TYPE}}; my $modHash = $modules{$hash->{TYPE}};
my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo}); my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo});
my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo}); my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo});
my $now = gettimeofday(); my $now = gettimeofday();
@ -4726,7 +4730,7 @@ sub Modbus_ObjInfo($$$;$$) {
return $attr{$name}{$dadName} return $attr{$name}{$dadName}
if (defined($attr{$name}{$dadName})); if (defined($attr{$name}{$dadName}));
} }
my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo}); my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo});
return $devInfo->{$type}{$defName} return $devInfo->{$type}{$defName}
if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$defName})); if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$defName}));
} }
@ -4743,7 +4747,7 @@ sub Modbus_DevInfo($$$;$) {
$hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn $hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $modHash = $modules{$hash->{TYPE}}; my $modHash = $modules{$hash->{TYPE}};
my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo}); my $devInfo = ($hash->{deviceInfo} ? $hash->{deviceInfo} : $modHash->{deviceInfo});
my $aName = "dev-".$type."-".$oName; my $aName = "dev-".$type."-".$oName;
my $adName = "dev-".$oName; my $adName = "dev-".$oName;
@ -4774,7 +4778,7 @@ sub Modbus_ObjKey($$) {
$hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn $hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $modHash = $modules{$hash->{TYPE}}; my $modHash = $modules{$hash->{TYPE}};
my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo}); my $parseInfo = ($hash->{parseInfo} ? $hash->{parseInfo} : $modHash->{parseInfo});
foreach my $a (keys %{$attr{$name}}) { foreach my $a (keys %{$attr{$name}}) {
if ($a =~ /obj-([cdih][0-9]+)-reading/ && $attr{$name}{$a} eq $reading) { if ($a =~ /obj-([cdih][0-9]+)-reading/ && $attr{$name}{$a} eq $reading) {
@ -4819,20 +4823,20 @@ sub Modbus_TryCall($$$$)
{ {
my ($hash, $fName, $reading, $val) = @_; my ($hash, $fName, $reading, $val) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $modHash = $modules{$hash->{TYPE}}; my $modHash = $modules{$hash->{TYPE}};
if ($modHash->{$fName}) { if ($modHash->{$fName}) {
my $func = $modHash->{$fName}; my $func = $modHash->{$fName};
Log3 $name, 5, "$name: " . Modbus_Caller() . " is calling $fName via TrCall for reading $reading and val $val"; Log3 $name, 5, "$name: " . Modbus_Caller() . " is calling $fName via TrCall for reading $reading and val $val";
no strict "refs"; no strict "refs";
my $ret = eval { &{$func}($hash,$reading,$val) }; my $ret = eval { &{$func}($hash,$reading,$val) };
if( $@ ) { if( $@ ) {
Log3 $name, 3, "$name: " . Modbus_Caller() . " error calling $fName: $@"; Log3 $name, 3, "$name: " . Modbus_Caller() . " error calling $fName: $@";
return; return;
} }
use strict "refs"; use strict "refs";
return $ret return $ret
} }
return; return;
} }
@ -4955,7 +4959,7 @@ sub Modbus_Caller()
{ {
my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller 2; my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller 2;
return $1 if ($subroutine =~ /main::Modbus_(.*)/); return $1 if ($subroutine =~ /main::Modbus_(.*)/);
return $1 if ($subroutine =~ /main::ModbusLD_(.*)/); return $1 if ($subroutine =~ /main::ModbusLD_(.*)/);
return $1 if ($subroutine =~ /main::(.*)/); return $1 if ($subroutine =~ /main::(.*)/);
return "$subroutine"; return "$subroutine";
@ -4971,6 +4975,8 @@ sub Modbus_MapConvert($$$;$)
my ($hash, $map, $val, $reverse) = @_; my ($hash, $map, $val, $reverse) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
$map =~ s/\s+/ /g; # substitute all \t \n etc. by one space only
if ($reverse) { if ($reverse) {
$map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map $map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map
} }
@ -4999,8 +5005,8 @@ sub Modbus_MapToHint($)
{ {
my ($map) = @_; my ($map) = @_;
my $hint = $map; # create hint from map my $hint = $map; # create hint from map
$hint =~ s/\s+/ /g; # convert spaces for fhemweb
$hint =~ s/([^,\$]+):([^,\$]+)(,?) */$2$3/g; # allow spaces in names $hint =~ s/([^,\$]+):([^,\$]+)(,?) */$2$3/g; # allow spaces in names
$hint =~ s/\s/ /g; # convert spaces for fhemweb
return $hint; return $hint;
} }