FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-23 20:52:13 +00:00
Code Issues Releases Wiki Activity

HMInfo: minor internal updates

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@22786 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876 2020-09-18 15:37:20 +00:00
parent 5c1bdda8f8
commit 4e0785ecfb
1 changed files with 120 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
fhem/FHEM/98_HMinfo.pm
View File

@ -316,6 +316,7 @@ sub HMinfo_status($){##########################################################
foreach my $id (keys%{$modules{CUL_HM}{defptr}}){#search/count for parameter foreach my $id (keys%{$modules{CUL_HM}{defptr}}){#search/count for parameter
my $ehash = $modules{CUL_HM}{defptr}{$id}; my $ehash = $modules{CUL_HM}{defptr}{$id};
my $eName = $ehash->{NAME}; my $eName = $ehash->{NAME};
next if (CUL_HM_getAttrInt($eName,"ignore"));
$nbrE++; $nbrE++;
$nbrC++ if ($ehash->{helper}{role}{chn}); $nbrC++ if ($ehash->{helper}{role}{chn});
$nbrV++ if ($ehash->{helper}{role}{vrt}); $nbrV++ if ($ehash->{helper}{role}{vrt});
@ -1146,7 +1147,7 @@ sub HMinfo_getEntities(@) { ###################################################
($doChn && $eHash->{helper}{role}{chn}))); ($doChn && $eHash->{helper}{role}{chn})));
next if ( $noVrt && $eHash->{helper}{role}{vrt}); next if ( $noVrt && $eHash->{helper}{role}{vrt});
next if ( $noPhy && !$eHash->{helper}{role}{vrt}); next if ( $noPhy && !$eHash->{helper}{role}{vrt});
my $eSt = CUL_HM_Get($eHash,$eName,"param","subType"); my $eSt = CUL_HM_getAttr($eName,"subType","");
next if ( $noSen && $eSt =~ m/^(THSensor|remote|pushButton|threeStateSensor|sensor|motionDetector|swi)$/); next if ( $noSen && $eSt =~ m/^(THSensor|remote|pushButton|threeStateSensor|sensor|motionDetector|swi)$/);
next if ( $noAct && $eSt =~ m/^(switch|blindActuator|dimmer|thermostat|smokeDetector|KFM100|outputUnit)$/); next if ( $noAct && $eSt =~ m/^(switch|blindActuator|dimmer|thermostat|smokeDetector|KFM100|outputUnit)$/);
@ -1217,18 +1218,29 @@ sub HMinfo_GetFn($@) {#########################################################
my ($opt,$optEmpty,$filter) = ("",1,""); my ($opt,$optEmpty,$filter) = ("",1,"");
my $ret; my $ret;
$doAli = 0;#set default $doAli = 0;#set default
Log3 $hash,3,"HMinfo $name get:$cmd :".join(",",@a) if ($cmd && $cmd ne "?");
if (@a && ($a[0] =~ m/^-/) && ($a[0] !~ m/^-f$/)){# options provided if (@a && ($a[0] =~ m/^(-[dcasev]+)/)){# options provided
$opt = $a[0]; $opt = $1;
$a[0] =~ s/^(-[dcasev]*)//;
$optEmpty = ($opt =~ m/e/)?1:0; $optEmpty = ($opt =~ m/e/)?1:0;
shift @a; #remove shift @a if($a[0] || $a[0] =~ m/^[ ]*$/); #remove
} }
if (@a && $a[0] =~ m/^-f$/){# options provided if (@a && $a[0] =~ m/^-f$/){# options provided
shift @a; #remove shift @a; #remove
$filter = shift @a; if(scalar @a){
my $a0 = shift @a;
($filter,$a0) = split(",",$a0,2);
if(!defined $a0 || $a0 =~ m/^[ ]*$/){
shift @a;
}
else{
$a[0] = $a0;
}
}
} }
$cmd = "?" if(!$cmd);# by default print options $cmd = "?" if(!$cmd);# by default print options
#------------ statistics --------------- #------------ statistics ---------------
if ($cmd eq "protoEvents"){##print protocol-events------------------------- if ($cmd eq "protoEvents"){##print protocol-events-------------------------
my ($type) = @a; my ($type) = @a;
@ -1315,8 +1327,8 @@ sub HMinfo_GetFn($@) {#########################################################
: "" : ""
) )
." condition:".ReadingsVal($_,"cond","-") ." condition:".ReadingsVal($_,"cond","-")
.(defined $defs{$_}{msgLoadEst} .(defined $defs{$_}{msgLoadCurrent}
? "\n msgLoadEst: ".$defs{$_}{msgLoadEst} ? "\n msgLoadCurrent: ".$defs{$_}{msgLoadCurrent}
: "" : ""
) )
; ;
@ -1420,30 +1432,62 @@ sub HMinfo_GetFn($@) {#########################################################
return $defs{$name}{helper}{cfgChkResult} ? $defs{$name}{helper}{cfgChkResult} :"no results available"; return $defs{$name}{helper}{cfgChkResult} ? $defs{$name}{helper}{cfgChkResult} :"no results available";
} }
elsif($cmd eq "templateChk"){##template: see if it applies ------------------ elsif($cmd eq "templateChk"){##template: see if it applies ------------------
my $id = ++$hash->{nb}{cnt}; if ($hash->{CL}){
my $bl = BlockingCall("HMinfo_templateChk_Get", join(",",("$name;$id;$hash->{CL}{NAME}",$opt,$filter,@a)), my $id = ++$hash->{nb}{cnt};
"HMinfo_bpPost", 30, my $bl = BlockingCall("HMinfo_templateChk_Get", join(",",("$name;$id;$hash->{CL}{NAME}",$opt,$filter,@a)),
"HMinfo_bpAbort", "$name:0"); "HMinfo_bpPost", 30,
$hash->{nb}{$id}{$_} = $bl->{$_} foreach (keys %{$bl}); "HMinfo_bpAbort", "$name:0");
$ret = ""; $hash->{nb}{$id}{$_} = $bl->{$_} foreach (keys %{$bl});
$ret = "";
}
else{
(undef,undef,undef,$ret) = split(";",HMinfo_templateChk_Get (join(",",("$name;;",$opt,$filter,@a))),4);
$ret = HMinfo_bpPost("$name;;;$ret");
}
} }
elsif($cmd =~ m/^templateUs(g|gG)$/){##template: see if it applies ---------- elsif($cmd =~ m/^templateUs(g|gG)$/){##template: see if it applies ----------
return HMinfo_templateUsg($opt,$filter,@a); return HMinfo_templateUsg($opt,$filter,@a);
} }
#------------ print tables --------------- #------------ print tables ---------------
elsif($cmd eq "peerXref") {##print cross-references------------------------ elsif($cmd eq "peerXref") {##print cross-references------------------------
my @peerPairs; my $sort = "act";
#sender,actor,receiver,virtual
my $disp = "";
if (defined $a[0]){
foreach (split(",",$a[0])){
$disp .= "1" if($_ =~ m/^sender$/);
$disp .= "2" if($_ =~ m/^actor$/);
$disp .= "3" if($_ =~ m/^receiver$/);
$disp .= "4" if($_ =~ m/^virtual$/);
}
}
$disp = "1234" if ($disp eq "");
$disp .= "56";
my %peerFriends;
my @peerFhem; my @peerFhem;
my @peerUndef; # my @peerUndef;
my @fheml = (); my @fheml = ();
foreach my $dName (HMinfo_getEntities($opt,$filter)){ foreach my $dName (HMinfo_getEntities($opt,$filter)){
# search for irregular trigger # search for irregular trigger
my $peerIDs = AttrVal($dName,"peerIDs",""); my $peerIDs = AttrVal($dName,"peerIDs","");
$peerIDs =~ s/00000000,//; $peerIDs =~ s/00000000,//;
my $pType = substr($defs{$dName}{helper}{peerOpt},0,1);
$pType = ($pType eq '4' ? '1_sender'
:$pType eq '3' ? '2_actor'
:$pType eq '7' ? '3_receive'
:$pType eq 'p' ? '3_receive'
:$pType eq 'v' ? '4_virtual'
: '5_undef'
);
foreach (grep /^......$/, HMinfo_noDup(map {CUL_HM_name2Id(substr($_,8))} foreach (grep /^......$/, HMinfo_noDup(map {CUL_HM_name2Id(substr($_,8))}
grep /^trigDst_/, grep /^trigDst_/,
keys %{$defs{$dName}{READINGS}})){ keys %{$defs{$dName}{READINGS}})){
push @peerUndef,"$dName triggers $_" # push @peerUndef,"$dName triggers $_"
# if( ($peerIDs && $peerIDs !~ m/$_/)
# &&("CCU-FHEM" ne AttrVal(CUL_HM_id2Name($_),"model","")));
$peerFriends{"6_trigger"}{$dName}{$_} = 1
if( ($peerIDs && $peerIDs !~ m/$_/) if( ($peerIDs && $peerIDs !~ m/$_/)
&&("CCU-FHEM" ne AttrVal(CUL_HM_id2Name($_),"model",""))); &&("CCU-FHEM" ne AttrVal(CUL_HM_id2Name($_),"model","")));
} }
@ -1451,14 +1495,13 @@ sub HMinfo_GetFn($@) {#########################################################
#--- check regular references #--- check regular references
next if(!$peerIDs); next if(!$peerIDs);
my $dId = unpack 'A6',CUL_HM_name2Id($dName); my $dId = unpack 'A6',CUL_HM_name2Id($dName);
my @pl = ();
foreach (split",",$peerIDs){ foreach (split",",$peerIDs){
my $pn = CUL_HM_peerChName($_,$dId); my $pn = CUL_HM_peerChName($_,$dId);
$pn =~ s/_chn-01//; $pn =~ s/_chn-01//;
push @pl,$pn;
push @fheml,"$_$dName" if ($pn =~ m/^fhem..$/); push @fheml,"$_$dName" if ($pn =~ m/^fhem..$/);
$peerFriends{$pType}{$dName}{$pn} = 1;
} }
push @peerPairs,$dName." => ".join(" ",(sort @pl)) if (@pl);
} }
#--- calculate peerings to Central --- #--- calculate peerings to Central ---
my %fChn; my %fChn;
@ -1468,13 +1511,27 @@ sub HMinfo_GetFn($@) {#########################################################
$fChn{$fhemCh} = ($fChn{$fhemCh}?$fChn{$fhemCh}.", ":"").$p; $fChn{$fhemCh} = ($fChn{$fhemCh}?$fChn{$fhemCh}.", ":"").$p;
} }
push @peerFhem,map {"$_ => $fChn{$_}"} keys %fChn; push @peerFhem,map {"$_ => $fChn{$_}"} keys %fChn;
$ret = $cmd." done:" ."\n x-ref list"."\n ".(join "\n ",sort @peerPairs)
."\n ".(join "\n ",sort @peerFhem) $ret = $cmd." done:" ."\n x-ref list";
; foreach my $type(sort keys %peerFriends){
$ret .= "\n warning: sensor triggers but no config found" my $typeId = substr($type,0,1);
."\n ".(join "\n ",sort @peerUndef) next if($disp !~ m/$typeId/);
if(@peerUndef) $ret .= "\n ".substr($type,2,20);
; foreach my $Channel(sort keys %{$peerFriends{$type}}){
$ret .= sprintf("\n %-20s %s %s",$Channel
,($sort eq "act" ? " => " : " <= " )
,join (" ",sort keys %{$peerFriends{$type}{$Channel}}))
;
}
}
# ."\n ".(join "\n ",sort @peerFhem)
# ;
# $ret .= "\n warning: sensor triggers but no config found"
# ."\n ".(join "\n ",sort @peerUndef)
# if(@peerUndef)
# ;
} }
elsif($cmd eq "peerUsg") {##print cross-references and usage-------------- elsif($cmd eq "peerUsg") {##print cross-references and usage--------------
my @peerPairs; my @peerPairs;
@ -1655,7 +1712,11 @@ sub HMinfo_GetFn($@) {#########################################################
,"param" ,"param"
,"peerCheck" ,"peerCheck"
,"peerUsg" ,"peerUsg"
,"peerXref" ,"peerXref:multiple"
.",sender"
.",actor"
.",receiver"
.",virtual"
,"protoEvents:all,short,long" ,"protoEvents:all,short,long"
,"msgStat" ,"msgStat"
,"rssi rssiG:full,reduced" ,"rssi rssiG:full,reduced"
@ -1692,6 +1753,7 @@ sub HMinfo_SetFn($@) {#########################################################
} }
$cmd = "?" if(!$cmd);# by default print options $cmd = "?" if(!$cmd);# by default print options
Log3 $hash,3,"HMinfo $name get:$cmd :".join(",",@a) if ($cmd ne "?");
if ($cmd =~ m/^clear[G]?/ ) {##actionImmediate: clear parameter-------- if ($cmd =~ m/^clear[G]?/ ) {##actionImmediate: clear parameter--------
my ($type) = @a; my ($type) = @a;
return "please enter what to clear" if (! $type); return "please enter what to clear" if (! $type);
@ -1789,7 +1851,7 @@ sub HMinfo_SetFn($@) {#########################################################
} }
elsif($cmd eq "loadConfig") {##action: loadConfig----------------------- elsif($cmd eq "loadConfig") {##action: loadConfig-----------------------
my $fn = HMinfo_getConfigFile($name,"configFilename",$a[0]); my $fn = HMinfo_getConfigFile($name,"configFilename",$a[0]);
$ret = HMinfo_loadConfig($filter,$fn); $ret = HMinfo_loadConfig($hash,$filter,$fn);
} }
elsif($cmd eq "verifyConfig") {##action: verifyConfig--------------------- elsif($cmd eq "verifyConfig") {##action: verifyConfig---------------------
my $fn = HMinfo_getConfigFile($name,"configFilename",$a[0]); my $fn = HMinfo_getConfigFile($name,"configFilename",$a[0]);
@ -2093,8 +2155,8 @@ sub HMinfo_verifyConfig($) {###################################################
$ret =~ s/\n/-ret-/g; $ret =~ s/\n/-ret-/g;
return "$id;$ret"; return "$id;$ret";
} }
sub HMinfo_loadConfig($@) {#################################################### sub HMinfo_loadConfig($$@) {####################################################
my ($filter,$fName)=@_; my ($hash,$filter,$fName)=@_;
$filter = "." if (!$filter); $filter = "." if (!$filter);
my $ret; my $ret;
open(rFile, "$fName") || return("Can't open $fName: $!"); open(rFile, "$fName") || return("Can't open $fName: $!");
@ -2104,6 +2166,8 @@ sub HMinfo_loadConfig($@) {####################################################
my %changes; my %changes;
my @rUpdate; my @rUpdate;
my @tmplList = (); #collect template definitions my @tmplList = (); #collect template definitions
my ($cntTStart,$cntDef,$cntSet,$cntEWT,$cntPBulk,$cntRBulk) = (0,0,0,0,0,0);
while(<rFile>){ while(<rFile>){
chomp; chomp;
my $line = $_; my $line = $_;
@ -2127,8 +2191,10 @@ sub HMinfo_loadConfig($@) {####################################################
$defs{$eN}{READINGS}{$cmd}{TIME} = "from archivexx"; $defs{$eN}{READINGS}{$cmd}{TIME} = "from archivexx";
} }
elsif($cmd1 eq "templateDef"){ elsif($cmd1 eq "templateDef"){
if ($eN eq "templateStart"){#if new block we remove all old templates if ($eN eq "templateStart"){#if new block we remove all old templates
@tmplList = (); @tmplList = ();
$cntTStart++;
} }
else { else {
foreach my $read (keys %{$HMConfig::culHmUpdate{regValUpdt}}){# update wrong reg namings and options foreach my $read (keys %{$HMConfig::culHmUpdate{regValUpdt}}){# update wrong reg namings and options
@ -2157,6 +2223,7 @@ sub HMinfo_loadConfig($@) {####################################################
} }
if ( $timeStamp if ( $timeStamp
&& $timeStamp gt ReadingsTimestamp($eN,".peerListRDate","1900-01-01 00:00:01")){ && $timeStamp gt ReadingsTimestamp($eN,".peerListRDate","1900-01-01 00:00:01")){
$cntPBulk++;
CUL_HM_ID2PeerList($eN,$_,1) foreach (grep /[0-9A-F]{8}/,split(",",$param)); CUL_HM_ID2PeerList($eN,$_,1) foreach (grep /[0-9A-F]{8}/,split(",",$param));
push @el,"$eN peerIDs"; push @el,"$eN peerIDs";
$defs{$eN}{READINGS}{".peerListRDate"}{VAL} = $defs{$eN}{READINGS}{".peerListRDate"}{TIME} = $timeStamp; $defs{$eN}{READINGS}{".peerListRDate"}{VAL} = $defs{$eN}{READINGS}{".peerListRDate"}{TIME} = $timeStamp;
@ -2194,13 +2261,14 @@ sub HMinfo_loadConfig($@) {####################################################
} }
} }
} }
close(rFile); close(rFile);
foreach my $eN (keys %changes){ foreach my $eN (keys %changes){
foreach my $reg (keys %{$changes{$eN}}){ foreach my $reg (keys %{$changes{$eN}}){
$defs{$eN}{READINGS}{$reg}{VAL} = $changes{$eN}{$reg}{d}; $defs{$eN}{READINGS}{$reg}{VAL} = $changes{$eN}{$reg}{d};
$defs{$eN}{READINGS}{$reg}{TIME} = $changes{$eN}{$reg}{t}; $defs{$eN}{READINGS}{$reg}{TIME} = $changes{$eN}{$reg}{t};
my ($list,$pN) = $reg =~ m/RegL_(..)\.(.*)/?($1,$2):("",""); my ($list,$pN) = $reg =~ m/RegL_(..)\.(.*)/?($1,$2):("","");
$cntRBulk++;
next if (!$list); next if (!$list);
my $pId = CUL_HM_name2Id($pN);# allow devices also as peer. Regfile is korrekt my $pId = CUL_HM_name2Id($pN);# allow devices also as peer. Regfile is korrekt
# my $pId = CUL_HM_peerChId($pN,substr($defs{$eN}{DEF},0,6));#old - removed # my $pId = CUL_HM_peerChId($pN,substr($defs{$eN}{DEF},0,6));#old - removed
@ -2216,13 +2284,30 @@ sub HMinfo_loadConfig($@) {####################################################
next if (!defined $tmplCmd[4]); next if (!defined $tmplCmd[4]);
delete $HMConfig::culHmTpl{$tmplCmd[1]}; delete $HMConfig::culHmTpl{$tmplCmd[1]};
my $r = HMinfo_templateDef($tmplCmd[1],$tmplCmd[2],$tmplCmd[3],split(" ",$tmplCmd[4])); my $r = HMinfo_templateDef($tmplCmd[1],$tmplCmd[2],$tmplCmd[3],split(" ",$tmplCmd[4]));
$cntDef++;
} }
$tmplDefChange = 0;# all changes are obsolete $tmplDefChange = 0;# all changes are obsolete
$tmplUsgChange = 0;# all changes are obsolete $tmplUsgChange = 0;# all changes are obsolete
foreach my $tmpN(devspec2array("TYPE=CUL_HM")){ foreach my $tmpN(devspec2array("TYPE=CUL_HM")){
$defs{$tmpN}{helper}{tmplChg} = 0 if(!$defs{$tmpN}{helper}{role}{vrt}); $defs{$tmpN}{helper}{tmplChg} = 0 if(!$defs{$tmpN}{helper}{role}{vrt});
CUL_HM_setTmplDisp($defs{$tmpN});#set readings if desired CUL_HM_setTmplDisp($defs{$tmpN});#set readings if desired
if (defined $defs{$tmpN}{helper}{tmpl}){
my $TmpCnt = scalar(keys %{$defs{$tmpN}{helper}{tmpl}}) ;
if ($TmpCnt){
$cntSet += $TmpCnt;
$cntEWT++; # entity with template
}
}
} }
Log3 $hash,4,"HMinfo load config file"
."\n templateReDefinition:$cntTStart"
."\n templateDef:$cntDef"
."\n templateSet:$cntSet"
."\n Entity with template:$cntEWT"
."\n peerListUpdate:$cntPBulk"
."\n regListUpdate:$cntRBulk"
;
HMinfo_GetFn($hash,$hash->{NAME},"templateChk");
return $ret; return $ret;
} }
sub HMinfo_purgeConfig($) {#################################################### sub HMinfo_purgeConfig($) {####################################################
@ -2727,9 +2812,9 @@ sub HMinfo_bpPost($) {#bp finished ############################################
$state = "ok"; $state = "ok";
} }
else{ else{
$state = join(",",map{$chkIds{$_}{shtxt}} keys%{$defs{$e}{helper}{cfgChk}}); $state = join(",",sort map{$chkIds{$_}{shtxt}} keys%{$defs{$e}{helper}{cfgChk}});
CUL_HM_complConfigTest($e); CUL_HM_complConfigTest($e);
} }
CUL_HM_UpdtReadSingle($defs{$e},"cfgState",$state,1); CUL_HM_UpdtReadSingle($defs{$e},"cfgState",$state,1);
} }
@ -3162,8 +3247,6 @@ sub HMinfo_cpRegs(@){##########################################################
return "source channel $srcCh undefined" if (!$defs{$srcCh}); return "source channel $srcCh undefined" if (!$defs{$srcCh});
return "destination channel $srcCh undefined" if (!$defs{$dstCh}); return "destination channel $srcCh undefined" if (!$defs{$dstCh});
#compare source and destination attributes #compare source and destination attributes
# return "model not compatible" if (CUL_HM_Get($ehash,$eName,"param","model") ne
# CUL_HM_Get($ehash,$eName,"param","model"));
if ($srcP){# will be peer related copy if ($srcP){# will be peer related copy
if ($srcP =~ m/self(.*)/) {$srcPid = substr($defs{$srcCh}{DEF},0,6).sprintf("%02X",$1)} if ($srcP =~ m/self(.*)/) {$srcPid = substr($defs{$srcCh}{DEF},0,6).sprintf("%02X",$1)}