98_Modbus.pm: little enhancements and fixes

git-svn-id: https://svn.fhem.de/fhem/trunk@14234 2b470e98-0d58-463d-a4d8-8e2adae1ed80

fhem/FHEM/98_Modbus.pm

@@ -101,6 +101,11 @@
 #               new attribute ignoreExpr
 #   2017-02-11  optimize logging
 #   2017-03-12  fix disable for logical attribues (disable ist in PhysAttrs ...) - introduce more global vars for attributes
+#   2017-04-15  added some debug logging and explicit return 0 in checkDelays
+#   2017-04-21  optimize call to _send in GetUpdate, new attribute nonPrioritizedSet
+#               remove unused variables for devInfo / parseInfo in ParseObj
+#   2017-05-08  better warning handler restore (see $oldSig)
+#
 #
 #
 #   ToDo / Ideas : 
@@ -108,6 +113,8 @@
 #                   get object-interpretations h123 -> Alle Variationen mit revregs und bswap und unpacks ...
 #                   nonblocking disable attr für xp
 #
+#					attr with a lits of set commands / requests to launch when polling (Helios support)
+#
 #                   passive listening to other modbus traffic (state machine, parse requests of others in special queue
 #
 #                   set definition with multiple requests as raw containig opt. readings / input
@@ -154,7 +161,7 @@ sub ModbusLD_GetUpdate($);
 sub ModbusLD_GetIOHash($);
 sub ModbusLD_Send($$$;$$$);
 
-my $Modbus_Version = '3.5.21 - 12.3.2017';
+my $Modbus_Version = '3.5.25 - 8.5.2017';
 my $Modbus_PhysAttrs = 
         "queueDelay " .
         "busDelay " .
@@ -173,6 +180,7 @@ my $Modbus_LogAttrs =
         "IODev " .                              # fhem.pl macht dann $hash->{IODev} = $defs{$ioname}
         "alignTime " .
         "enableControlSet:0,1 " .
+        "nonPrioritizedSet:0,1 " .
         "scanDelay ";
         
 my $Modbus_CommonAttrs = 
@@ -228,6 +236,7 @@ sub Modbus_Initialize($)
         $Modbus_PhysAttrs .
         $Modbus_CommonAttrs .
         $readingFnAttributes;
+    return;
 }
 
 
@@ -282,7 +291,7 @@ sub Modbus_Undef($$)
         delete $d->{IODev};
         RemoveInternalTimer ("update:$d->{NAME}");
     }
-    return undef;
+    return;
 }
 
 
@@ -471,10 +480,12 @@ sub Modbus_CheckEval($$$$$) {
     # context e.g. "ParseObj", eName e.g. "ignoreExpr for $reading"
     my $name = $hash->{NAME};
     my $result;
+    my $inCheckEval = 1;
+    my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT');
     Log3 $name, 5, "$name: $context evaluates $eName, val=$val, expr $expr";
     $SIG{__WARN__} = sub { Log3 $name, 3, "$name: $context warning evaluating $eName, val=$val, expr $expr: @_"; };
     $result = eval($expr);
-    $SIG{__WARN__} = 'DEFAULT';
+    $SIG{__WARN__} = $oldSig;
     if ($@) {
         Log3 $name, 3, "$name: $context error evaluating $eName, val=$val, expr=$expr: $@";
     } else {
@@ -494,9 +505,6 @@ sub Modbus_CheckEval($$$$$) {
 sub Modbus_ParseObj($$$;$$) {
     my ($logHash, $data, $objCombi, $quantity, $op) = @_;
     my $name      = $logHash->{NAME};
-    my $modHash   = $modules{$logHash->{TYPE}};
-    my $parseInfo = $modHash->{parseInfo};
-    my $devInfo   = $modHash->{deviceInfo};
     my $type      = substr($objCombi, 0, 1);
     my $startAdr  = substr($objCombi, 1);
     my $lastAdr   = ($quantity ? $startAdr + $quantity -1 : 0);
@@ -602,7 +610,7 @@ sub Modbus_ParseObj($$$;$$) {
                 }
             }
         } else {
-            Log3 $name, 5, "$name: ParseObj has no parseInfo for $key";
+            Log3 $name, 5, "$name: ParseObj has no information about parsing $key";
             $len = 1;
         }
         
@@ -626,6 +634,7 @@ sub Modbus_ParseObj($$$;$$) {
         Log3 $name, 5, "$name: ParseObj moves to next object, skip $len to $type$startAdr" if ($rest);
     }
     readingsEndUpdate($logHash, 1);
+    return;
 }
 
 
@@ -657,6 +666,7 @@ sub Modbus_Statistics($$$)
             $hash->{statistics}{sums}{$key} = $value;
         }
     }
+    return;
 }
 
 
@@ -735,6 +745,7 @@ sub Modbus_Profiler($$)
         $hash->{profiler}{start}{$key} = $now;
         $hash->{profiler}{lastKey}     = $key;
     }
+    return;
 }
 
     
@@ -922,6 +933,7 @@ sub Modbus_ParseFrames($)
         }
         return 1;
     }
+    return;
 }
 
 
@@ -940,6 +952,7 @@ sub Modbus_EndBUSY($)
     Modbus_Profiler($hash, "Idle"); 
     Modbus_Statistics($hash, "Timeouts", 0);    # damit bei Bedarf das Reading gesetzt wird
     RemoveInternalTimer ("timeout:$name");
+    return;
 }
 
 
@@ -971,6 +984,7 @@ sub Modbus_Read($)
         RemoveInternalTimer ("queue:$name"); 
         Modbus_HandleSendQueue ("direct:$name"); # don't wait for next regular handle queue slot
     }
+    return;
 }
 
 
@@ -1015,6 +1029,7 @@ sub Modbus_Open($;$)
 
     DevIo_OpenDev($hash, $reopen, 0, \&Modbus_OpenCB);
     delete $hash->{TIMEOUT};
+    return;
 }
 
 
@@ -1042,6 +1057,7 @@ sub Modbus_Ready($)
         my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
         return ($InBytes>0);    # tell fhem.pl to read when we return
     }
+    return;
 }
 
 
@@ -1098,6 +1114,7 @@ sub Modbus_CountTimeouts($)
             $hash->{TIMEOUTS} = 1;
         }
     }
+    return;
 }
 
 
@@ -1117,12 +1134,10 @@ sub Modbus_TimeoutSend($)
                 ($ioHash->{helper}{buffer} ? ", Buffer contains " . unpack ("H*", $ioHash->{helper}{buffer}) : "");
 
     Modbus_Statistics($ioHash, "Timeouts", 1);
-        
     Modbus_EndBUSY ($ioHash);       # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
-    
     Modbus_CountTimeouts ($ioHash);
-
     Modbus_HandleSendQueue ("direct:$name"); # verwaltet auch idle und busy time statistics variables  
+    return;
 };
 
 
@@ -1137,18 +1152,20 @@ sub Modbus_CheckDelay($$$$$$)
     my $t2   = $last + $delay;
     my $rest = $t2 - $now;
     
-    #Log3 $name, 5, "$name: handle queue check $title ($delay) for $devName: rest $rest";
+    Log3 $name, 5, "$name: handle queue check $title ($delay) for $devName: rest $rest";
     if ($rest > 0) {
         Modbus_Profiler($ioHash, "Delay");  
         if ($force) {
-            Log3 $name, 4, "$name: CheckDelay $title for $devName not over, sleep $rest forced";
+            Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, sleep $rest forced";
             sleep $rest if ($rest > 0 && $rest < $delay);
+            return 0;
         } else {
             InternalTimer($t2, "Modbus_HandleSendQueue", "queue:$name", 0);
-            Log3 $name, 4, "$name: CheckDelay $title for $devName not over, try again in $rest";
+            Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, try again in $rest";
             return 1;
         }
     }  
+    return 0;
 }
 
 
@@ -1252,6 +1269,7 @@ sub Modbus_HandleSendQueue($;$)
                 "sendDelay", ModbusLD_DevInfo($logHash, "timing", "sendDelay", 0.1),
                 $logHash->{helper}{lsend}));
     }
+    Log3 $name, 5, "$name: HandleSendQueue: finished delay checking, proceed with sending";       
     
     my $data;
     if ($fCode == 1 || $fCode == 2) {           # read coils / discrete inputs, pdu: StartAdr, Len (=number of coils)
@@ -1320,6 +1338,7 @@ sub Modbus_HandleSendQueue($;$)
     if(@{$queue} > 0) {         # more items in queue -> schedule next handle 
         InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0);
     }
+    return;
 }
 
 
@@ -1400,7 +1419,7 @@ sub ModbusLD_Initialize($ )
         "dev-timing-timeout " .
         "dev-timing-sendDelay " .
         "dev-timing-commDelay ";
-                
+    return;            
 }
 
 
@@ -1475,6 +1494,7 @@ sub ModbusLD_SetTimer($;$)
        $hash->{TRIGGERTIME}     = 0;
        $hash->{TRIGGERTIME_FMT} = "";
     }
+    return;
 }
 
 
@@ -1488,6 +1508,7 @@ sub Modbus_OpenCB($$)
     }
     delete $hash->{BUSY_OPENDEV};
     delete $hash->{TIMEOUTS} if ($hash->{FD});
+    return;
 }
 
 
@@ -1583,6 +1604,7 @@ sub ModbusLD_Attr(@)
 {
     my ($cmd,$name,$aName,$aVal) = @_;
     my $hash = $defs{$name};        # hash des logischen Devices
+    my $inCheckEval = 0;
 
     # todo: validate other attrs
     # e.g. unpack not allowed for coils / discrete inputs, len not for coils,
@@ -1611,7 +1633,7 @@ sub ModbusLD_Attr(@)
             $hash->{TimeAlign}    = fhemTimeLocal($alSec, $alMin, $alHr, $mday, $mon, $year);
             $hash->{TimeAlignFmt} = FmtDateTime($hash->{TimeAlign});
             ModbusLD_SetTimer($hash);     # change timer for alignment 
-        } elsif (" $Modbus_PhysAttrs " =~ / $aName[: ]/) {
+        } elsif (" $Modbus_PhysAttrs " =~ /\ $aName[: ]/) {
             if (!$hash->{DEST}) {
                 Log3 $name, 3, "$name: attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}";
                 return "attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}";
@@ -1669,7 +1691,7 @@ sub ModbusLD_Attr(@)
             ModbusLD_SetTimer($hash, 1);    # first Update in 1 second or aligned if interval is defined
         }
     }   
-    return undef;
+    return;
 }
 
 
@@ -1683,7 +1705,7 @@ sub ModbusLD_Undef($$)
     RemoveInternalTimer ("update:$name");
     RemoveInternalTimer ("timeout:$name");
     RemoveInternalTimer ("queue:$name"); 
-    return undef;
+    return;
 }
 
 
@@ -1742,6 +1764,7 @@ sub ModbusLD_UpdateGetSetList($)
     #Log3 $name, 5, "$name: UpdateSetList: setList=$hash->{'.setList'}";
     #Log3 $name, 5, "$name: UpdateSetList: getList=$hash->{'.getList'}";
     $hash->{".updateSetGet"} = 0;
+    return;
 }
 
 
@@ -1943,6 +1966,7 @@ sub ModbusLD_ScanObjects($) {
     }
     ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanobj', 0, 0, $hash->{scanOLen});
     InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0);
+    return;
 }
 
 
@@ -1987,6 +2011,7 @@ sub ModbusLD_ScanIds($) {
     }
     ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanid'.$hash->{scanId}, 0, 0, $hash->{scanOLen});
     InternalTimer($now+$scanDelay, "ModbusLD_ScanIds", "scan:$name", 0);
+    return;
 }
 
 
@@ -2134,21 +2159,28 @@ sub ModbusLD_Set($@)
     $packedVal = Modbus_RevRegs($hash, $packedVal, $len) if ($revRegs && $len > 1);
     $packedVal = Modbus_SwpRegs($hash, $packedVal, $len) if ($swpRegs);
     
+    if (AttrVal($name, "nonPrioritizedSet", 0)) {
+        ModbusLD_Send($hash, $objCombi, "write", $packedVal, 0);    # no force, just queue
+    } else {
         ModbusLD_Send($hash, $objCombi, "write", $packedVal, 1);   # add at beginning and force send / sleep if necessary
-    
         ($err, $result) = ModbusLD_ReadAnswer($hash, $setName);
         Modbus_EndBUSY ($ioHash);       # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
         return $err if ($err);
+    }
             
     if ($fCode == 15 || $fCode == 16) {
         # read after write
         Log3 $name, 5, "$name: Set: sending read after write";
         
+        if (AttrVal($name, "nonPrioritizedSet", 0)) {
+            ModbusLD_Send($hash, $objCombi, "read", 0, 0);      # no force, just queue
+        } else {
             ModbusLD_Send($hash, $objCombi, "read", 0, 1);      # add at beginning and force send / sleep if necessary
             ($err, $result) = ModbusLD_ReadAnswer($hash, $setName);
             Modbus_EndBUSY ($ioHash);       # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig
             return "$err (in read after write for FCode 16)" if ($err);          
         }
+    }
     return;     # no return code if no error 
 }
 
@@ -2376,8 +2408,13 @@ sub ModbusLD_GetUpdate($) {
     }
     Modbus_Profiler($ioHash, "Idle");       
     while (my ($objCombi, $span) = each %readList) {
-        ModbusLD_Send($hash, $objCombi, "read", 0, 0, $readList{$objCombi});    # readList contains length / span
+        # helios:
+        #                                    val force len
+        #ModbusLD_Send($hash, h100, "write", $adr, 0, $span);
+        #ModbusLD_Send($hash, h100, "read",  0,    0, 20);
+        ModbusLD_Send($hash, $objCombi, "read", 0, 0, $span);
     }
+    return;
 }
 
 
@@ -2489,7 +2526,7 @@ sub ModbusLD_Send($$$;$$$){
 
     Log3 $name, 4, "$name: Send called with $type$adr, objLen $objLen / reqLen " .
         ($reqLen ? $reqLen : "-") . " to id $devId, op $op, qlen $qlen" .
-        (defined($v1) && $op eq 'write' ? ", value hex " . unpack ('H*', $v1) : "");
+        ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : "");
     $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"); 
@@ -2529,10 +2566,13 @@ sub ModbusLD_Send($$$;$$$){
     }
     $request{FCODE} = $fCode;   # function code
     
-    Log3 $name, 4, "$name: Send queues fc $fCode to $devId" .
+    Log3 $name, 4, "$name: Send" .
+        ($force ? " adds " : " queues ") .
+        "fc $fCode to $devId" .
         ($proto eq "TCP" ? ", tid $tid" : "") . ", for $type$adr" .
-        ($reading ? " ($reading)" : "") . ", reqLen $reqLen" . ($force ? ", force" : "") .
+        ($reading ? " ($reading)" : "") . ", reqLen $reqLen" .
-        (defined($v1) && $op eq 'write' ? ", value hex " . unpack ('H*', $v1) : "");
+        ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : "") .
+        ($force ? " at beginning of queue for immediate sending" : "");
     
     if(!$qlen) {
         #Log3 $name, 5, "$name: Send is creating new queue";
@@ -2549,8 +2589,8 @@ sub ModbusLD_Send($$$;$$$){
             }
         }
     }
-
     Modbus_HandleSendQueue("direct:".$ioName, $force); # name is physical device
+    return;
 }   
 
 1;