FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-19 00:26:03 +00:00
Code Issues Releases Wiki Activity

98_Modbus.pm: small bug fixes

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@15871 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2018-01-13 16:24:22 +00:00
parent 8ef3270208
commit 23cab6e7ff
1 changed files with 22 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
fhem/FHEM/98_Modbus.pm
View File

@ -111,7 +111,11 @@
# 2017-07-18 started implementing data types (3.6.0) # 2017-07-18 started implementing data types (3.6.0)
# 2017-07-25 set saveAsModule # 2017-07-25 set saveAsModule
# 2017-08-17 nicer logging of timeouts # 2017-08-17 nicer logging of timeouts
# # 2017-09-17 extended check for missing len attribute with unpack that expects > 16 bits
# in _send
# 2017-12-06 little fixes
# 2017-12-22 remember timeout time in $hash instead of reading it from intAt
# 2018-01-11 fix bug where defptr pointed to ioHash instead of logical hash when seting IODev Attr
# #
# ToDo / Ideas : # ToDo / Ideas :
# get reading key (type / adr) # get reading key (type / adr)
@ -171,7 +175,7 @@ sub ModbusLD_GetUpdate($);
sub ModbusLD_GetIOHash($); sub ModbusLD_GetIOHash($);
sub ModbusLD_Send($$$;$$$); sub ModbusLD_Send($$$;$$$);
my $Modbus_Version = '3.7.0 - 20.8.2017'; my $Modbus_Version = '3.7.3 - 22.12.2017';
my $Modbus_PhysAttrs = my $Modbus_PhysAttrs =
"queueDelay " . "queueDelay " .
"busDelay " . "busDelay " .
@ -296,6 +300,7 @@ sub Modbus_Undef($$)
DevIo_CloseDev($ioHash); DevIo_CloseDev($ioHash);
RemoveInternalTimer ("timeout:$name"); RemoveInternalTimer ("timeout:$name");
RemoveInternalTimer ("queue:$name"); RemoveInternalTimer ("queue:$name");
delete $ioHash->{nextTimeout};
# lösche auch die Verweise aus logischen Modulen auf dieses physische. # lösche auch die Verweise aus logischen Modulen auf dieses physische.
foreach my $d (values %{$ioHash->{defptr}}) { foreach my $d (values %{$ioHash->{defptr}}) {
Log3 $name, 3, "$name: Undef is removing IO device for $d->{NAME}"; Log3 $name, 3, "$name: Undef is removing IO device for $d->{NAME}";
@ -801,7 +806,6 @@ sub Modbus_ParseFrames($)
use bytes; use bytes;
if ($proto eq "RTU") { if ($proto eq "RTU") {
if (AttrVal($name, "skipGarbage", 0)) { if (AttrVal($name, "skipGarbage", 0)) {
my $start = index($frame, pack('C', $reqId)); my $start = index($frame, pack('C', $reqId));
@ -860,8 +864,7 @@ sub Modbus_ParseFrames($)
($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame); ($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame);
Log3 $name, 5, "$name: ParseFrames: unpacked rest as tid=$tid, dlen=$dlen, id=$devAdr, pdu=" . unpack ('H*', $pdu); Log3 $name, 5, "$name: ParseFrames: unpacked rest as tid=$tid, dlen=$dlen, id=$devAdr, pdu=" . unpack ('H*', $pdu);
if ($ioHash->{REQUEST}{TID} != $tid) { if ($ioHash->{REQUEST}{TID} != $tid) {
$frame = substr($frame, $dlen + 6); return ("got wrong tid ($tid)");
return ("got wrong tid ($tid)", undef);
} }
} }
if (length($pdu) + 1 < $dlen) { if (length($pdu) + 1 < $dlen) {
@ -953,7 +956,7 @@ sub Modbus_ParseFrames($)
Log3 $name, 4, "$name: ParseFrames got fcode $fCode from $devAdr" . Log3 $name, 4, "$name: ParseFrames got fcode $fCode from $devAdr" .
($proto eq "TCP" ? ", tid $tid" : "") . ($proto eq "TCP" ? ", tid $tid" : "") .
", values " . unpack ('H*', $values) . "HeaderLen $headerLen, ActualLen $actualLen" . ", values " . unpack ('H*', $values) . "HeaderLen $headerLen, ActualLen $actualLen" .
", request was for $type$parseAdr ($ioHash->{REQUEST}{READING})". ", request was for $type$adr ($ioHash->{REQUEST}{READING})".
", len $reqLen for module $logHash->{NAME}"; ", len $reqLen for module $logHash->{NAME}";
if ($fCode < 15) { if ($fCode < 15) {
# nothing to parse after reply to 15 / 16 # nothing to parse after reply to 15 / 16
@ -980,6 +983,7 @@ sub Modbus_EndBUSY($)
$hash->{helper}{buffer} = ""; $hash->{helper}{buffer} = "";
$hash->{BUSY} = 0; $hash->{BUSY} = 0;
delete $hash->{REQUEST}; delete $hash->{REQUEST};
delete $hash->{nextTimeout};
Modbus_Profiler($hash, "Idle"); Modbus_Profiler($hash, "Idle");
Modbus_Statistics($hash, "Timeouts", 0); # damit bei Bedarf das Reading gesetzt wird Modbus_Statistics($hash, "Timeouts", 0); # damit bei Bedarf das Reading gesetzt wird
RemoveInternalTimer ("timeout:$name"); RemoveInternalTimer ("timeout:$name");
@ -1165,7 +1169,7 @@ sub Modbus_TimeoutSend($)
($ioHash->{helper}{buffer} ? ", Buffer contains " . unpack ("H*", $ioHash->{helper}{buffer}) : ""); ($ioHash->{helper}{buffer} ? ", Buffer contains " . unpack ("H*", $ioHash->{helper}{buffer}) : "");
Modbus_Statistics($ioHash, "Timeouts", 1); Modbus_Statistics($ioHash, "Timeouts", 1);
Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig, remove internalTimer
Modbus_CountTimeouts ($ioHash); Modbus_CountTimeouts ($ioHash);
Modbus_HandleSendQueue ("direct:$name"); # verwaltet auch idle und busy time statistics variables Modbus_HandleSendQueue ("direct:$name"); # verwaltet auch idle und busy time statistics variables
return; return;
@ -1366,9 +1370,10 @@ sub Modbus_HandleSendQueue($;$)
Modbus_Statistics($ioHash, "Requests", 1); Modbus_Statistics($ioHash, "Requests", 1);
Modbus_Profiler($ioHash, "Wait"); Modbus_Profiler($ioHash, "Wait");
my $timeout = ModbusLD_DevInfo($logHash, "timing", "timeout", 2); my $timeout = ModbusLD_DevInfo($logHash, "timing", "timeout", 2);
my $toTime = $now+$timeout;
RemoveInternalTimer ("timeout:$name"); RemoveInternalTimer ("timeout:$name");
InternalTimer($now+$timeout, "Modbus_TimeoutSend", "timeout:$name", 0); InternalTimer($toTime, "Modbus_TimeoutSend", "timeout:$name", 0);
$ioHash->{nextTimeout} = $toTime;
shift(@{$queue}); # remove first element from queue shift(@{$queue}); # remove first element from queue
if(@{$queue} > 0) { # more items in queue -> schedule next handle if(@{$queue} > 0) { # more items in queue -> schedule next handle
@ -1669,7 +1674,7 @@ sub ModbusLD_Attr(@)
} elsif ($aName eq "IODev") { # defptr housekeeping } elsif ($aName eq "IODev") { # defptr housekeeping
my $ioHash = $defs{$aVal}; my $ioHash = $defs{$aVal};
if ($ioHash && $ioHash->{TYPE} eq "Modbus") { # gibt es den Geräte-Hash zum IODev Attribut? if ($ioHash && $ioHash->{TYPE} eq "Modbus") { # gibt es den Geräte-Hash zum IODev Attribut?
$ioHash->{defptr}{$hash->{MODBUSID}} = $ioHash; # register logical device $ioHash->{defptr}{$hash->{MODBUSID}} = $hash; # register logical device
Log3 $name, 5, "$name: Attr IODev - using $aVal"; Log3 $name, 5, "$name: Attr IODev - using $aVal";
} else { } else {
Log3 $name, 5, "$name: Attr IODev can't use $aVal - device does not exist (yet?) or is not a physical Modbus Device"; Log3 $name, 5, "$name: Attr IODev can't use $aVal - device does not exist (yet?) or is not a physical Modbus Device";
@ -2364,14 +2369,8 @@ sub ModbusLD_ReadAnswer($;$)
# get timeout. In case ReadAnswer is called after a delay # get timeout. In case ReadAnswer is called after a delay
# only wait for remaining time # only wait for remaining time
my $to = ModbusLD_DevInfo($hash, "timing", "timeout", 2); my $to = ModbusLD_DevInfo($hash, "timing", "timeout", 2);
my $arg = "timeout:$ioHash->{NAME}"; # key in internl Timer hash my $rest = ($ioHash->{nextTimeout} ? $ioHash->{nextTimeout} - $now : 0);
my $rest = $to;
# find internal timeout timer time and calculate remaining timeout
foreach my $a (keys %intAt) {
if($intAt{$a}{ARG} eq $arg) {
$rest = $intAt{$a}{TRIGGERTIME} - $now;
}
}
if ($rest <= 0) { if ($rest <= 0) {
Log3 $name, 5, "$name: ReadAnswer called but timeout already over" . Log3 $name, 5, "$name: ReadAnswer called but timeout already over" .
($reading ? " requested reading was $reading" : ""); ($reading ? " requested reading was $reading" : "");
@ -2705,8 +2704,8 @@ sub ModbusLD_Send($$$;$$$){
$reqLen = $objLen if (!$reqLen); # reqLen given as parameter (only for combined read requests from GetUpdate or scans) $reqLen = $objLen if (!$reqLen); # reqLen given as parameter (only for combined read requests from GetUpdate or scans)
my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n"); my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n");
if ($objLen < 2 && $unpack =~ 'f') { if ($objLen < 2 && $unpack =~ /lLIqQfFNVD/) {
Log3 $name, 3, "$name: _Send with unpack containing f but len is too small - please set obj-${objCombi}-Len!"; Log3 $name, 3, "$name: _Send with unpack $unpack but len seems too small - please set obj-${objCombi}-Len!";
} }
if ($qlen && AttrVal($ioName, "dropQueueDoubles", 0)) { if ($qlen && AttrVal($ioName, "dropQueueDoubles", 0)) {