Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

Timing Enhancement:HMLAN delay estimation and display, CUL_HM performance improvement

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@3280 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876 2013-06-13 17:46:20 +00:00
parent 7fcaca072f
commit aea8c3157a
2 changed files with 204 additions and 174 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
FHEM/00_HMLAN.pm
View File

@ -4,13 +4,13 @@ package main;
use strict; use strict;
use warnings; use warnings;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday time);
sub HMLAN_Parse($$); sub HMLAN_Parse($$);
sub HMLAN_Read($); sub HMLAN_Read($);
sub HMLAN_Write($$$); sub HMLAN_Write($$$);
sub HMLAN_ReadAnswer($$$); sub HMLAN_ReadAnswer($$$);
sub HMLAN_uptime($$); sub HMLAN_uptime($@);
sub HMLAN_secSince2000(); sub HMLAN_secSince2000();
sub HMLAN_SimpleWrite(@); sub HMLAN_SimpleWrite(@);
@ -159,7 +159,8 @@ sub HMLAN_ReadAnswer($$$) {# This is a direct read for commands like get
if($mdata =~ m/\r\n/) { if($mdata =~ m/\r\n/) {
if($regexp && $mdata !~ m/$regexp/) { if($regexp && $mdata !~ m/$regexp/) {
HMLAN_Parse($hash, $mdata); HMLAN_Parse($hash, $mdata);
} else { }
else {
return (undef, $mdata); return (undef, $mdata);
} }
} }
@ -230,37 +231,35 @@ sub HMLAN_Read($) {############################################################
} }
$hash->{PARTIAL} = $hmdata; $hash->{PARTIAL} = $hmdata;
} }
sub HMLAN_uptime($$) {######################################################### sub HMLAN_uptime($@) {#########################################################
my ($hash,$msec) = @_; my ($hmtC,$hash) = @_; # hmTime Current
$msec = hex($msec); $hmtC = hex($hmtC);
my $sec = int($msec/1000);
# my ($sysec, $syusec) = gettimeofday(); if ($hash && $hash->{helper}{ref}){ #will calculate new ref-time
# my $symsec = int($sysec*1000+$syusec/1000); my $ref = $hash->{helper}{ref};#shortcut
# if ($hash->{helper}{refTime} == 1){ #init referenceTime my $sysC = int(time()*1000); #current systime in ms
# $hash->{helper}{refTime} = 2; my $offC = $sysC - $hmtC; #offset calc between time and HM-stamp
# $hash->{helper}{refTimeS} = $symsec; if ($ref->{hmtL} && ($hmtC > $ref->{hmtL})){
# $hash->{helper}{refTStmp} = $msec; if (($sysC - $ref->{kTs})<20){ #if delay is more then 20ms, we dont trust
# $hash->{helper}{msgdly} = $hash->{helper}{msgdlymin} = $hash->{helper}{msgdlymax} = 0; if ($ref->{sysL}){
# } $ref->{drft} = ($offC - $ref->{offL})/($sysC - $ref->{sysL});
# elsif ($hash->{helper}{refTime} == 0){ #init referenceTime }
# $hash->{helper}{refTime} = 1; $ref->{sysL} = $sysC;
# } $ref->{offL} = $offC;
# else{ }
# my $dly = ($symsec - $hash->{helper}{refTimeS} ) - }
# ($msec - $hash->{helper}{refTStmp}); else{# hm had a skip in time, start over calculation
# $hash->{helper}{msgdly} = $dly; delete $hash->{helper}{ref};
# $hash->{helper}{msgdlymin} = $dly }
# if (!$hash->{helper}{msgdlymin} || $hash->{helper}{msgdlymin} > $dly); $hash->{helper}{ref}{hmtL} = $hmtC;
# $hash->{helper}{msgdlymax} = $dly $hash->{helper}{ref}{kTs} = 0;
# if (!$hash->{helper}{msgdlymax} || $hash->{helper}{msgdlymax} < $dly); }
# readingsSingleUpdate($hash,"msgDly","last:".$hash->{helper}{msgdly}
# ." min:".$hash->{helper}{msgdlymin} my $sec = int($hmtC/1000);
# ." max:".$hash->{helper}{msgdlymax},0);
# }
return sprintf("%03d %02d:%02d:%02d.%03d", return sprintf("%03d %02d:%02d:%02d.%03d",
int($msec/86400000), int($sec/3600), int($hmtC/86400000), int($sec/3600),
int(($sec%3600)/60), $sec%60, $msec % 1000); int(($sec%3600)/60), $sec%60, $hmtC % 1000);
} }
sub HMLAN_Parse($$) {########################################################## sub HMLAN_Parse($$) {##########################################################
my ($hash, $rmsg) = @_; my ($hash, $rmsg) = @_;
@ -324,16 +323,36 @@ sub HMLAN_Parse($$) {##########################################################
Log $ll5, "HMLAN_Parse: $name special reply ".$mFld[1] if($stat & 0x0200); Log $ll5, "HMLAN_Parse: $name special reply ".$mFld[1] if($stat & 0x0200);
#update some User information ------ #update some User information ------
$hash->{uptime} = HMLAN_uptime($hash,$mFld[2]); $hash->{uptime} = HMLAN_uptime($mFld[2]);
$hash->{RSSI} = $rssi; $hash->{RSSI} = $rssi;
$hash->{RAWMSG} = $rmsg; $hash->{RAWMSG} = $rmsg;
$hash->{"${name}_MSGCNT"}++; $hash->{"${name}_MSGCNT"}++;
$hash->{"${name}_TIME"} = TimeNow(); $hash->{"${name}_TIME"} = TimeNow();
my $dly = 0;
if ($hash->{helper}{ref} && $hash->{helper}{ref}{drft}){
my $ref = $hash->{helper}{ref};#shortcut
my $sysC = int(time()*1000); #current systime in ms
$dly = int($sysC - (hex($mFld[2]) + $ref->{offL} + $ref->{drft}*($sysC - $ref->{sysL})));
$hash->{helper}{dly}{lst} = $dly;
my $dlyP = $hash->{helper}{dly};
$dlyP->{min} = $dly if (!$dlyP->{min} || $dlyP->{min}>$dly);
$dlyP->{max} = $dly if (!$dlyP->{max} || $dlyP->{max}<$dly);
if ($dlyP->{cnt}) {$dlyP->{cnt}++} else {$dlyP->{cnt} = 1} ;
$hash->{msgParseDly} = "min:" .$dlyP->{min}
." max:" .$dlyP->{max}
." last:".$dlyP->{lst}
." cnt:" .$dlyP->{cnt};
$dly = 0 if ($dly<0);
}
# HMLAN sends ACK for flag 'A0' but not for 'A4'(config mode)- # HMLAN sends ACK for flag 'A0' but not for 'A4'(config mode)-
# we ack ourself an long as logic is uncertain - also possible is 'A6' for RHS # we ack ourself an long as logic is uncertain - also possible is 'A6' for RHS
if (hex($flg)&0x4){#not sure: 4 oder 2 ? if (hex($flg)&0x4){#not sure: 4 oder 2 ?
$hash->{helper}{nextSend}{$src} = gettimeofday() + 0.100; my $wait = 0.100 - $dly/1000;
$hash->{helper}{nextSend}{$src} = gettimeofday() + $wait if ($wait > 0);
} }
if (hex($flg)&0xA4 == 0xA4 && $hash->{owner} eq $dst){ if (hex($flg)&0xA4 == 0xA4 && $hash->{owner} eq $dst){
Log $ll5, "HMLAN_Parse: $name ACK config"; Log $ll5, "HMLAN_Parse: $name ACK config";
@ -360,8 +379,8 @@ sub HMLAN_Parse($$) {##########################################################
$hash->{serialNr} = $mFld[2]; $hash->{serialNr} = $mFld[2];
$hash->{firmware} = sprintf("%d.%d", (hex($mFld[1])>>12)&0xf, hex($mFld[1]) & 0xffff); $hash->{firmware} = sprintf("%d.%d", (hex($mFld[1])>>12)&0xf, hex($mFld[1]) & 0xffff);
$hash->{owner} = $mFld[4]; $hash->{owner} = $mFld[4];
$hash->{uptime} = HMLAN_uptime($hash,$mFld[5]); $hash->{uptime} = HMLAN_uptime($mFld[5],$hash);
$hash->{assignIDsReport}=$mFld[6]; $hash->{assignIDsReport}=hex($mFld[6]);
$hash->{helper}{keepAliveRec} = 1; $hash->{helper}{keepAliveRec} = 1;
$hash->{helper}{keepAliveRpt} = 0; $hash->{helper}{keepAliveRpt} = 0;
Log $ll5, 'HMLAN_Parse: '.$name. ' V:'.$mFld[1] Log $ll5, 'HMLAN_Parse: '.$name. ' V:'.$mFld[1]
@ -460,7 +479,7 @@ sub HMLAN_DoInit($) {##########################################################
HMLAN_SimpleWrite($hash, "Y03,00,"); HMLAN_SimpleWrite($hash, "Y03,00,");
HMLAN_SimpleWrite($hash, "Y03,00,"); HMLAN_SimpleWrite($hash, "Y03,00,");
HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000"); HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000");
$hash->{helper}{refTime}=0; delete $hash->{helper}{ref};
foreach (keys %lhash){delete ($lhash{$_})};# clear IDs - HMLAN might have a reset foreach (keys %lhash){delete ($lhash{$_})};# clear IDs - HMLAN might have a reset
$hash->{helper}{keepAliveRec} = 1; # ok for first time $hash->{helper}{keepAliveRec} = 1; # ok for first time
@ -478,6 +497,7 @@ sub HMLAN_KeepAlive($) {#######################################################
return if(!$hash->{FD}); return if(!$hash->{FD});
HMLAN_SimpleWrite($hash, "K"); HMLAN_SimpleWrite($hash, "K");
$hash->{helper}{ref}{kTs} = int(time()*1000);
RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer
my $rt = AttrVal($name,"respTime",1); my $rt = AttrVal($name,"respTime",1);
InternalTimer(gettimeofday()+$rt,"HMLAN_KeepAliveCheck","keepAliveCk:".$name,1); InternalTimer(gettimeofday()+$rt,"HMLAN_KeepAliveCheck","keepAliveCk:".$name,1);

264
FHEM/10_CUL_HM.pm
View File

@ -112,8 +112,7 @@ sub CUL_HM_Initialize($) {
sub CUL_HM_reqStatus($){ sub CUL_HM_reqStatus($){
while(@{$modules{CUL_HM}{helper}{reqStatus}}){ while(@{$modules{CUL_HM}{helper}{reqStatus}}){
my $name = shift(@{$modules{CUL_HM}{helper}{reqStatus}}); my $name = shift(@{$modules{CUL_HM}{helper}{reqStatus}});
my $hash = CUL_HM_name2Hash($name); CUL_HM_Set($defs{$name},$name,"statusRequest");
CUL_HM_Set($hash,$name,"statusRequest");
InternalTimer(gettimeofday()+4,"CUL_HM_reqStatus","CUL_HM_reqStatus",0); InternalTimer(gettimeofday()+4,"CUL_HM_reqStatus","CUL_HM_reqStatus",0);
last; last;
} }
@ -123,7 +122,7 @@ sub CUL_HM_autoReadConfig($){
# #
while(@{$modules{CUL_HM}{helper}{updtCfgLst}}){ while(@{$modules{CUL_HM}{helper}{updtCfgLst}}){
my $name = shift(@{$modules{CUL_HM}{helper}{updtCfgLst}}); my $name = shift(@{$modules{CUL_HM}{helper}{updtCfgLst}});
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
if (0 != CUL_HM_getAttrInt($name,"autoReadReg")){ if (0 != CUL_HM_getAttrInt($name,"autoReadReg")){
CUL_HM_Set($hash,$name,"getSerial"); CUL_HM_Set($hash,$name,"getSerial");
CUL_HM_Set($hash,$name,"getConfig"); CUL_HM_Set($hash,$name,"getConfig");
@ -142,8 +141,8 @@ sub CUL_HM_updateConfig($){
my @nameList = CUL_HM_noDup(@{$modules{CUL_HM}{helper}{updtCfgLst}}); my @nameList = CUL_HM_noDup(@{$modules{CUL_HM}{helper}{updtCfgLst}});
while(@nameList){ while(@nameList){
my $name = shift(@nameList); my $name = shift(@nameList);
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
my $id = CUL_HM_hash2Id($hash); my $id = $hash->{DEF};
my $chn = substr($id."00",6,2); my $chn = substr($id."00",6,2);
if ($id ne $K_actDetID){# if not action detector if ($id ne $K_actDetID){# if not action detector
@ -185,12 +184,12 @@ sub CUL_HM_updateConfig($){
my $chnPhy = int(($chn-$chnPhyMax+1)/2); # assotiated phy chan my $chnPhy = int(($chn-$chnPhyMax+1)/2); # assotiated phy chan
my $idPhy = $devId.sprintf("%02X",$chnPhy);# ID assot phy chan my $idPhy = $devId.sprintf("%02X",$chnPhy);# ID assot phy chan
my $pHash = CUL_HM_id2Hash($idPhy); # hash assot phy chan my $pHash = CUL_HM_id2Hash($idPhy); # hash assot phy chan
$idPhy = CUL_HM_hash2Id($pHash); # could be device!!! $idPhy = $pHash->{DEF}; # could be device!!!
if ($pHash){ if ($pHash){
$pHash->{helper}{vDim}{idPhy} = $idPhy; $pHash->{helper}{vDim}{idPhy} = $idPhy;
my $vHash = CUL_HM_id2Hash($devId.sprintf("%02X",$chnPhyMax+2*$chnPhy-1)); my $vHash = CUL_HM_id2Hash($devId.sprintf("%02X",$chnPhyMax+2*$chnPhy-1));
if ($vHash){ if ($vHash){
$pHash->{helper}{vDim}{idV2} = CUL_HM_hash2Id($vHash); $pHash->{helper}{vDim}{idV2} = $vHash->{DEF};
$vHash->{helper}{vDim}{idPhy} = $idPhy; $vHash->{helper}{vDim}{idPhy} = $idPhy;
} }
else{ else{
@ -198,7 +197,7 @@ sub CUL_HM_updateConfig($){
} }
$vHash = CUL_HM_id2Hash($devId.sprintf("%02X",$chnPhyMax+2*$chnPhy)); $vHash = CUL_HM_id2Hash($devId.sprintf("%02X",$chnPhyMax+2*$chnPhy));
if ($vHash){ if ($vHash){
$pHash->{helper}{vDim}{idV3} = CUL_HM_hash2Id($vHash); $pHash->{helper}{vDim}{idV3} = $vHash->{DEF};
$vHash->{helper}{vDim}{idPhy} = $idPhy; $vHash->{helper}{vDim}{idPhy} = $idPhy;
} }
else{ else{
@ -296,7 +295,7 @@ sub CUL_HM_Undef($$) {###############################
my $HMid = $hash->{DEF}; my $HMid = $hash->{DEF};
my $chn = substr($HMid,6,2); my $chn = substr($HMid,6,2);
if ($chn){# delete a channel if ($chn){# delete a channel
my $devHash = CUL_HM_name2Hash($devName); my $devHash = $defs{$devName};
delete $devHash->{"channel_$chn"} if ($devName); delete $devHash->{"channel_$chn"} if ($devName);
$devHash->{helper}{role}{chn}=1 if($chn eq "01");# return chan 01 role $devHash->{helper}{role}{chn}=1 if($chn eq "01");# return chan 01 role
} }
@ -312,16 +311,16 @@ sub CUL_HM_Undef($$) {###############################
sub CUL_HM_Rename($$$) {############################# sub CUL_HM_Rename($$$) {#############################
my ($name, $oldName) = @_; my ($name, $oldName) = @_;
my $HMid = CUL_HM_name2Id($name); my $HMid = CUL_HM_name2Id($name);
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
if (length($HMid) == 8){# we are channel, inform the device if (length($HMid) == 8){# we are channel, inform the device
$hash->{chanNo} = substr($HMid,6,2); $hash->{chanNo} = substr($HMid,6,2);
my $devHash = CUL_HM_id2Hash(substr($HMid,0,6)); my $devHash = CUL_HM_id2Hash(substr($HMid,0,6));
$hash->{device} = CUL_HM_hash2Name($devHash); $hash->{device} = $devHash->{NAME};
$devHash->{"channel_".$hash->{chanNo}} = $name; $devHash->{"channel_".$hash->{chanNo}} = $name;
} }
else{# we are a device - inform channels if exist else{# we are a device - inform channels if exist
foreach (grep {$_ =~m/^channel_/} keys%{$hash}){ foreach (grep {$_ =~m/^channel_/} keys%{$hash}){
my $chnHash = CUL_HM_name2Hash($hash->{$_}); my $chnHash = $defs{$hash->{$_}};
$chnHash->{device} = $name; $chnHash->{device} = $name;
} }
} }
@ -333,7 +332,7 @@ sub CUL_HM_Attr(@) {#################################
my $updtReq = 0; my $updtReq = 0;
if ($attrName eq "expert"){#[0,1,2] if ($attrName eq "expert"){#[0,1,2]
$attr{$name}{expert} = $attrVal; $attr{$name}{expert} = $attrVal;
my $eHash = CUL_HM_name2Hash($name); my $eHash = $defs{$name};
foreach my $chId (CUL_HM_getAssChnIds($name)){ foreach my $chId (CUL_HM_getAssChnIds($name)){
my $cHash = CUL_HM_id2Hash($chId); my $cHash = CUL_HM_id2Hash($chId);
push(@hashL,$cHash) if ($eHash ne $cHash); push(@hashL,$cHash) if ($eHash ne $cHash);
@ -407,7 +406,6 @@ sub CUL_HM_Parse($$) {##############################
my $id = CUL_HM_Id($iohash); my $id = CUL_HM_Id($iohash);
my $ioName = $iohash->{NAME}; my $ioName = $iohash->{NAME};
my ($msg,$msgStat,$myRSSI,$msgIO) = split(":",$msgIn,4); my ($msg,$msgStat,$myRSSI,$msgIO) = split(":",$msgIn,4);
# Msg format: Allnnffttssssssddddddpp... # Msg format: Allnnffttssssssddddddpp...
$msg =~ m/A(..)(..)(..)(..)(......)(......)(.*)/; $msg =~ m/A(..)(..)(..)(..)(......)(......)(.*)/;
my ($len,$mNo,$mFlg,$mTp,$src,$dst,$p) = ($1,$2,$3,$4,$5,$6,$7); my ($len,$mNo,$mFlg,$mTp,$src,$dst,$p) = ($1,$2,$3,$4,$5,$6,$7);
@ -464,7 +462,6 @@ sub CUL_HM_Parse($$) {##############################
CUL_HM_SndCmd(${$ack}[$i++],${$ack}[$i++]) while ($i<@{$ack}); CUL_HM_SndCmd(${$ack}[$i++],${$ack}[$i++]) while ($i<@{$ack});
$shash->{helper}{rpt}{ts} = gettimeofday(); $shash->{helper}{rpt}{ts} = gettimeofday();
Log GetLogLevel($name,4), "CUL_HM $name dup: repeat ack, dont process"; Log GetLogLevel($name,4), "CUL_HM $name dup: repeat ack, dont process";
Log 1,"General ############ duplicate";
} }
else{ else{
Log GetLogLevel($name,4), "CUL_HM $name dup: dont process"; Log GetLogLevel($name,4), "CUL_HM $name dup: dont process";
@ -850,6 +847,7 @@ sub CUL_HM_Parse($$) {##############################
push @event, "$eventName:up:$vs" if(($err&0x30) == 0x10); push @event, "$eventName:up:$vs" if(($err&0x30) == 0x10);
push @event, "$eventName:down:$vs" if(($err&0x30) == 0x20); push @event, "$eventName:down:$vs" if(($err&0x30) == 0x20);
push @event, "$eventName:stop:$vs" if(($err&0x30) == 0x00); push @event, "$eventName:stop:$vs" if(($err&0x30) == 0x00);
CUL_HM_qStateUpdatIfEnab($name) if(($err&0x30) != 0x00);
} }
if ($st eq "dimmer"){ if ($st eq "dimmer"){
push @event,"overload:".(($err&0x02)?"on":"off"); push @event,"overload:".(($err&0x02)?"on":"off");
@ -1073,7 +1071,7 @@ sub CUL_HM_Parse($$) {##############################
#--- check out teamstatus, members might be shy --- #--- check out teamstatus, members might be shy ---
my $peerList = ReadingsVal($name,"peerList",""); my $peerList = ReadingsVal($name,"peerList","");
foreach my $pNm (split(",",$peerList)){ foreach my $pNm (split(",",$peerList)){
CUL_HM_qStateUpdat($pNm)if ($pNm); CUL_HM_qStateUpdatIfEnab($pNm,1)if ($pNm);
} }
} }
elsif ($mTp eq "01"){ #Configs elsif ($mTp eq "01"){ #Configs
@ -1208,8 +1206,8 @@ sub CUL_HM_Parse($$) {##############################
my $dChNo = substr($dChId,6,2); my $dChNo = substr($dChId,6,2);
my $dChName = CUL_HM_id2Name($dChId); my $dChName = CUL_HM_id2Name($dChId);
if (AttrVal($dChName,"peerIDs","") =~m/$recId/){# is in peerlist? if(($attr{$dChName}{peerIDs}?$attr{$dChName}{peerIDs}:"") =~m/$recId/){
my $dChHash = CUL_HM_name2Hash($dChName); my $dChHash = $defs{$dChName};
$dChHash->{helper}{trgLgRpt} = 0 $dChHash->{helper}{trgLgRpt} = 0
if (!defined($dChHash->{helper}{trgLgRpt})); if (!defined($dChHash->{helper}{trgLgRpt}));
$dChHash->{helper}{trgLgRpt} +=1; $dChHash->{helper}{trgLgRpt} +=1;
@ -1281,6 +1279,7 @@ sub CUL_HM_Parse($$) {##############################
CUL_HM_SndCmd($ack[$i++],$ack[$i++])while ($i<@ack); CUL_HM_SndCmd($ack[$i++],$ack[$i++])while ($i<@ack);
Log GetLogLevel($name,6), "CUL_HM $name sent ACK:".(int(@ack)); Log GetLogLevel($name,6), "CUL_HM $name sent ACK:".(int(@ack));
} }
CUL_HM_ProcessCmdStack($shash) if ($respRemoved); # cont if complete CUL_HM_ProcessCmdStack($shash) if ($respRemoved); # cont if complete
#------------ process events ------------------ #------------ process events ------------------
push @event, "noReceiver:src:$src ".$mFlg.$mTp." $p" if(!@event); push @event, "noReceiver:src:$src ".$mFlg.$mTp." $p" if(!@event);
@ -1290,6 +1289,7 @@ sub CUL_HM_Parse($$) {##############################
foreach (CUL_HM_noDup(@entities)){ foreach (CUL_HM_noDup(@entities)){
DoTrigger($_, undef) if ($_ ne $name); DoTrigger($_, undef) if ($_ ne $name);
} }
return $name ;#general notification to the device return $name ;#general notification to the device
} }
sub CUL_HM_parseCommon(@){##################################################### sub CUL_HM_parseCommon(@){#####################################################
@ -1298,7 +1298,7 @@ sub CUL_HM_parseCommon(@){#####################################################
my $shash = $modules{CUL_HM}{defptr}{$src}; my $shash = $modules{CUL_HM}{defptr}{$src};
my $dhash = $modules{CUL_HM}{defptr}{$dst}; my $dhash = $modules{CUL_HM}{defptr}{$dst};
return "" if(!$shash->{DEF});# this should be from ourself return "" if(!$shash->{DEF});# this should be from ourself
my $ret = "";
my $pendType = $shash->{helper}{respWait}{Pending}? my $pendType = $shash->{helper}{respWait}{Pending}?
$shash->{helper}{respWait}{Pending}:""; $shash->{helper}{respWait}{Pending}:"";
#------------ parse message flag for start processing command Stack #------------ parse message flag for start processing command Stack
@ -1342,8 +1342,8 @@ sub CUL_HM_parseCommon(@){#####################################################
elsif($subType eq "01"){ #ACKinfo################# elsif($subType eq "01"){ #ACKinfo#################
$success = "yes"; $success = "yes";
my $rssi = substr($p,8,2);# --calculate RSSI my $rssi = substr($p,8,2);# --calculate RSSI
CUL_HM_storeRssi(CUL_HM_hash2Name($shash), CUL_HM_storeRssi($shash->{NAME},
($dhash?CUL_HM_hash2Name($dhash):$shash->{IODev}{NAME}), ($dhash?$dhash->{NAME}:$shash->{IODev}{NAME}),
(-1)*(hex($rssi))) (-1)*(hex($rssi)))
if ($rssi && $rssi ne '00' && $rssi ne'80'); if ($rssi && $rssi ne '00' && $rssi ne'80');
$reply = "ACKStatus"; $reply = "ACKStatus";
@ -1355,7 +1355,7 @@ sub CUL_HM_parseCommon(@){#####################################################
readingsSingleUpdate($chnhash,"CommandAccepted",$success,1); readingsSingleUpdate($chnhash,"CommandAccepted",$success,1);
CUL_HM_ProcessCmdStack($shash) CUL_HM_ProcessCmdStack($shash)
if($dhash->{DEF} && (CUL_HM_IOid($shash) eq $dhash->{DEF})); if($dhash->{DEF} && (CUL_HM_IOid($shash) eq $dhash->{DEF}));
return $reply; $ret = $reply;
} }
elsif($mTp eq "00"){###################################### elsif($mTp eq "00"){######################################
if ($pendType eq "PairSerial"){ if ($pendType eq "PairSerial"){
@ -1369,13 +1369,13 @@ sub CUL_HM_parseCommon(@){#####################################################
if(!$shash->{cmdStack} || !(CUL_HM_getRxType($shash) & 0x04)) { if(!$shash->{cmdStack} || !(CUL_HM_getRxType($shash) & 0x04)) {
CUL_HM_Pair($shash->{NAME}, $shash,$mFlg.$mTp,$src,$dst,$p); CUL_HM_Pair($shash->{NAME}, $shash,$mFlg.$mTp,$src,$dst,$p);
} }
return "done"; $ret = "done";
} }
elsif($mTp eq "10"){###################################### elsif($mTp eq "10"){######################################
my $subType = substr($p,0,2); my $subType = substr($p,0,2);
if($subType eq "00"){ #storePeerList################# if($subType eq "00"){ #storePeerList#################
$attr{$shash->{NAME}}{serialNr} = pack("H*",substr($p,2,20)); $attr{$shash->{NAME}}{serialNr} = pack("H*",substr($p,2,20));
return "done"; $ret = "done";
} }
elsif($subType eq "01"){ #storePeerList################# elsif($subType eq "01"){ #storePeerList#################
if ($pendType eq "PeerList"){ if ($pendType eq "PeerList"){
@ -1397,7 +1397,7 @@ sub CUL_HM_parseCommon(@){#####################################################
my $flag = CUL_HM_getFlag($shash); my $flag = CUL_HM_getFlag($shash);
my $id = CUL_HM_IOid($shash); my $id = CUL_HM_IOid($shash);
my $listNo = "0".$chnhash->{helper}{getCfgListNo}; my $listNo = "0".$chnhash->{helper}{getCfgListNo};
my @peerID = split(",", AttrVal($chnNname,"peerIDs","")); my @peerID = split(",",($attr{$chnNname}{peerIDs}?$attr{$chnNname}{peerIDs}:""));
foreach my $peer (@peerID){ foreach my $peer (@peerID){
next if ($peer eq '00000000');# ignore termination next if ($peer eq '00000000');# ignore termination
$peer .="01" if (length($peer) == 6); # add the default $peer .="01" if (length($peer) == 6); # add the default
@ -1413,7 +1413,7 @@ sub CUL_HM_parseCommon(@){#####################################################
else{ else{
CUL_HM_respPendToutProlong($shash);#wasn't last - reschedule timer CUL_HM_respPendToutProlong($shash);#wasn't last - reschedule timer
} }
return "done"; $ret = "done";
} }
} }
elsif($subType eq "02" ||$subType eq "03"){ #ParamResp================== elsif($subType eq "02" ||$subType eq "03"){ #ParamResp==================
@ -1443,6 +1443,7 @@ sub CUL_HM_parseCommon(@){#####################################################
$data = join(" ",@dataList); $data = join(" ",@dataList);
} }
} }
my $peer = $shash->{helper}{respWait}{forPeer}; my $peer = $shash->{helper}{respWait}{forPeer};
my $regLN = ((CUL_HM_getAttrInt($chnName,"expert") == 2)?"":".")."RegL_".$list.":".$peer; my $regLN = ((CUL_HM_getAttrInt($chnName,"expert") == 2)?"":".")."RegL_".$list.":".$peer;
readingsSingleUpdate($chnHash,$regLN, readingsSingleUpdate($chnHash,$regLN,
@ -1458,12 +1459,12 @@ sub CUL_HM_parseCommon(@){#####################################################
# peer Channel name from/for user entry. <IDorName> <deviceID> <ioID> # peer Channel name from/for user entry. <IDorName> <deviceID> <ioID>
CUL_HM_updtRegDisp($chnHash,$list, CUL_HM_updtRegDisp($chnHash,$list,
CUL_HM_peerChId($peer, CUL_HM_peerChId($peer,
substr(CUL_HM_hash2Id($chnHash),0,6),"00000000")); substr($chnHash->{DEF},0,6),"00000000"));
} }
else{ else{
CUL_HM_respPendToutProlong($shash);#wasn't last - reschedule timer CUL_HM_respPendToutProlong($shash);#wasn't last - reschedule timer
} }
return "done"; $ret = "done";
} }
} }
elsif($subType eq "04"){ #ParamChange=================================== elsif($subType eq "04"){ #ParamChange===================================
@ -1493,8 +1494,8 @@ sub CUL_HM_parseCommon(@){#####################################################
} }
elsif($subType eq "06"){ #reply to status request======================= elsif($subType eq "06"){ #reply to status request=======================
my $rssi = substr($p,8,2);# --calculate RSSI my $rssi = substr($p,8,2);# --calculate RSSI
CUL_HM_storeRssi(CUL_HM_hash2Name($shash), CUL_HM_storeRssi($shash->{NAME},
($dhash?CUL_HM_hash2Name($dhash):$shash->{IODev}{NAME}), ($dhash?$dhash->{NAME}:$shash->{IODev}{NAME}),
(-1)*(hex($rssi))) (-1)*(hex($rssi)))
if ($rssi && $rssi ne '00' && $rssi ne'80'); if ($rssi && $rssi ne '00' && $rssi ne'80');
@{$modules{CUL_HM}{helper}{reqStatus}} = grep { $_ ne $shash->{NAME} } @{$modules{CUL_HM}{helper}{reqStatus}} = grep { $_ ne $shash->{NAME} }
@ -1504,14 +1505,14 @@ sub CUL_HM_parseCommon(@){#####################################################
my $chnhash = $modules{CUL_HM}{defptr}{$chnSrc}; my $chnhash = $modules{CUL_HM}{defptr}{$chnSrc};
$chnhash = $shash if (!$chnhash); $chnhash = $shash if (!$chnhash);
CUL_HM_respPendRm($shash); CUL_HM_respPendRm($shash);
return "STATresp"; $ret = "STATresp";
} }
else{ else{
my ($chn) = ($1) if($p =~ m/^..(..)/); my ($chn) = ($1) if($p =~ m/^..(..)/);
if ($chn eq "00"){ if ($chn eq "00"){
CUL_HM_queueAutoRead(CUL_HM_hash2Name($shash)) CUL_HM_queueAutoRead($shash->{NAME})
if (1 < CUL_HM_getAttrInt($shash->{NAME},"autoReadReg")); if (1 < CUL_HM_getAttrInt($shash->{NAME},"autoReadReg"));
return "powerOn" ;# check dst eq "000000" as well? $ret = "powerOn" ;# check dst eq "000000" as well?
} }
} }
} }
@ -1524,7 +1525,7 @@ sub CUL_HM_parseCommon(@){#####################################################
# CUL_HM_SndCmd($shash, '++A112'.CUL_HM_IOid($shash).$src); # CUL_HM_SndCmd($shash, '++A112'.CUL_HM_IOid($shash).$src);
# CUL_HM_ProcessCmdStack($shash); # CUL_HM_ProcessCmdStack($shash);
} }
return ""; return $ret;
} }
sub CUL_HM_queueAutoRead($){ sub CUL_HM_queueAutoRead($){
my $name = shift; my $name = shift;
@ -1695,7 +1696,7 @@ sub CUL_HM_Get($@) {
$timestamps .= "\n# ".ReadingsTimestamp($eName,"peerList","")." :peerList"; $timestamps .= "\n# ".ReadingsTimestamp($eName,"peerList","")." :peerList";
print aSave "\nset ".$eName." peerBulk ".$pIds; print aSave "\nset ".$eName." peerBulk ".$pIds;
} }
my $ehash = CUL_HM_name2Hash($eName); my $ehash = $defs{$eName};
foreach my $read (sort keys %{$ehash->{READINGS}}){ foreach my $read (sort keys %{$ehash->{READINGS}}){
next if ($read !~ m/^[\.]?RegL_/); next if ($read !~ m/^[\.]?RegL_/);
print aSave "\nset ".$eName." regBulk ".$read." ".ReadingsVal($eName,$read,""); print aSave "\nset ".$eName." regBulk ".$read." ".ReadingsVal($eName,$read,"");
@ -1716,6 +1717,7 @@ sub CUL_HM_Get($@) {
#+++++++++++++++++ set command+++++++++++++++++++++++++++++++++++++++++++++++++ #+++++++++++++++++ set command+++++++++++++++++++++++++++++++++++++++++++++++++
sub CUL_HM_Set($@) { sub CUL_HM_Set($@) {
my ($hash, @a) = @_; my ($hash, @a) = @_;
my $act = join(" ", @a[1..$#a]);
my $ret; my $ret;
return "no set value specified" if(@a < 2); return "no set value specified" if(@a < 2);
@ -1726,7 +1728,6 @@ sub CUL_HM_Set($@) {
my $rxType = CUL_HM_getRxType($hash); my $rxType = CUL_HM_getRxType($hash);
my $flag = CUL_HM_getFlag($hash); #set burst flag my $flag = CUL_HM_getFlag($hash); #set burst flag
my $cmd = $a[1]; my $cmd = $a[1];
return "devicepair is outdated. Please use peerChan instead" if ($cmd eq "devicepair");#todo Updt4 remove at some point
my $dst = $hash->{DEF}; my $dst = $hash->{DEF};
my $isChannel = (length($dst) == 8)?"true":""; my $isChannel = (length($dst) == 8)?"true":"";
my $chn = ($isChannel)?substr($dst,6,2):"01"; my $chn = ($isChannel)?substr($dst,6,2):"01";
@ -1797,7 +1798,7 @@ sub CUL_HM_Set($@) {
return "$a[2] not specified. choose 0-15 for brightness" if ($a[2]>15); return "$a[2] not specified. choose 0-15 for brightness" if ($a[2]>15);
return "$a[3] not specified. choose 0-127 for duration" if ($a[3]>127); return "$a[3] not specified. choose 0-127 for duration" if ($a[3]>127);
return "unsupported for channel, use $devName" if (!$roleD); return "unsupported for channel, use $devName" if (!$roleD);
splice @a,1,3, ("regBulk","RegL_00:",sprintf(" 04:%02X",$a[2]),sprintf(" 08:%02X",$a[3]*2)); splice @a,1,3, ("regBulk","RegL_00:",sprintf("04:%02X",$a[2]),sprintf("08:%02X",$a[3]*2));
} }
elsif($cmd eq "text") { ################################################# reg elsif($cmd eq "text") { ################################################# reg
my ($bn,$l1, $l2) = ($chn,$a[2],$a[3]); # Create CONFIG_WRITE_INDEX string my ($bn,$l1, $l2) = ($chn,$a[2],$a[3]); # Create CONFIG_WRITE_INDEX string
@ -2496,7 +2497,7 @@ sub CUL_HM_Set($@) {
my $cmdB = ($set)?"01":"02";# do we set or remove? my $cmdB = ($set)?"01":"02";# do we set or remove?
# First the remote (one loop for on, one for off) # First the remote (one loop for on, one for off)
my $pSt = AttrVal( CUL_HM_hash2Name($peerHash), "subType", "");#peer SubType my $pSt = AttrVal($peerHash->{NAME}, "subType", "");#peer SubType
if (!$target || $target =~ m/^(remote|both)$/){ if (!$target || $target =~ m/^(remote|both)$/){
my $burst = ($pSt eq "thermostat"?"0101":"0100");#set burst for target my $burst = ($pSt eq "thermostat"?"0101":"0100");#set burst for target
for(my $i = 1; $i <= $nrCh2Pair; $i++) { for(my $i = 1; $i <= $nrCh2Pair; $i++) {
@ -2537,8 +2538,7 @@ sub CUL_HM_Set($@) {
readingsSingleUpdate($hash,"state",$state,1) if($state); readingsSingleUpdate($hash,"state",$state,1) if($state);
$rxType = CUL_HM_getRxType($devHash); $rxType = CUL_HM_getRxType($devHash);
Log GetLogLevel($name,2), "CUL_HM set $name " . Log GetLogLevel($name,2), "CUL_HM set $name $act";
join(" ", @a[1..$#a])." rxt:".$rxType;
CUL_HM_ProcessCmdStack($devHash) if($rxType & 0x03);#all/burst CUL_HM_ProcessCmdStack($devHash) if($rxType & 0x03);#all/burst
return ("",1);# no not generate trigger outof command return ("",1);# no not generate trigger outof command
} }
@ -2957,7 +2957,7 @@ sub CUL_HM_pushConfig($$$$$$$$) {#generate messages to cnfig data to register
substr($content,$l,$ml)); substr($content,$l,$ml));
} }
CUL_HM_PushCmdStack($hash,"++A001".$src.$dst.$chn."06"); CUL_HM_PushCmdStack($hash,"++A001".$src.$dst.$chn."06");
CUL_HM_queueAutoRead(CUL_HM_hash2Name($hash)) CUL_HM_queueAutoRead($hash->{NAME})
if (2 < CUL_HM_getAttrInt($hash->{NAME},"autoReadReg")); if (2 < CUL_HM_getAttrInt($hash->{NAME},"autoReadReg"));
} }
sub CUL_HM_Resend($) {#resend a message if there is no answer sub CUL_HM_Resend($) {#resend a message if there is no answer
@ -2986,8 +2986,8 @@ sub CUL_HM_Resend($) {#resend a message if there is no answer
################### Peer Handling ################ ################### Peer Handling ################
sub CUL_HM_ID2PeerList ($$$) { sub CUL_HM_ID2PeerList ($$$) {
my($name,$peerID,$set) = @_; my($name,$peerID,$set) = @_;
my $peerIDs = AttrVal($name,"peerIDs",""); my $peerIDs = $attr{$name}{peerIDs}?$attr{$name}{peerIDs}:"";
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
$peerIDs =~ s/$peerID//g; #avoid duplicate, support unset $peerIDs =~ s/$peerID//g; #avoid duplicate, support unset
$peerID =~ s/^000000../00000000/; #correct end detector $peerID =~ s/^000000../00000000/; #correct end detector
$peerIDs.= $peerID."," if($set); $peerIDs.= $peerID."," if($set);
@ -3025,7 +3025,7 @@ sub CUL_HM_peerChId($$$) {# in:<IDorName> <deviceID> <ioID>, out:channelID
} }
sub CUL_HM_peerChName($$$) {#in:<IDorName> <deviceID> <ioID>, out:name sub CUL_HM_peerChName($$$) {#in:<IDorName> <deviceID> <ioID>, out:name
my($pId,$dId,$iId)=@_; my($pId,$dId,$iId)=@_;
my($pDev,$pChn) = ($1,$2) if ($pId =~ m/(......)(..)/); my($pDev,$pChn) = unpack'A6A2',$pId;
return 'self'.$pChn if ($pDev eq $dId); return 'self'.$pChn if ($pDev eq $dId);
return 'fhem'.$pChn if ($pDev eq $iId); return 'fhem'.$pChn if ($pDev eq $iId);
return CUL_HM_id2Name($pId); return CUL_HM_id2Name($pId);
@ -3077,9 +3077,9 @@ sub CUL_HM_getAssChnIds($) { #in: name out:ID list of assotiated channels
# if device and no channel # if device and no channel
my ($name) = @_; my ($name) = @_;
my @chnIdList; my @chnIdList;
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
foreach my $channel (grep {$_ =~m/^channel_/} keys %{$hash}){ foreach my $channel (grep {$_ =~m/^channel_/} keys %{$hash}){
my $chnHash = CUL_HM_name2Hash($hash->{$channel}); my $chnHash = $defs{$hash->{$channel}};
push @chnIdList,$chnHash->{DEF} if ($chnHash); push @chnIdList,$chnHash->{DEF} if ($chnHash);
} }
my $dId = CUL_HM_name2Id($name); my $dId = CUL_HM_name2Id($name);
@ -3090,17 +3090,25 @@ sub CUL_HM_getAssChnIds($) { #in: name out:ID list of assotiated channels
} }
#+++++++++++++++++ Conversions names, hashes, ids++++++++++++++++++++++++++++++ #+++++++++++++++++ Conversions names, hashes, ids++++++++++++++++++++++++++++++
#Performance opti: subroutines may consume up to 5 times the performance
#
#get Attr: $val = $attr{$hash->{NAME}}{$attrName}?$attr{$hash->{NAME}}{$attrName} :"";
# $val = $attr{$name}{$attrName} ?$attr{$name}{$attrName} :"";
#getRead: $val = $hash->{READINGS}{$rlName} ?$hash->{READINGS}{$rlName}{VAL} :"";
# $val = $defs{$name}{READINGS}{$rlName}?$defs{$name}{READINGS}{$rlName}{VAL} :"";
# $time = $hash->{READINGS}{$rlName} ?$hash->{READINGS}{$rlName}{time} :"";
sub CUL_HM_Id($) {#in: ioHash out: ioHMid sub CUL_HM_Id($) {#in: ioHash out: ioHMid
my ($io) = @_; my ($io) = @_;
my $fhtid = defined($io->{FHTID}) ? $io->{FHTID} : "0000"; my $fhtid = defined($io->{FHTID}) ? $io->{FHTID} : "0000";
return AttrVal($io->{NAME}, "hmId", "F1$fhtid"); return $attr{$io->{NAME}}{hmId}?$attr{$io->{NAME}}{hmId}:"F1$fhtid";
} }
sub CUL_HM_IOid($) {#in: hash out: id of IO device sub CUL_HM_IOid($) {#in: hash out: id of IO device
my ($hash) = @_; my ($hash) = @_;
my $dHash = CUL_HM_getDeviceHash($hash); my $dHash = CUL_HM_getDeviceHash($hash);
my $ioHash = $dHash->{IODev}; my $ioHash = $dHash->{IODev};
my $fhtid = defined($ioHash->{FHTID}) ? $ioHash->{FHTID} : "0000"; my $fhtid = defined($ioHash->{FHTID}) ? $ioHash->{FHTID} : "0000";
return AttrVal($ioHash->{NAME}, "hmId", "F1$fhtid"); return $attr{$ioHash->{NAME}}{hmId}?$attr{$ioHash->{NAME}}{hmId}:"F1$fhtid";
} }
sub CUL_HM_hash2Id($) {#in: id, out:hash sub CUL_HM_hash2Id($) {#in: id, out:hash
my ($hash) = @_; my ($hash) = @_;
@ -3117,7 +3125,7 @@ sub CUL_HM_name2Hash($) {#in: name, out:hash
sub CUL_HM_name2Id(@) { #in: name or HMid ==>out: HMid, "" if no match sub CUL_HM_name2Id(@) { #in: name or HMid ==>out: HMid, "" if no match
my ($name,$idHash) = @_; my ($name,$idHash) = @_;
my $hash = $defs{$name}; my $hash = $defs{$name};
return $hash->{DEF} if ($hash); #name is entity return $hash->{DEF} if($hash); #name is entity
return "000000" if($name eq "broadcast"); #broadcast return "000000" if($name eq "broadcast"); #broadcast
return $defs{$1}->{DEF}.$2 if($name =~ m/(.*)_chn:(..)/); #<devname> chn:xx return $defs{$1}->{DEF}.$2 if($name =~ m/(.*)_chn:(..)/); #<devname> chn:xx
return $name if($name =~ m/^[A-F0-9]{6,8}$/i);#was already HMid return $name if($name =~ m/^[A-F0-9]{6,8}$/i);#was already HMid
@ -3127,22 +3135,21 @@ sub CUL_HM_name2Id(@) { #in: name or HMid ==>out: HMid, "" if no match
} }
sub CUL_HM_id2Name($) { #in: name or HMid out: name sub CUL_HM_id2Name($) { #in: name or HMid out: name
my ($p) = @_; my ($p) = @_;
return $p if($defs{$p}); # is already name return $p if($defs{$p}||$p =~ m/_chn:/);
return $p if ($p =~ m/_chn:/);
my $devId= substr($p, 0, 6); my $devId= substr($p, 0, 6);
return "broadcast" if($devId eq "000000"); return "broadcast" if($devId eq "000000");
my ($chn,$chnId);
if (length($p) == 8){
$chn = substr($p, 6, 2);;
$chnId = $p;
}
my $defPtr = $modules{CUL_HM}{defptr};
return $defPtr->{$chnId}{NAME} if( $chnId && $defPtr->{$chnId});#channel
return $defPtr->{$devId}{NAME} if(!$chnId && $defPtr->{$devId});#device only
return $defPtr->{$devId}{NAME}."_chn:".$chn my $defPtr = $modules{CUL_HM}{defptr};
if( $chnId && $defPtr->{$devId});#device, add chn if (length($p) == 8){
return $devId. ($chn ? ("_chn:".$chn):""); #not defined, return ID only return $defPtr->{$p}{NAME} if($defPtr->{$p});#channel
return $defPtr->{$devId}{NAME}."_chn:".substr($p,6,2)
if($defPtr->{$devId});#dev, add chn
return $p; #not defined, return ID only
}
else{
return $defPtr->{$devId}{NAME} if($defPtr->{$devId});#device only
return $devId; #not defined, return ID only
}
} }
sub CUL_HM_id2Hash($) {#in: id, out:hash sub CUL_HM_id2Hash($) {#in: id, out:hash
my ($id) = @_; my ($id) = @_;
@ -3210,13 +3217,11 @@ sub CUL_HM_DumpProtocol($$@) {
} }
#+++++++++++++++++ handling register updates ++++++++++++++++++++++++++++++++++ #+++++++++++++++++ handling register updates ++++++++++++++++++++++++++++++++++
sub CUL_HM_getRegFromStore($$$$) {#read a register from backup data sub CUL_HM_getRegFromStore($$$$@) {#read a register from backup data
my($name,$regName,$list,$peerId)=@_; my($name,$regName,$list,$peerId,$regLN)=@_;
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
my ($size,$pos,$conversion,$factor,$unit) = (8,0,"",1,""); # default my ($size,$pos,$conversion,$factor,$unit) = (8,0,"",1,""); # default
my $addr = $regName; my $addr = $regName;
my $dId = substr(CUL_HM_name2Id($name),0,6);#id of device
my $iId = CUL_HM_IOid($hash); #id of IO device
my $reg = $culHmRegDefine{$regName}; my $reg = $culHmRegDefine{$regName};
if ($reg) { # get the register's information if ($reg) { # get the register's information
$addr = $reg->{a}; $addr = $reg->{a};
@ -3229,31 +3234,33 @@ sub CUL_HM_getRegFromStore($$$$) {#read a register from backup data
$factor = $reg->{f}; $factor = $reg->{f};
$unit = $reg->{u}; $unit = $reg->{u};
} }
else{ $regLN = ((CUL_HM_getAttrInt($name,"expert") == 2)?"":".")
;# use address instead of .sprintf("RegL_%02X:",$list)
} .($peerId?CUL_HM_peerChName($peerId,
$peerId = CUL_HM_peerChId(($peerId?$peerId:"00000000"),$dId,$iId); substr(CUL_HM_name2Id($name),0,6),
CUL_HM_IOid($hash)):"")
my $regLN = ((CUL_HM_getAttrInt($name,"expert") == 2)?"":"."). if(!$regLN);
"RegL_".sprintf("%02X",$list).":".CUL_HM_peerChName($peerId,$dId,$iId);
$regLN =~ s/broadcast//;
my $data=0; my $data=0;
my $convFlg = "";# confirmation flag - indicates data not confirmed by device my $convFlg = "";# confirmation flag - indicates data not confirmed by device
for (my $size2go = $size;$size2go>0;$size2go -=8){ for (my $size2go = $size;$size2go>0;$size2go -=8){
my $addrS = sprintf("%02X",$addr); my $addrS = sprintf("%02X",$addr);
my $dReadS; my ($dReadS,$dReadR) = (undef,"");
if ($hash->{helper}{shadowReg}&&$hash->{helper}{shadowReg}{$regLN}){ $dReadS = $1 if( $hash->{helper}{shadowReg}
$dReadS = $1 if($hash->{helper}{shadowReg}{$regLN} =~ m/$addrS:(..)/); && $hash->{helper}{shadowReg}{$regLN}
&& $hash->{helper}{shadowReg}{$regLN} =~ m/$addrS:(..)/);
$dReadR = $1 if( $hash->{READINGS}{$regLN}
&&$hash->{READINGS}{$regLN}{VAL} =~ m/$addrS:(..)/);
my $dRead = $dReadR;
if (defined $dReadS){
$convFlg = "set_" if ($dReadR ne $dReadS);
$dRead = $dReadS;
} }
my $dReadR = " "; else{
if ($hash->{READINGS}{$regLN}) { return "invalid" if (!defined($dRead) || $dRead eq "");
$dReadR = $1 if($hash->{READINGS}{$regLN}{VAL} =~ m/$addrS:(..)/);
} }
$convFlg = "set_" if ($dReadS && $dReadR ne $dReadS);
my $dRead = $dReadS?$dReadS:$dReadR;
return "invalid" if (!defined($dRead) || $dRead eq ""|| $dRead eq " ");
$data = ($data<< 8)+hex($dRead); $data = ($data<< 8)+hex($dRead);
$addr++; $addr++;
@ -3261,30 +3268,30 @@ sub CUL_HM_getRegFromStore($$$$) {#read a register from backup data
$data = ($data>>$pos) & (0xffffffff>>(32-$size)); $data = ($data>>$pos) & (0xffffffff>>(32-$size));
if (!$conversion){ ;# do nothing if (!$conversion){ ;# do nothing
} elsif($conversion eq "factor"){ $data /= $factor; } elsif($conversion eq "factor"){$data /= $factor;
} elsif($conversion eq "fltCvT"){ $data = CUL_HM_CvTflt($data); } elsif($conversion eq "lit" ){$data = $reg->{litInv}{$data}?$reg->{litInv}{$data}:"undef lit";
} elsif($conversion eq "m10s3") { $data = ($data+3)/10; # } elsif(defined($reg->{lit})) {
} elsif($conversion eq "hex" ) { $data = sprintf("0x%X",$data); # foreach (keys%{$reg->{lit}}){
} elsif(defined($reg->{lit})) { # if ($data == $reg->{lit}{$_}){$data = $_; last; }
foreach (keys%{$reg->{lit}}){ # }
if ($data == $reg->{lit}{$_}){ $data = $_; last; } } elsif($conversion eq "fltCvT"){$data = CUL_HM_CvTflt($data);
} } elsif($conversion eq "m10s3" ){$data = ($data+3)/10;
} elsif($conversion eq "hex" ){$data = sprintf("0x%X",$data);
} else { return " conversion undefined - please contact admin"; } else { return " conversion undefined - please contact admin";
} }
return $convFlg.$data.' '.$unit; return $convFlg.$data.' '.$unit;
} }
sub CUL_HM_updtRegDisp($$$) { sub CUL_HM_updtRegDisp($$$) {
my $starttime = gettimeofday();
my($hash,$list,$peerId)=@_; my($hash,$list,$peerId)=@_;
my $listNo = $list+0; my $listNo = $list+0;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $peer = ($peerId && $peerId ne '00000000' )? my $pReg = ($peerId && $peerId ne '00000000' )?
CUL_HM_peerChName($peerId,substr($hash->{DEF},0,6),"")."-":""; CUL_HM_peerChName($peerId,substr($hash->{DEF},0,6),"")."-":"";
$peer=~s/:/-/; $pReg=~s/:/-/;
$pReg="R-".$pReg;
my $devName =CUL_HM_getDeviceHash($hash)->{NAME};# devName as protocol entity my $devName =CUL_HM_getDeviceHash($hash)->{NAME};# devName as protocol entity
my $st = AttrVal($devName, "subType", ""); my $st = $attr{$devName}{subType} ?$attr{$devName}{subType} :"";
my $md = AttrVal($devName, "model", ""); my $md = $attr{$devName}{model} ?$attr{$devName}{model} :"";
my $chn = $hash->{DEF}; my $chn = $hash->{DEF};
$chn = (length($chn) == 8)?substr($chn,6,2):""; $chn = (length($chn) == 8)?substr($chn,6,2):"";
my @regArr = keys %culHmRegGeneral; my @regArr = keys %culHmRegGeneral;
@ -3292,15 +3299,20 @@ sub CUL_HM_updtRegDisp($$$) {
push @regArr, keys %{$culHmRegModel{$md}} if($culHmRegModel{$md}); push @regArr, keys %{$culHmRegModel{$md}} if($culHmRegModel{$md});
push @regArr, keys %{$culHmRegChan{$md.$chn}} if($culHmRegChan{$md.$chn}); push @regArr, keys %{$culHmRegChan{$md.$chn}} if($culHmRegChan{$md.$chn});
my @changedRead; my @changedRead;
my $expLvl = (CUL_HM_getAttrInt($name,"expert") != 0)?1:0; my $expL = CUL_HM_getAttrInt($name,"expert");
foreach my $regName (@regArr){ my $expLvl = ($expL != 0)?1:0;
next if ($culHmRegDefine{$regName}->{l} ne $listNo); my $regLN = (($expL == 2)?"":".")
my $rgVal = CUL_HM_getRegFromStore($name,$regName,$list,$peerId); .sprintf("RegL_%02X:",$listNo)
.($peerId?CUL_HM_peerChName($peerId,
substr(CUL_HM_name2Id($name),0,6),
CUL_HM_IOid($hash)):"");
foreach my $rgN (@regArr){
next if ($culHmRegDefine{$rgN}->{l} ne $listNo);
my $rgVal = CUL_HM_getRegFromStore($name,$rgN,$list,$peerId,$regLN);
next if (!$rgVal || $rgVal eq "invalid"); next if (!$rgVal || $rgVal eq "invalid");
my $readName = "R-".$peer.$regName; my $rdN = ((!$expLvl && !$culHmRegDefine{$rgN}->{d})?".":"").$pReg.$rgN;
$readName = ($culHmRegDefine{$regName}->{d}?"":".").$readName if (!$expLvl); #expert? push (@changedRead,$rdN.":".$rgVal)
push (@changedRead,$readName.":".$rgVal) if (ReadingsVal($name,$rdN,"") ne $rgVal);
if (ReadingsVal($name,$readName,"") ne $rgVal);
} }
CUL_HM_UpdtReadBulk($hash,1,@changedRead) if (@changedRead); CUL_HM_UpdtReadBulk($hash,1,@changedRead) if (@changedRead);
@ -3400,11 +3412,19 @@ sub CUL_HM_getChnLvl($){# in: name out: vit or phys level
#--------------- Conversion routines for register settings--------------------- #--------------- Conversion routines for register settings---------------------
sub CUL_HM_initRegHash() { #duplicate short and long press register sub CUL_HM_initRegHash() { #duplicate short and long press register
foreach my $reg (keys %culHmRegDefShLg){ #update register list foreach my $reg (keys %culHmRegDefShLg){ #update register list
%{$culHmRegDefine{"sh".$reg}} = %{$culHmRegDefShLg{$reg}}; %{$culHmRegDefine{"sh".$reg}} = %{$culHmRegDefShLg{$reg}};
%{$culHmRegDefine{"lg".$reg}} = %{$culHmRegDefShLg{$reg}}; %{$culHmRegDefine{"lg".$reg}} = %{$culHmRegDefShLg{$reg}};
$culHmRegDefine{"lg".$reg}{a} +=0x80; $culHmRegDefine{"lg".$reg}{a} +=0x80;
} }
foreach my $rN (keys %culHmRegDefine){#create literal inverse for fast search
if ($culHmRegDefine{$rN}{lit}){# literal assigned => create inverse
foreach my $lit (keys %{$culHmRegDefine{$rN}{lit}}){
$culHmRegDefine{$rN}{litInv}{$culHmRegDefine{$rN}{lit}{$lit}}=$lit;
}
}
}
foreach my $type(sort(keys %culHmRegType)){ #update references to register foreach my $type(sort(keys %culHmRegType)){ #update references to register
foreach my $reg (sort(keys %{$culHmRegType{$type}})){ foreach my $reg (sort(keys %{$culHmRegType{$type}})){
if ($culHmRegDefShLg{$reg}){ if ($culHmRegDefShLg{$reg}){
@ -3631,7 +3651,7 @@ sub CUL_HM_ActAdd($$) {# add an HMid to list for activity supervision
if (length($devId) != 6); if (length($devId) != 6);
my ($cycleString,undef)=CUL_HM_time2sec($timeout); my ($cycleString,undef)=CUL_HM_time2sec($timeout);
my $devName = CUL_HM_id2Name($devId); my $devName = CUL_HM_id2Name($devId);
my $devHash = CUL_HM_name2Hash($devName); my $devHash = $defs{$devName};
$attr{$devName}{actCycle} = $cycleString; $attr{$devName}{actCycle} = $cycleString;
$attr{$devName}{actStatus}=""; # force trigger $attr{$devName}{actStatus}=""; # force trigger
@ -3644,7 +3664,7 @@ sub CUL_HM_ActAdd($$) {# add an HMid to list for activity supervision
no strict; #convert regardless of content no strict; #convert regardless of content
next if (!defined $ehash->{NAME}); next if (!defined $ehash->{NAME});
use strict; use strict;
my $eName = CUL_HM_hash2Name($ehash); my $eName = $ehash->{NAME};
next if (!$eName); next if (!$eName);
foreach my $rName (keys %{$ehash->{READINGS}}){ foreach my $rName (keys %{$ehash->{READINGS}}){
next if (!$rName || next if (!$rName ||
@ -3704,7 +3724,7 @@ sub CUL_HM_ActCheck() {# perform supervision
CUL_HM_ActDel($devId); CUL_HM_ActDel($devId);
next; next;
} }
my $devHash = CUL_HM_name2Hash($devName); my $devHash = $defs{$devName};
my $state; my $state;
my $oldState = AttrVal($devName,"actStatus","unset"); my $oldState = AttrVal($devName,"actStatus","unset");
my (undef,$tSec)=CUL_HM_time2sec($attr{$devName}{actCycle}); my (undef,$tSec)=CUL_HM_time2sec($attr{$devName}{actCycle});
@ -3813,7 +3833,7 @@ sub CUL_HM_storeRssi(@){
else{ else{
$rssiP->{avg} += ($val - $rssiP->{avg}) /$rssiP->{cnt}; $rssiP->{avg} += ($val - $rssiP->{avg}) /$rssiP->{cnt};
} }
my $hash = CUL_HM_name2Hash($name); my $hash = $defs{$name};
my $rssi; my $rssi;
foreach (keys %{$rssiP}){ foreach (keys %{$rssiP}){
my $val = $rssiP->{$_}?$rssiP->{$_}:0; my $val = $rssiP->{$_}?$rssiP->{$_}:0;
@ -3825,36 +3845,26 @@ sub CUL_HM_storeRssi(@){
sub CUL_HM_stateUpdat($){#in:name, send status-request sub CUL_HM_stateUpdat($){#in:name, send status-request
my $name = shift; my $name = shift;
(undef,$name)=split":",$name,2; (undef,$name)=split":",$name,2;
CUL_HM_Set(CUL_HM_name2Hash($name),$name,"statusRequest") if ($name); CUL_HM_Set($defs{$name},$name,"statusRequest") if ($name);
} }
sub CUL_HM_qStateUpdatIfEnab($){#in:name or id, queue stat-request after 12 sec sub CUL_HM_qStateUpdatIfEnab($@){#in:name or id, queue stat-request after 12 sec
my $name = shift; my ($name,$force) = @_;
$name = CUL_HM_id2Name($name) if ($name =~ m/^[A-F0-9]{6,8}$/i); $name = CUL_HM_id2Name($name) if ($name =~ m/^[A-F0-9]{6,8}$/i);
$name =~ s /_chn:..$//; $name =~ s /_chn:..$//;
return if (!$defs{$name}); #device unknown, ignore return if (!$defs{$name}); #device unknown, ignore
if (CUL_HM_getAttrInt($name,"autoReadReg") > 3){ if ($force || (CUL_HM_getAttrInt($name,"autoReadReg") > 3)){
@{$modules{CUL_HM}{helper}{reqStatus}}= @{$modules{CUL_HM}{helper}{reqStatus}}=
CUL_HM_noDup(@{$modules{CUL_HM}{helper}{reqStatus}},$name); CUL_HM_noDup(@{$modules{CUL_HM}{helper}{reqStatus}},$name);
RemoveInternalTimer("CUL_HM_reqStatus"); RemoveInternalTimer("CUL_HM_reqStatus");
InternalTimer(gettimeofday()+120,"CUL_HM_reqStatus","CUL_HM_reqStatus", 0); InternalTimer(gettimeofday()+120,"CUL_HM_reqStatus","CUL_HM_reqStatus", 0);
} }
} }
sub CUL_HM_qStateUpdat($){#in:name or id, queue send stat-request after 12 sec
my $name = shift;
$name = CUL_HM_id2Name($name) if ($name =~ m/^[A-F0-9]{6,8}$/i);
$name =~ s /_chn:..$//;
return if (!$defs{$name}); #device unknown, ignore
@{$modules{CUL_HM}{helper}{reqStatus}}=
CUL_HM_noDup(@{$modules{CUL_HM}{helper}{reqStatus}},$name);
RemoveInternalTimer("CUL_HM_reqStatus");
InternalTimer(gettimeofday()+120,"CUL_HM_reqStatus","CUL_HM_reqStatus", 0);
}
sub CUL_HM_getAttrInt($$){#return attrValue as integer sub CUL_HM_getAttrInt($$){#return attrValue as integer
my ($name,$attrName) = @_; my ($name,$attrName) = @_;
my $val = AttrVal($name,$attrName,""); my $val = $attr{$name}{$attrName}?$attr{$name}{$attrName}:"";
no warnings 'numeric'; no warnings 'numeric';
$val = int(AttrVal(CUL_HM_getDeviceName($name),$attrName,0))+0 my $devN = $defs{$name}{device}?$defs{$name}{device}:$name;
if ($val eq ""); $val = int($attr{$devN}{$attrName}?$attr{$devN}{$attrName}:0)+0 if($val eq "");
use warnings 'numeric'; use warnings 'numeric';
return substr($val,0,1); return substr($val,0,1);
} }