############################################## # $Id$ package main; use strict; use warnings; sub HMinfo_Initialize($$); sub HMinfo_Define($$); sub HMinfo_getParam(@); sub HMinfo_regCheck(@); sub HMinfo_peerCheck(@); sub HMinfo_peerCheck(@); sub HMinfo_getEntities(@); sub HMinfo_SetFn($@); sub HMinfo_SetFnDly($); use Blocking; use HMConfig; sub HMinfo_Initialize($$) {#################################################### my ($hash) = @_; $hash->{DefFn} = "HMinfo_Define"; $hash->{SetFn} = "HMinfo_SetFn"; $hash->{GetFn} = "HMinfo_GetFn"; $hash->{AttrFn} = "HMinfo_Attr"; $hash->{AttrList} = "loglevel:0,1,2,3,4,5,6 " ."sumStatus sumERROR " ."autoUpdate autoArchive " ."hmAutoReadScan hmIoMaxDly " ."hmManualOper:0_auto,1_manual " ."configDir configFilename " .$readingFnAttributes; } sub HMinfo_Define($$){######################################################### my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my $name = $hash->{NAME}; $hash->{Version} = "01"; $attr{$name}{webCmd} = "update:protoEvents short:rssi:peerXref:configCheck:models"; $attr{$name}{sumStatus} = "battery" .",sabotageError" .",powerError" .",motor"; $attr{$name}{sumERROR} = "battery:ok" .",sabotageError:off" .",powerError:ok" .",overload:off" .",overheat:off" .",reduced:off" .",motorError:no" .",error:none" .",uncertain:yes" .",smoke_detect:none" .",cover:closed" ; $hash->{nb}{cnt} = 0; return; } sub HMinfo_Attr(@) {########################################################### my ($cmd,$name, $attrName,$attrVal) = @_; my @hashL; my $hash = $defs{$name}; if ($attrName eq "autoUpdate"){# 00:00 hh:mm delete $hash->{helper}{autoUpdate}; return if ($cmd eq "del"); my ($h,$m) = split":",$attrVal; return "please enter time [hh:mm]" if (!defined $h||!defined $m); my $sec = $h*3600+$m*60; return "give at least one minute" if ($sec < 60); $hash->{helper}{autoUpdate} = $sec; InternalTimer(gettimeofday()+$sec,"HMinfo_autoUpdate","sUpdt:".$name,0); } elsif($attrName eq "hmAutoReadScan"){# 00:00 hh:mm if ($cmd eq "del"){ $modules{CUL_HM}{hmAutoReadScan} = 4;# return to default } else{ return "please add plain integer between 1 and 300" if ( $attrVal !~ m/^(\d+)$/ ||$attrVal<0 ||$attrVal >300 ); ## implement new timer to CUL_HM $modules{CUL_HM}{hmAutoReadScan}=$attrVal; CUL_HM_queueAutoRead(""); #will restart timer } } elsif($attrName eq "hmIoMaxDly"){# if ($cmd eq "del"){ $modules{CUL_HM}{hmIoMaxDly} = 60;# return to default } else{ return "please add plain integer between 0 and 3600" if ( $attrVal !~ m/^(\d+)$/ ||$attrVal<0 ||$attrVal >3600 ); ## implement new timer to CUL_HM $modules{CUL_HM}{hmIoMaxDly}=$attrVal; } } elsif($attrName eq "hmManualOper"){# 00:00 hh:mm if ($cmd eq "del"){ $modules{CUL_HM}{helper}{hmManualOper} = 0;# default automode } else{ return "please set 0 or 1" if ($attrVal !~ m/^(0|1)/); ## implement new timer to CUL_HM $modules{CUL_HM}{helper}{hmManualOper} = substr($attrVal,0,1); } } return; } sub HMinfo_autoUpdate($){#in:name, send status-request my $name = shift; (undef,$name)=split":",$name,2; HMinfo_SetFn($defs{$name},$name,"update") if ($name); if (AttrVal($name,"autoArchive",undef) && scalar(@{$modules{CUL_HM}{helper}{confUpdt}})){ my $fN = AttrVal($name,"configFilename","regSave.cfg"); $fN = AttrVal($name,"configDir",".")."\/".$fN if ($fN !~ m/\//); HMinfo_archConfig($defs{$name},$name,"",$fN); } InternalTimer(gettimeofday()+$defs{$name}{helper}{autoUpdate}, "HMinfo_autoUpdate","sUpdt:".$name,0) if (defined $defs{$name}{helper}{autoUpdate}); } sub HMinfo_getParam(@) { ###################################################### my ($id,@param) = @_; my @paramList; my $ehash = $modules{CUL_HM}{defptr}{$id}; my $eName = $ehash->{NAME}; my $found = 0; foreach (@param){ my $para = CUL_HM_Get($ehash,$eName,"param",$_); push @paramList,sprintf("%-15s",($para eq "undefined"?" -":$para)); $found = 1 if ($para ne "undefined") ; } return $found,sprintf("%-20s\t: %s",$eName,join "\t|",@paramList); } sub HMinfo_regCheck(@) { ###################################################### my @entities = @_; my @regIncompl; my @regMissing; my @regChPend; foreach my $eName (@entities){ my $ehash = $defs{$eName}; next if (!$ehash); my @lsNo = CUL_HM_reglUsed($eName); my @mReg = (); my @iReg = (); foreach my $rNm (@lsNo){# check non-peer lists next if (!$rNm || $rNm eq ""); if ( !$ehash->{READINGS}{$rNm} || !$ehash->{READINGS}{$rNm}{VAL}) {push @mReg, $rNm;} elsif ( $ehash->{READINGS}{$rNm}{VAL} !~ m/00:00/){push @iReg, $rNm;} } push @regChPend,$eName if ($ehash->{helper}{shadowReg} && keys %{$ehash->{helper}{shadowReg}}); push @regMissing,$eName.":\t".join(",",@mReg) if (scalar @mReg); push @regIncompl,$eName.":\t".join(",",@iReg) if (scalar @iReg); } my $ret = ""; $ret .="\n\n missing register list\n " .(join "\n ",sort @regMissing) if(@regMissing); $ret .="\n\n incomplete register list\n ".(join "\n ",sort @regIncompl) if(@regIncompl); $ret .="\n\n Register changes pending\n ".(join "\n ",sort @regChPend) if(@regChPend); return $ret; } sub HMinfo_peerCheck(@) { ##################################################### my @entities = @_; my @peerIDsFail; my @peerIDsEmpty; my @peerIDnotDef; my @peerIDsNoPeer; foreach my $eName (@entities){ next if (!$defs{$eName}{helper}{role}{chn});#device has no channels next if (!CUL_HM_peerUsed($eName)); my $id = $defs{$eName}{DEF}; my $devId = substr($id,0,6); my $st = AttrVal(CUL_HM_id2Name($devId),"subType","");# from Master my $md = AttrVal(CUL_HM_id2Name($devId),"model",""); my $peerIDs = AttrVal($eName,"peerIDs",undef); if (!$peerIDs){ # no peers - is this correct? push @peerIDsEmpty,"empty: ".$eName; } elsif($peerIDs !~ m/00000000/){#peerList incomplete push @peerIDsFail,"incomplete: ".$eName.":".$peerIDs; } else{# work on a valid list: next if ($st eq "repeater"); foreach (split",",$peerIDs){ next if ($_ eq "00000000" ||$_ =~m /$devId/); my $cId = $id; if ($md eq "HM-CC-RT-DN" && $id =~ m/05$/){ # special RT climate $_ =~ s/04$/05/; # have to compare with clima_team, not clima $cId =~ s/05$/04/;# will find 04 in peerlist, not 05 } my $pDiD = substr($_,0,6) if (substr($_,6,2) eq "01"); if (!$modules{CUL_HM}{defptr}{$_} && ($pDiD && !$modules{CUL_HM}{defptr}{$pDiD})){ push @peerIDnotDef,$eName." id:".$_; } else{ my $pName = CUL_HM_id2Name($_); $pName =~s/_chn:01//; #channel 01 could be covered by device my $pPlist = AttrVal($pName,"peerIDs",""); push @peerIDsNoPeer,$eName." p:".$pName if (!$pPlist || $pPlist !~ m/$cId/); } } } } my $ret = ""; $ret .="\n\n peer list not read" ."\n ".(join "\n ",sort @peerIDsEmpty) if(@peerIDsEmpty); $ret .="\n\n peer list incomplete"."\n ".(join "\n ",sort @peerIDsFail) if(@peerIDsFail); $ret .="\n\n peer not defined" ."\n ".(join "\n ",sort @peerIDnotDef) if(@peerIDnotDef); $ret .="\n\n peer not verified" ."\n ".(join "\n ",sort @peerIDsNoPeer)if(@peerIDsNoPeer); return $ret; } sub HMinfo_burstCheck(@) { #################################################### my @entities = @_; my @needBurstMiss; my @needBurstFail; my @peerIDsCond; foreach my $eName (@entities){ next if (!$defs{$eName}{helper}{role}{chn});#device has no channels next if (!CUL_HM_peerUsed($eName)); next if (CUL_HM_Get($defs{$eName},$eName,"regList") !~ m/peerNeedsBurst/); my $peerIDs = AttrVal($eName,"peerIDs",undef); next if(!$peerIDs); # no peers - noting to check my $devId = substr($defs{$eName}{DEF},0,6); foreach (split",",$peerIDs){ next if ($_ eq "00000000" ||$_ =~m /$devId/); my $pn = CUL_HM_id2Name($_); $pn =~ s/_chn:/_chn-/; my $prxt = CUL_HM_getRxType($defs{$pn}); next if (!($prxt & 0x82)); # not a burst peer my $pnb = ReadingsVal($eName,"R-$pn-peerNeedsBurst",undef); if (!$pnb) {push @needBurstMiss, $eName;} elsif($pnb !~ m /on/){push @needBurstFail, $eName;} if ($prxt & 0x80){# conditional burst - is it on? my $pDevN = CUL_HM_getDeviceName($pn); push @peerIDsCond," $pDevN for remote $eName" if (ReadingsVal($pDevN,"R-burstRx","") !~ m /on/); } } } my $ret = ""; $ret .="\n\n peerNeedsBurst cannot be determined" ."\n ".(join "\n ",sort @needBurstMiss) if(@needBurstMiss); $ret .="\n\n peerNeedsBurst not set" ."\n ".(join "\n ",sort @needBurstFail) if(@needBurstFail); $ret .="\n\n conditionalBurst not set" ."\n ".(join "\n ",sort @peerIDsCond) if(@peerIDsCond); return $ret; } sub HMinfo_paramCheck(@) { #################################################### my @entities = @_; my @noIoDev; my @noID; my @idMismatch; foreach my $eName (@entities){ next if (!$defs{$eName}{helper}{role}{dev}); my $ehash = $defs{$eName}; my $pairId = CUL_HM_Get($ehash,$eName,"param","PairedTo"); my $IoDev = $ehash->{IODev} if ($ehash->{IODev}); my $ioHmId = AttrVal($IoDev->{NAME},"hmId","-"); if (!$IoDev) { push @noIoDev,$eName;} elsif ($pairId eq "undefined"){ push @noID,$eName;} elsif ($pairId !~ m /$ioHmId/){ push @idMismatch,"$eName paired:$pairId IO attr: $ioHmId";} } my $ret = ""; $ret .="\n\n no IO device assigned" ."\n ".(join "\n ",sort @noIoDev) if (@noIoDev); $ret .="\n\n PairedTo missing/unknown" ."\n ".(join "\n ",sort @noID) if (@noID); $ret .="\n\n PairedTo mismatch to IODev"."\n ".(join "\n ",sort @idMismatch) if (@idMismatch); return $ret; } sub HMinfo_tempList(@) { ###################################################### my ($filter,$action,$fName)=@_; $filter = "." if (!$filter); $action = "" if (!$action); my $ret; if ($action eq "save"){ open(aSave, ">$fName") || return("Can't open $fName: $!"); my @incmpl; foreach my $eN(HMinfo_getEntities("d")){#search and select channel my $md = AttrVal($eN,"model",""); my $chN; #tempList channel name if ($md =~ m/(HM-CC-RT-DN-BoM|HM-CC-RT-DN)/){ $chN = $defs{$eN}{channel_04}; } elsif ($md =~ m/(ROTO_ZEL-STG-RM-FWT|HM-CC-TC|HM-TC-IT-WM-W-EU)/){ $chN = $defs{$eN}{channel_02}; } next if (!$chN || !$defs{$chN} || $chN !~ m/$filter/); print aSave "\nentities:$chN"; my @tl = sort grep /tempList(P[123])?[SMFWT]/,keys %{$defs{$chN}{READINGS}}; if (scalar@tl != 7 && scalar@tl != 21){ print aSave "\nincomplete:$chN only data for ".join(",",@tl); push @incmpl,$chN; next; } foreach my $rd (@tl){ print aSave "\n$rd>$defs{$chN}{READINGS}{$rd}{VAL}"; } } print aSave "\n======= finished ===\n"; close(aSave); $ret = "incomplete data for ".join("\n ",@incmpl) if (scalar@incmpl); } elsif ($action eq "verify"){ open(aSave, "$fName") || return("Can't open $fName: $!"); my @el = (); my @elAll = (); my @entryFail = (); my @entryNF = (); while(){ chomp; if($_ =~ m/^entities:/){ my $line = $_; $line =~s/.*://; @el = (); foreach (split(",",$line)){ if ($defs{$_}){ push @el,$_ if ($defs{$_} && $_ =~ m/$filter/); } else{ push @entryNF,$_; } } push @elAll,@el; } elsif(@el && $_ =~ m/tempList(P[123])?[SMFWT].*\>/){ my ($tln,$val) = ($1,$2)if($_ =~ m/(.*)>(.*)/); $tln =~ s/ //g; $val =~ s/ //g; foreach my $eN(@el){ my $valR = ReadingsVal($eN,$tln,""); $valR =~ s/ //g; push @entryFail,$eN." :".$tln if ($valR ne $val); } } } $ret .= "\nentries tested:\n " .join("\n ",@elAll) if (scalar@elAll); $ret .= "\nfailed verify:\n " .join("\n ",@entryFail) if (scalar@entryFail); $ret .= "\nentries not found:\n ".join("\n ",@entryNF) if (scalar@entryNF); } elsif ($action eq "restore"){ open(aSave, "$fName") || return("Can't open $fName: $!"); my @el = (); my @elAll = (); my @entryFail = (); my @entryNF = (); my @exec = (); while(){ chomp; if($_ =~ m/^entities:/){ my $line = $_; $line =~s/.*://; @el = (); foreach (split(",",$line)){ if ($defs{$_}){ push @el,$_ if ($defs{$_} && $_ =~ m/$filter/); } else{ push @entryNF,$_; } } foreach (@exec){ my @param = split(" ",$_); CUL_HM_Set($defs{$param[0]},@param); } push @elAll,@el; } elsif(@el && $_ =~ m/tempList(P[123])?[SMFWT].*\>/){ my ($tln,$val) = ($1,$2)if($_ =~ m/(.*)>(.*)/); $tln =~ s/ //g; $val =~ tr/ +/ /; $val =~ s/^ //; $val =~ s/ $//; @exec = (); foreach my $eN(@el){ my $x = CUL_HM_Set($defs{$eN},$eN,$tln,"prep",split(" ",$val)); push @entryFail,$eN." :".$tln." respose:$x" if ($x != 1); push @exec,$eN." ".$tln." exec ".$val; } } } foreach (@exec){ my @param = split(" ",$_); CUL_HM_Set($defs{$param[0]},@param); } $ret = "failed Entries:\n " .join("\n ",@entryFail) if (scalar@entryFail); $ret = "Entries not found:\n ".join("\n ",@entryNF) if (scalar@entryNF); } else{ $ret = "$action unknown option - please use save, verify or restore"; } return $ret; } sub HMinfo_tempListTmpl(@) { ################################################## my ($filter,$tmpl,$fName)=@_; $filter = "." if (!$filter); return "no template name given" if (!$tmpl); my $ret; my @el ; foreach my $eN(HMinfo_getEntities("d")){#search for devices and select correct channel next if (!$eN); my $md = AttrVal($eN,"model",""); my $chN; #tempList channel name if ($md =~ m/(HM-CC-RT-DN-BoM|HM-CC-RT-DN)/){$chN = $defs{$eN}{channel_04};} elsif ($md =~ m/(ROTO_ZEL-STG-RM-FWT|-TC)/) {$chN = $defs{$eN}{channel_02};} next if (!$chN || !$defs{$chN} || $chN !~ m/$filter/); push @el,$chN; } return "no entities selected" if (!scalar @el); open(aSave, "$fName") || return("Can't open $fName: $!"); my $found = 0; my @entryFail = (); my @exec = (); while(){ chomp; if($_ =~ m/^entities:/){ last if ($found != 0); my $line = $_; $line =~s/.*://; foreach (split(",",$line)){ $found = 1 if ($defs{$_} && $_ eq $tmpl); } } elsif($found != 1 && $_ =~ m/tempList(P[123])?[SMFWT].*\>/){ my ($tln,$val) = ($1,$2)if($_ =~ m/(.*)>(.*)/); $tln =~ s/ //g; $val =~ tr/ +/ /; $val =~ s/^ //; $val =~ s/ $//; @exec = (); foreach my $eN(@el){ my $x = CUL_HM_Set($defs{$eN},$eN,$tln,"prep",split(" ",$val)); push @entryFail,$eN." :".$tln." respose:$x" if ($x != 1); push @exec,$eN." ".$tln." exec ".$val; } } foreach (@exec){ my @param = split(" ",$_); CUL_HM_Set($defs{$param[0]},@param); } $ret = "failed Entries:\n " .join("\n ",@entryFail) if (scalar@entryFail); } close(aSave); return $ret; } sub HMinfo_getEntities(@) { ################################################### my ($filter,$re) = @_; my @names; my ($doDev,$doChn,$doIgn,$noVrt,$noPhy,$noAct,$noSen,$doEmp); $doDev=$doChn=$doEmp= 1; $doIgn=$noVrt=$noPhy=$noAct=$noSen = 0; $filter .= "dc" if ($filter !~ m/d/ && $filter !~ m/c/); # add default $re = '.' if (!$re); if ($filter){# options provided $doDev=$doChn=$doEmp= 0;#change default no warnings; my @pl = split undef,$filter; use warnings; foreach (@pl){ $doDev = 1 if($_ eq 'd'); $doChn = 1 if($_ eq 'c'); $doIgn = 1 if($_ eq 'i'); $noVrt = 1 if($_ eq 'v'); $noPhy = 1 if($_ eq 'p'); $noAct = 1 if($_ eq 'a'); $noSen = 1 if($_ eq 's'); $doEmp = 1 if($_ eq 'e'); } } # generate entity list foreach my $id (sort(keys%{$modules{CUL_HM}{defptr}})){ next if ($id eq "000000"); my $eHash = $modules{CUL_HM}{defptr}{$id}; my $eName = $eHash->{NAME}; my $isChn = (length($id) != 6 || CUL_HM_Get($eHash,$eName,"param","channel_01") eq "undefined")?1:0; my $eMd = CUL_HM_Get($eHash,$eName,"param","model"); my $eIg = CUL_HM_Get($eHash,$eName,"param","ignore"); $eIg = "" if ($eIg eq "undefined"); next if (!(($doDev && length($id) == 6) || ($doChn && $isChn))); next if (!$doIgn && $eIg); next if ( $noVrt && $eMd =~ m/^virtual/); next if ( $noPhy && $eMd !~ m/^virtual/); my $eSt = CUL_HM_Get($eHash,$eName,"param","subType"); 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 ( $eName !~ m/$re/); push @names,$eName; } return sort(@names); } sub HMinfo_getMsgStat() { ##################################################### my ($hr,$dr,$hs,$ds); $hr = sprintf("\n %-14s:","receive hour"); $hs = sprintf("\n %-14s:","send hour"); $dr = sprintf("\n %-14s:","receive day"); $ds = sprintf("\n %-14s:","send day"); $hr .= sprintf("| %02d",$_) foreach (0..23); $hs .= sprintf("| %02d",$_) foreach (0..23); $dr .= sprintf("|%4s",$_) foreach ("Mon","Tue","Wed","Thu","Fri","Sat","Sun","# tdy"); $ds .= sprintf("|%4s",$_) foreach ("Mon","Tue","Wed","Thu","Fri","Sat","Sun","# tdy"); foreach my $ioD(keys %{$modules{CUL_HM}{stat}{r}}){ next if ($ioD eq "dummy"); $hr .= sprintf("\n %-10s:",$ioD); $hs .= sprintf("\n %-10s:",$ioD); $dr .= sprintf("\n %-10s:",$ioD); $ds .= sprintf("\n %-10s:",$ioD); $hr .= sprintf("|%3d",$modules{CUL_HM}{stat}{r}{$ioD}{h}{$_}) foreach (0..23); $hs .= sprintf("|%3d",$modules{CUL_HM}{stat}{s}{$ioD}{h}{$_}) foreach (0..23); $dr .= sprintf("|%4d",$modules{CUL_HM}{stat}{r}{$ioD}{d}{$_}) foreach (0..6); $ds .= sprintf("|%4d",$modules{CUL_HM}{stat}{s}{$ioD}{d}{$_}) foreach (0..6); my ($tdr,$tds); $tdr += $modules{CUL_HM}{stat}{r}{$ioD}{h}{$_} foreach (0..23); $tds += $modules{CUL_HM}{stat}{s}{$ioD}{h}{$_} foreach (0..23); $dr .= sprintf("|#%4d",$tdr); $ds .= sprintf("|#%4d",$tds); } my @l = localtime(gettimeofday()); my $tsts = "\n |"; $tsts .= "----" foreach (1..$l[2]); $tsts .= ">*" ; return "msg statistics\n" .$tsts .$hr.$hs .$tsts .$dr.$ds ; } sub HMinfo_GetFn($@) {######################################################### my ($hash,$name,$cmd,@a) = @_; my ($opt,$optEmpty,$filter) = ("",1,""); my $ret; if (@a && ($a[0] =~ m/^-/) && ($a[0] !~ m/^-f$/)){# options provided $opt = $a[0]; $optEmpty = ($opt =~ m/e/)?1:0; shift @a; #remove } if (@a && $a[0] =~ m/^-f$/){# options provided shift @a; #remove $filter = shift @a; } $cmd = "?" if(!$cmd);# by default print options if ($cmd eq "protoEvents"){##print protocol-events------------------------- my ($type) = @a; $type = "long" if(!$type); my @paramList; my @IOlist; my @plSum; push @plSum,0 for (0..9);#prefill foreach my $dName (HMinfo_getEntities($opt."d",$filter)){ my $id = $defs{$dName}{DEF}; my ($found,$para) = HMinfo_getParam($id, ,"protState","protCmdPend" ,"protSnd","protLastRcv","protResnd" ,"protCmdDel","protResndFail","protNack","protIOerr"); $para =~ s/( last_at|20..-|\|)//g; my @pl = split "\t",$para; foreach (@pl){ $_ =~ s/\s+$|//g ; $_ =~ s/CMDs_//; $_ =~ s/..-.. ..:..:..//g if ($type eq "short"); $_ =~ s/CMDs // if ($type eq "short"); } for (1..9){ my ($x) = $pl[$_] =~ /(\d+)/; $plSum[$_] += $x if ($x); } if ($type eq "short"){ push @paramList, sprintf("%-20s%-17s|%-10s|%-10s|%-10s#%-10s|%-10s|%-10s|%-10s", @pl[0..3],@pl[5..9]); } else{ push @paramList, sprintf("%-20s%-17s|%-18s|%-18s|%-14s|%-18s#%-18s|%-18s|%-18s|%-18s", @pl[0..9]); } push @IOlist,$defs{$pl[0]}{IODev}->{NAME}; } my $hdr = sprintf("%-20s:%-16s|%-18s|%-18s|%-14s|%-18s#%-18s|%-18s|%-18s|%-18s", ,"name" ,"State","CmdPend" ,"Snd","LastRcv","Resnd" ,"CmdDel","ResndFail","Nack","IOerr"); $hdr = sprintf("%-20s:%-16s|%-10s|%-10s|%-10s#%-10s|%-10s|%-10s|%-10s", ,"name" ,"State","CmdPend" ,"Snd","Resnd" ,"CmdDel","ResndFail","Nack","IOerr") if ($type eq "short"); $ret = $cmd." done:" ."\n ".$hdr ."\n ".(join "\n ",sort @paramList); $ret .= "\n=======================================================" ."========================================================="; if ($type eq "short"){ $ret .= "\n ".sprintf("%-20s%-17s|%-10s|%-10s|%-10s#%-10s|%-10s|%-10s|%-10s","sum",@plSum[1..3],@plSum[5..9]); } else{ $ret .= "\n ".sprintf("%-20s%-17s|%-18s|%-18s|%-14s|%-18s#%-18s|%-18s|%-18s|%-18s","sum",@plSum[1..9]); } $ret .= "\n\n CUL_HM queue length:$modules{CUL_HM}{prot}{rspPend}"; $ret .= "\n"; $ret .= "\n requests pending"; $ret .= "\n ----------------"; $ret .= "\n autoReadReg :".join(", ",@{$modules{CUL_HM}{helper}{qReqConf}}); $ret .= "\n recent :".($modules{CUL_HM}{helper}{autoRdActive}?$modules{CUL_HM}{helper}{autoRdActive}:"none"); $ret .= "\n status request :".join(", ",@{$modules{CUL_HM}{helper}{qReqStat}}) ; $ret .= "\n autoReadReg wakeup :".join(", ",@{$modules{CUL_HM}{helper}{qReqConfWu}}); $ret .= "\n status request wakeup:".join(", ",@{$modules{CUL_HM}{helper}{qReqStatWu}}); $ret .= "\n autoReadTest :".join(", ",@{$modules{CUL_HM}{helper}{confCheckArr}}); $ret .= "\n"; @IOlist = HMinfo_noDup(@IOlist); foreach(@IOlist){ $_ .= ":".$defs{$_}{STATE} .(defined $defs{$_}{helper}{q} ? " pending=".$defs{$_}{helper}{q}{answerPend} : "" ) ." condition:".ReadingsVal($_,"cond","-") .(defined $defs{$_}{msgLoadEst} ? "\n msgLoadEst: ".$defs{$_}{msgLoadEst} : "" ) ; } $ret .= "\n IODevs:".(join"\n ",HMinfo_noDup(@IOlist)); } elsif($cmd eq "msgStat") {##print message statistics---------------------- $ret = HMinfo_getMsgStat(); } elsif($cmd eq "rssi") {##print RSSI protocol-events-------------------- my @rssiList; foreach my $dName (HMinfo_getEntities($opt."d",$filter)){ foreach my $dest (keys %{$defs{$dName}{helper}{rssi}}){ my $dispName = $dName; my $dispDest = $dest; if ($dest =~ m/^at_(.*)/){ $dispName = $1; $dispDest = (($dest =~ m/^to_rpt_/)?"rep_":"").$dName; } if (AttrVal($dName,"subType","") eq "virtual"){ my $h = InternalVal($dName,"IODev",""); $dispDest .= "/$h->{NAME}"; } push @rssiList,sprintf("%-15s:%-15s %-15s %6.1f %6.1f %6.1f<%6.1f %5s" ,$dName,$dispName,$dispDest ,$defs{$dName}{helper}{rssi}{$dest}{lst} ,$defs{$dName}{helper}{rssi}{$dest}{avg} ,$defs{$dName}{helper}{rssi}{$dest}{min} ,$defs{$dName}{helper}{rssi}{$dest}{max} ,$defs{$dName}{helper}{rssi}{$dest}{cnt} ); } } $ret = $cmd." done:"."\n "."Device :receive from last avg min{helper}{r}{$rN} = "" if (!defined($hash->{helper}{r}{$rN})); $hash->{helper}{r}{$rN} .= sprintf("%16s",$val); if ($pt ne $ptOld){ $ptLine .= sprintf("%16s",$pt); $ptOld = $pt; } if ($peer ne $peerOld){ $peerLine .= sprintf("%32s",$peer); $peerOld = $peer; } } $RegReply .= $peerLine."\n".$ptLine."\n"; foreach my $rN (sort keys %{$hash->{helper}{r}}){ $RegReply .= $rN.$hash->{helper}{r}{$rN}."\n"; } delete $hash->{helper}{r}; } $ret = "No regs found for:".join(",",sort @noReg)."\n\n" .$RegReply; } elsif($cmd eq "param") {##print param ---------------------------------- my @paramList; foreach my $dName (HMinfo_getEntities($opt,$filter)){ my $id = $defs{$dName}{DEF}; my ($found,$para) = HMinfo_getParam($id,@a); push @paramList,$para if($found || $optEmpty); } my $prtHdr = "entity \t: "; $prtHdr .= sprintf("%-20s \t|",$_)foreach (@a); $ret = $cmd." done:" ."\n param list" ."\n " .$prtHdr ."\n " .(join "\n ",sort @paramList) ; } elsif($cmd eq "regCheck") {##check register-------------------------------- my @entities = HMinfo_getEntities($opt."v",$filter); $ret = $cmd." done:" .HMinfo_regCheck(@entities); } elsif($cmd eq "peerCheck") {##check peers----------------------------------- my @entities = HMinfo_getEntities($opt."v",$filter); $ret = $cmd." done:" .HMinfo_peerCheck(@entities); } elsif($cmd eq "configCheck"){##check peers and register---------------------- my @entities = HMinfo_getEntities($opt."v",$filter); $ret = $cmd." done:" .HMinfo_regCheck(@entities) .HMinfo_peerCheck(@entities) .HMinfo_burstCheck(@entities) .HMinfo_paramCheck(@entities); } elsif($cmd eq "peerXref") {##print cross-references------------------------ my @peerPairs; foreach my $dName (HMinfo_getEntities($opt,$filter)){ my $peerIDs = AttrVal($dName,"peerIDs",undef); foreach (split",",$peerIDs){ next if ($_ eq "00000000"); my $pName = CUL_HM_id2Name($_); my $pPlist = AttrVal($pName,"peerIDs",""); $pName =~ s/$dName\_chn:/self/; push @peerPairs,$dName." =>".$pName; } } $ret = $cmd." done:" ."\n x-ref list" ."\n ".(join "\n ",sort @peerPairs) ; } elsif($cmd eq "models") {##print capability, models---------------------- my $th = \%HMConfig::culHmModel; my @model; foreach (keys %{$th}){ my $mode = $th->{$_}{rxt}; $mode =~ s/c/config/; $mode =~ s/w/wakeup/; $mode =~ s/b/burst/; $mode =~ s/l/lazyConf/; $mode =~ s/\bf\b/burstCond/; $mode =~ s/:/,/g; $mode = "normal" if (!$mode); my $list = $th->{$_}{lst}; $list =~ s/.://g; $list =~ s/p//; my $chan = ""; foreach (split",",$th->{$_}{chn}){ my ($n,$s,$e) = split(":",$_); $chan .= $s.(($s eq $e)?"":("-".$e))." ".$n.", "; } push @model,sprintf("%-16s %-24s %4s %-24s %-5s %-5s %s" ,$th->{$_}{st} ,$th->{$_}{name} ,$_ ,$mode ,$th->{$_}{cyc} ,$list ,$chan ); } $ret = $cmd.($filter?" filtered":"").":$filter\n " .sprintf("%-16s %-24s %4s %-24s %-5s %-5s %s\n " ,"subType" ,"name" ,"ID" ,"supportedMode" ,"Info" ,"List" ,"channels" ) .join"\n ",grep(/$filter/,sort @model); } elsif($cmd eq "templateList"){##template: list templates -------------------- return HMinfo_templateList($a[0]); } elsif($cmd eq "templateChk"){##template: see if it applies ------------------ my $repl; foreach my $dName (HMinfo_getEntities($opt."v",$filter)){ unshift @a, $dName; $repl .= HMinfo_templateChk(@a); shift @a; } return $repl; } elsif($cmd eq "help") { $ret = " Unknown argument $cmd, choose one of " ."\n ---checks---" ."\n get configCheck [] # perform regCheck and regCheck" ."\n get regCheck [] # find incomplete or inconsistant register readings" ."\n get peerCheck [] # find incomplete or inconsistant peer lists" ."\n ---actions---" ."\n set saveConfig [] [] # stores peers and register with saveConfig" ."\n set archConfig [-a] [] # as saveConfig but only if data of entity is complete" ."\n set purgeConfig [] # purge content of saved configfile " ."\n set loadConfig [] # restores register and peer readings if missing" ."\n set autoReadReg [] # trigger update readings if attr autoReadReg is set" ."\n set tempList [][save|restore|verify][]# handle tempList of thermostat devices" ."\n set tempListTmpl[][templateName][]# program a templist from a template in the file to one or multiple devices" ."\n ---infos---" ."\n set update # update HMindfo counts" ."\n get register [] # devicefilter parse devicename. Partial strings supported" ."\n get peerXref [] # peer cross-reference" ."\n get models [] # list of models incl native parameter" ."\n get protoEvents [] [short|long] # protocol status - names can be filtered" ."\n get msgStat # view message statistic" ."\n get param [] [] [] ... # displays params for all entities as table" ."\n get rssi [] # displays receive level of the HM devices" ."\n last: most recent" ."\n avg: average overall" ."\n range: min to max value" ."\n count: number of events in calculation" ."\n ---clear status---" ."\n set clear [] [Protocol|readings|msgStat|register|rssi]" ."\n Protocol # delete all protocol-events" ."\n readings # delete all readings" ."\n register # delete all register-readings" ."\n rssi # delete all rssi data" ."\n msgStat # delete message statistics" ."\n ---help---" ."\n get help #" ."\n ***footnote***" ."\n [] : only matiching names are processed - partial names are possible" ."\n [] : any match in the output are searched. " ."\n" ."\n set cpRegs " ."\n copy register for a channel or behavior of channel/peer" ."\n set templateDef ...] : [:] ... " ."\n define a template" ."\n set templateSet [ ...] " ."\n write register according to a given template" ."\n get templateChk [] [ ...] " ."\n compare whether register match the template values" ."\n get templateList [] # gives a list of templates or a description of the named template" ."\n list all currently defined templates or the structure of a given template" ."\n ======= typeFilter options: supress class of devices ====" ."\n set [-dcasev] [-f ] [params]" ."\n entities according to list will be processed" ."\n d - device :include devices" ."\n c - channels :include channels" ."\n i - ignore :include devices marked as ignore" ."\n v - virtual :supress fhem virtual" ."\n p - physical :supress physical" ."\n a - aktor :supress actor" ."\n s - sensor :supress sensor" ."\n e - empty :include results even if requested fields are empty" ."\n " ."\n -f - filter :regexp to filter entity names " ."\n " ; } else{ my @cmdLst = ( "help" ,"configCheck","param","peerCheck","peerXref" ,"protoEvents","msgStat","rssi" ,"models" ,"clear" ,"regCheck","register" ,"templateList","templateChk" ); $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst); } return $ret; } sub HMinfo_SetFn($@) {######################################################### my ($hash,$name,$cmd,@a) = @_; my @in = @a; my ($opt,$optEmpty,$filter) = ("",1,""); my $ret; if (@a && ($a[0] =~ m/^-/) && ($a[0] !~ m/^-f$/)){# options provided $opt = $a[0]; $optEmpty = ($opt =~ m/e/)?1:0; shift @a; #remove } if (@a && $a[0] =~ m/^-f$/){# options provided shift @a; #remove $filter = shift @a; } $cmd = "?" if(!$cmd);# by default print options if ($cmd eq "clear" ) {##actionImmediate: clear parameter-------------- my ($type) = @a; if ($type eq "msgStat"){ foreach (keys %{$modules{CUL_HM}{stat}{r}}){ next if ($_ ne "dummy"); delete $modules{CUL_HM}{stat}{$_}; delete $modules{CUL_HM}{stat}{r}{$_}; delete $modules{CUL_HM}{stat}{s}{$_}; } return; } else{ return "unknown parameter - use Protocol, readings, msgStat, register or rssi" if ($type !~ m/^(Protocol|readings|register|rssi)$/); $opt .= "d" if ($type !~ m/(readings|register)/);# readings apply to all, others device only my @entities; $type = "msgEvents" if ($type eq "Protocol");# translate parameter foreach my $dName (HMinfo_getEntities($opt,$filter)){ push @entities,$dName; CUL_HM_Set($defs{$dName},$dName,"clear",$type); } return $cmd.$type." done:" ."\n cleared" ."\n ".(join "\n ",sort @entities) ; } } elsif($cmd eq "autoReadReg"){##actionImmediate: re-issue register Read------- my @entities; foreach my $dName (HMinfo_getEntities($opt."dv",$filter)){ next if (!substr(AttrVal($dName,"autoReadReg","0"),0,1)); CUL_HM_qAutoRead($dName,1); push @entities,$dName; } return $cmd." done:" ."\n triggered:" ."\n ".(join "\n ",sort @entities) ; } elsif($cmd eq "templateSet"){##template: set of register -------------------- return HMinfo_templateSet(@a); } elsif($cmd eq "templateDef"){##template: define one ------------------------- return HMinfo_templateDef(@a); } elsif($cmd eq "cpRegs") {##copy register -------------------- return HMinfo_cpRegs(@a); } elsif($cmd eq "update") {##update hm counts ----------------------------- $ret = HMinfo_status($hash); } elsif($cmd eq "tempList") {##handle thermostat templist from file --------- my $fn = $a[1]?$a[1]:"tempList.cfg"; $fn = AttrVal($name,"configDir",".")."\/".$fn if ($fn !~ m/\//); $ret = HMinfo_tempList($filter,$a[0],$fn); } elsif($cmd eq "tempListTmpl"){##handle thermostat templist from file -------- my $fn = $a[1]?$a[1]:"tempList.cfg"; $fn = AttrVal($name,"configDir",".")."\/".$fn if ($fn !~ m/\//); $ret = HMinfo_tempListTmpl($filter,$a[0],$fn); } elsif($cmd eq "loadConfig") {##action: loadConfig---------------------------- my $fn = $a[0]?$a[0]:AttrVal($name,"configFilename","regSave.cfg"); $fn = AttrVal($name,"configDir",".")."\/".$fn if ($fn !~ m/\//); $ret = HMinfo_loadConfig($filter,$fn); } elsif($cmd eq "purgeConfig"){##action: purgeConfig--------------------------- my $id = ++$hash->{nb}{cnt}; my $fn = $a[0]?$a[0]:AttrVal($name,"configFilename","regSave.cfg"); $fn = AttrVal($name,"configDir",".")."\/".$fn if ($fn !~ m/\//); my $bl = BlockingCall("HMinfo_purgeConfig", join(",",("$name:$id",$fn)), "HMinfo_bpPost", 30, "HMinfo_bpAbort", "$name:$id"); $hash->{nb}{$id}{$_} = $bl->{$_} foreach (keys %{$bl}); $ret = ""; } elsif($cmd eq "saveConfig") {##action: saveConfig---------------------------- my $id = ++$hash->{nb}{cnt}; my $fn = $a[0]?$a[0]:AttrVal($name,"configFilename","regSave.cfg"); $fn = AttrVal($name,"configDir",".")."\/".$fn if ($fn !~ m/\//); my $bl = BlockingCall("HMinfo_saveConfig", join(",",("$name:$id",$fn,$opt,$filter)), "HMinfo_bpPost", 30, "HMinfo_bpAbort", "$name:$id"); $hash->{nb}{$id}{$_} = $bl->{$_} foreach (keys %{$bl}); $ret = $cmd." done:" ."\n saved"; } elsif($cmd eq "archConfig") {##action: archiveConfig------------------------- # save config only if register are complete $ret = HMinfo_archConfig($hash,$name,$opt,($a[0]?$a[0]:"")); } ### redirect set commands to get - thus the command also work in webCmd elsif(HMinfo_GetFn($hash,$name,"?") =~ m/\b$cmd\b/){##---------------- $ret = HMinfo_GetFn($hash,$name,$cmd,@a); } else{ my @cmdLst = ( "autoReadReg","clear" ,"archConfig:-0,-a","saveConfig","loadConfig","purgeConfig","update" ,"cpRegs" ,"tempList tempListTmpl" ,"templateDef","templateSet"); $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst); } return $ret; } sub HMInfo_help(){ return " Unknown argument choose one of " ."\n ---checks---" ."\n get configCheck [] # perform regCheck and regCheck" ."\n get regCheck [] # find incomplete or inconsistant register readings" ."\n get peerCheck [] # find incomplete or inconsistant peer lists" ."\n ---actions---" ."\n set saveConfig [] [] # stores peers and register with saveConfig" ."\n set archConfig [-a] [] # as saveConfig but only if data of entity is complete" ."\n set purgeConfig [] # purge content of saved configfile " ."\n set loadConfig [] # restores register and peer readings if missing" ."\n set autoReadReg [] # trigger update readings if attr autoReadReg is set" ."\n set tempList [][save|restore|verify][]# handle tempList of thermostat devices" ."\n set tempListTmpl[][templateName][]# program a templist from a template in the file to one or multiple devices" ."\n ---infos---" ."\n set update # update HMindfo counts" ."\n get register [] # devicefilter parse devicename. Partial strings supported" ."\n get peerXref [] # peer cross-reference" ."\n get models [] # list of models incl native parameter" ."\n get protoEvents [] [short|long] # protocol status - names can be filtered" ."\n get msgStat # view message statistic" ."\n get param [] [] [] ... # displays params for all entities as table" ."\n get rssi [] # displays receive level of the HM devices" ."\n last: most recent" ."\n avg: average overall" ."\n range: min to max value" ."\n count: number of events in calculation" ."\n ---clear status---" ."\n set clear [] [Protocol|readings|msgStat|register|rssi]" ."\n Protocol # delete all protocol-events" ."\n readings # delete all readings" ."\n register # delete all register-readings" ."\n rssi # delete all rssi data" ."\n msgStat # delete message statistics" ."\n ---help---" ."\n get help #" ."\n ***footnote***" ."\n [] : only matiching names are processed - partial names are possible" ."\n [] : any match in the output are searched. " ."\n" ."\n set cpRegs " ."\n copy register for a channel or behavior of channel/peer" ."\n set templateDef ...] : [:] ... " ."\n define a template" ."\n set templateSet [ ...] " ."\n write register according to a given template" ."\n get templateChk [] [ ...] " ."\n compare whether register match the template values" ."\n get templateList [] # gives a list of templates or a description of the named template" ."\n list all currently defined templates or the structure of a given template" ."\n ======= typeFilter options: supress class of devices ====" ."\n set [-dcasev] [-f ] [params]" ."\n entities according to list will be processed" ."\n d - device :include devices" ."\n c - channels :include channels" ."\n i - ignore :include devices marked as ignore" ."\n v - virtual :supress fhem virtual" ."\n p - physical :supress physical" ."\n a - aktor :supress actor" ."\n s - sensor :supress sensor" ."\n e - empty :include results even if requested fields are empty" ."\n " ."\n -f - filter :regexp to filter entity names " ."\n " ; } sub HMinfo_loadConfig($@) {#################################################### my ($filter,$fName)=@_; $filter = "." if (!$filter); my $ret; open(aSave, "$fName") || return("Can't open $fName: $!"); my @el = (); my @elincmpl = (); my @entryNF = (); while(){ chomp; my $line = $_; next if ( $line !~ m/set .* (peerBulk|regBulk) .*/ && $line !~ m/attr .*/); my ($cmd1,$eN,$cmd,$param) = split(" ",$line,4); next if ($eN !~ m/$filter/); if (!$eN || !$defs{$eN}){ push @entryNF,$eN; next; } if ($cmd1 eq "setreading"){ $defs{$eN}{READINGS}{$cmd}{VAL} = $param; $defs{$eN}{READINGS}{$cmd}{TIME} = "from archive"; } elsif($cmd eq "peerBulk"){ next if(!$param); $param =~ s/ //g; if ($param !~ m/00000000/){ push @elincmpl,"$eN peerList"; next; } if (!AttrVal($eN,"peerIDs","")){ CUL_HM_ID2PeerList($eN,$_,1) foreach (grep /[0-9A-F]{8}/,split(",",$param)); push @el,"$eN peerIDs"; } } elsif($cmd eq "regBulk"){ my $exp = CUL_HM_getAttrInt($eN,"expert"); $param =~ s/\.RegL/RegL/; $param =~ s/RegL/\.RegL/ if ($exp != 2); my ($reg,$data) = split(" ",$param,2); if ($data !~ m/00:00/){ push @elincmpl,"$eN reg list:$reg"; next; } if (!$defs{$eN}{READINGS}{$reg}){ my ($list,$pN) = ($1,$2) if ($reg =~ m/RegL_(..):(.*)/); my $pId = CUL_HM_peerChId($pN,substr($defs{$eN}{DEF},0,6),"00000000"); $defs{$eN}{READINGS}{$reg}{VAL} = $data; $defs{$eN}{READINGS}{$reg}{TIME} = "from archive"; CUL_HM_updtRegDisp($defs{$eN},$list,$pId); push @el,"$eN reg list:$reg"; } } } $ret .= "\nadded data:\n " .join("\n ",@el) if (scalar@el); $ret .= "\nfile data incomplete:\n ".join("\n ",@elincmpl) if (scalar@elincmpl); $ret .= "\nentries not defind:\n " .join("\n ",@entryNF) if (scalar@entryNF); return $ret; } sub HMinfo_purgeConfig($) {#################################################### my ($param) = @_; my ($id,$fName) = split ",",$param; $fName = "regSave.cfg" if (!$fName); open(aSave, "$fName") || return("Can't open $fName: $!"); my %purgeH; while(){ chomp; my $line = $_; next if ( $line !~ m/set (.*) (peerBulk|regBulk) (.*)/ && $line !~ m/setreading .*/); my ($cmd,$eN,$typ,$p1,$p2) = split(" ",$line,5); if ($cmd eq "set" && $typ eq "regBulk"){ $typ .= " $p1"; $p1 = $p2; } elsif ($cmd eq "set" && $typ eq "peerBulk"){ delete $purgeH{$eN}{$cmd}{regBulk};# regBulk needs to be rewritten } $purgeH{$eN}{$cmd}{$typ} = $p1; } close(aSave); open(aSave, ">$fName") || return("Can't open $fName: $!"); print aSave "\n\n#============data purged: ".TimeNow(); foreach my $eN(sort keys %purgeH){ next if (!defined $defs{$eN}); print aSave "\n\n#-------------- entity:".$eN." ------------"; foreach my $cmd (sort keys %{$purgeH{$eN}}){ foreach my $typ (sort keys %{$purgeH{$eN}{$cmd}}){ print aSave "\n$cmd $eN $typ ".$purgeH{$eN}{$cmd}{$typ}; } } } print aSave "\n======= finished ===\n"; close(aSave); return $id; } sub HMinfo_saveConfig($) {##################################################### my ($param) = @_; my ($id,$fN,$opt,$filter,$strict) = split ",",$param; $strict = "" if (!defined $strict); my @entities; foreach my $dName (HMinfo_getEntities($opt."dv",$filter)){ CUL_HM_Get($defs{$dName},$dName,"saveConfig",$fN,$strict); push @entities,$dName; foreach my $chnId (CUL_HM_getAssChnIds($dName)){ my $dName = CUL_HM_id2Name($chnId); push @entities, $dName if($dName !~ m/_chn:/); } } HMinfo_purgeConfig($param) if (-e $fN && 200000 < -s $fN);# auto purge if file to big return $id; } sub HMinfo_archConfig($$$$) {################################################## # save config only if register are complete my ($hash,$name,$opt,$fN) = @_; $fN = $fN?$fN:AttrVal($name,"configFilename","regSave.cfg"); $fN = AttrVal($name,"configDir",".")."\/".$fN if ($fN !~ m/\//); my $id = ++$hash->{nb}{cnt}; my $bl = BlockingCall("HMinfo_archConfigExec", join(",",("$name:$id" ,$fN ,$opt)), "HMinfo_archConfigPost", 30, "HMinfo_bpAbort", "$name:$id"); $hash->{nb}{$id}{$_} = $bl->{$_} foreach (keys %{$bl}); @{$modules{CUL_HM}{helper}{confUpdt}} = (); return ; } sub HMinfo_archConfigExec($) {################################################ # save config only if register are complete my ($id,$fN,$opt) = split ",",shift; my @eN; if ($opt eq "-a"){@eN = HMinfo_getEntities("d","");} else {@eN = @{$modules{CUL_HM}{helper}{confUpdt}}} my @names; push @names,CUL_HM_getAssChnNames($_) foreach(@eN); @{$modules{CUL_HM}{helper}{confUpdt}} = (); my @archs; @eN = (); foreach(HMinfo_noDup(@names)){ if (CUL_HM_peersValid($_) !=1 ||HMinfo_regCheck($_)){ push @eN,$_; } else{ push @archs,$_; } } HMinfo_saveConfig(join(",",( $id ,$fN ,"c" ,"\^(".join("|",@archs).")\$") ,"strict")); return (@eN ? join(",",@eN) : ""); } sub HMinfo_archConfigPost($) {################################################ my $post = shift; push @{$modules{CUL_HM}{helper}{confUpdt}},split(",",$post) if ($post); return ; } sub HMinfo_bpPost($) {#bp finished############################################# my ($rep) = @_; my ($name,$id) = split(":",$rep); delete $defs{$name}{nb}{$id}; return; } sub HMinfo_bpAbort($) {#bp timeout ############################################ my ($rep) = @_; my ($name,$id) = split(":",$rep); delete $defs{$name}{nb}{$id}; return; } sub HMinfo_status($){########################################################## # - count defined HM entities, selected readings, errors on filtered readings # - display Assigned IO devices # - show ActionDetector status # - prot events if error # - rssi - eval minimum values my $hash = shift; my $name = $hash->{NAME}; my ($nbrE,$nbrD,$nbrC,$nbrV) = (0,0,0,0);# count entities and types #--- used for status my @info = split ",",$attr{$name}{sumStatus};#prepare event my %sum; #--- used for error counts my @erro = split ",",$attr{$name}{sumERROR}; my %errFlt; my %err; my @errNames; foreach (@erro){ #prepare reading filter for error counts my ($p,@a) = split ":",$_; $errFlt{$p}{x}=1; # add at least one reading $errFlt{$p}{$_}=1 foreach (@a); } #--- used for IO, protocol and communication (e.g. rssi) my @IOdev; my %protC = (ErrIoId_ =>0,ErrIoAttack =>0); my %protE = (NACK =>0,IOerr =>0,ResndFail =>0,CmdDel =>0); my %protW = (Resnd =>0,CmdPend =>0); my @protNamesC; # devices with current protocol Critical my @protNamesE; # devices with current protocol Errors my @protNamesW; # devices with current protocol Warnings my @Anames; # devices with ActionDetector events my %rssiMin; my %rssiMinCnt = ("99>"=>0,"80>"=>0,"60>"=>0,"59<"=>0); my @rssiNames; #entities with ciritcal RSSI my @shdwNames; #entites with shadowRegs, i.e. unconfirmed register ->W_unconfRegs foreach my $id (keys%{$modules{CUL_HM}{defptr}}){#search/count for parameter my $ehash = $modules{CUL_HM}{defptr}{$id}; my $eName = $ehash->{NAME}; $nbrE++; $nbrC++ if ($ehash->{helper}{role}{chn}); $nbrV++ if ($ehash->{helper}{role}{vrt}); push @shdwNames,$eName if (keys %{$ehash->{helper}{shadowReg}}); foreach my $read (grep {$ehash->{READINGS}{$_}} @info){ #---- count critical readings my $val = $ehash->{READINGS}{$read}{VAL}; $sum{$read}{$val} =0 if (!$sum{$read}{$val}); $sum{$read}{$val}++; } foreach my $read (grep {$ehash->{READINGS}{$_}} keys %errFlt){#---- count error readings my $val = $ehash->{READINGS}{$read}{VAL}; next if (grep (/$val/,(keys%{$errFlt{$read}})));# filter non-Error $err{$read}{$val} =0 if (!$err{$read}{$val}); $err{$read}{$val}++; push @errNames,$eName; } if ($ehash->{helper}{role}{dev}){#---restrict to devices $nbrD++; push @IOdev,$ehash->{IODev}{NAME} if($ehash->{IODev} && $ehash->{IODev}{NAME}); push @Anames,$eName if ($attr{$eName}{actStatus} && $attr{$eName}{actStatus} ne "alive"); foreach (grep /ErrIoId_/, keys %{$ehash}){# detect addtional critical entries my $k = $_; $k =~ s/^prot//; $protC{$k} = 0 if(!defined $protC{$_}); } foreach (grep {$ehash->{"prot".$_}} keys %protC){#protocol critical alarms $protC{$_}++; push @protNamesC,$eName; } foreach (grep {$ehash->{"prot".$_}} keys %protE){#protocol errors $protE{$_}++; push @protNamesE,$eName; } foreach (grep {$ehash->{"prot".$_}} keys %protW){#protocol events reported $protW{$_}++; push @protNamesW,$eName; } $rssiMin{$eName} = 0; foreach (keys %{$ehash->{helper}{rssi}}){ next if($_ !~ m /at_.*$ehash->{IODev}->{NAME}/ );#ignore unused IODev $rssiMin{$eName} = $ehash->{helper}{rssi}{$_}{min} if ($rssiMin{$eName} > $ehash->{helper}{rssi}{$_}{min}); } } } #====== collection finished - start data preparation====== delete $hash->{$_} foreach (grep(/^(ERR|W_|I_|C_)/,keys%{$hash}));# remove old my @updates; foreach my $read(grep {defined $sum{$_}} @info){ #--- disp crt count my $d; $d .= "$_:$sum{$read}{$_};"foreach(keys %{$sum{$read}}); push @updates,"I_sum_$read:".$d; } foreach my $read(grep {defined $err{$_}} keys %errFlt){#--- disp err count my $d; $d .= "$_:$err{$read}{$_};"foreach(keys %{$err{$read}}); push @updates,"ERR_$read:".$d; } @errNames = grep !/^$/,HMinfo_noDup(@errNames); $hash->{ERR_names} = join",",@errNames if(@errNames);# and name entities push @updates,"C_sumDefined:"."entities:$nbrE device:$nbrD channel:$nbrC virtual:$nbrV"; # ------- display status of action detector ------ push @updates,"I_actTotal:".$modules{CUL_HM}{defptr}{"000000"}{STATE}; $hash->{ERRactNames} = join",",@Anames if (@Anames); # ------- what about IO devices??? ------ my %tmp; # remove duplicates $tmp{$_}=0 for @IOdev; delete $tmp{""}; #remove empties if present @IOdev = sort keys %tmp; foreach (grep {$defs{$_}{READINGS}{cond}} @IOdev){ $_ .= ",:".$defs{$_}{READINGS}{cond}{VAL}; } $hash->{I_HM_IOdevices}= join",",@IOdev; # ------- what about protocol events ------ # Current Events are Rcv,NACK,IOerr,Resend,ResendFail,Snd # additional variables are protCmdDel,protCmdPend,protState,protLastRcv my @tpc; push @tpc,"$_:$protC{$_}" foreach (grep {$protC{$_}} keys(%protC)); if(@tpc){push @updates,"CRIT__protocol:".join",",@tpc;} else{delete $hash->{READINGS}{CRIT__protocol} }; my @tpe; push @tpe,"$_:$protE{$_}" foreach (grep {$protE{$_}} keys(%protE)); if(@tpe){push @updates,"ERR__protocol:".join",",@tpe;} else{ delete $hash->{READINGS}{ERR__protocol} }; my @tpw; push @tpw,"$_:$protW{$_}" foreach (grep {$protW{$_}} keys(%protW)); if(@tpw){push @updates,"W__protocol:".join",",@tpw ;} else{ delete $hash->{READINGS}{W__protocol} }; @protNamesC = grep !/^$/,HMinfo_noDup(@protNamesC); $hash->{CRI__protoNames} = join",",@protNamesC if(@protNamesC); @protNamesE = grep !/^$/,HMinfo_noDup(@protNamesE); $hash->{ERR__protoNames} = join",",@protNamesE if(@protNamesE); @protNamesW = grep !/^$/,HMinfo_noDup(@protNamesW); $hash->{W__protoNames} = join",",@protNamesW if(@protNamesW); if (defined $modules{CUL_HM}{helper}{qReqConf} && @{$modules{CUL_HM}{helper}{qReqConf}}>0){ $hash->{I_autoReadPend} = join ",",@{$modules{CUL_HM}{helper}{qReqConf}}; push @updates,"I_autoReadPend:". scalar @{$modules{CUL_HM}{helper}{qReqConf}}; } # else{ # delete $hash->{I_autoReadPend}; # } # ------- what about rssi low readings ------ foreach (grep {$rssiMin{$_} != 0}keys %rssiMin){ if ($rssiMin{$_}> -60) {$rssiMinCnt{"59<"}++;} elsif ($rssiMin{$_}> -80) {$rssiMinCnt{"60>"}++;} elsif ($rssiMin{$_}< -99) {$rssiMinCnt{"99>"}++; push @rssiNames,$_ ;} else {$rssiMinCnt{"80>"}++;} } my $d =""; $d .= "$_:$rssiMinCnt{$_} " foreach (sort keys %rssiMinCnt); push @updates,"I_rssiMinLevel:".$d; $hash->{ERR___rssiCrit} = join(",",@rssiNames) if (@rssiNames); # ------- what about others ------ $hash->{W_unConfRegs} = join(",",@shdwNames) if (@shdwNames > 0); # ------- update own status ------ $hash->{STATE} = "updated:".TimeNow(); my $updt = join",",@updates; foreach (grep /^(W_|I_|ERR)/,keys%{$hash->{READINGS}}){ delete $hash->{READINGS}{$_} if ($updt !~ m /$_/); } readingsBeginUpdate($hash); foreach my $rd (@updates){ next if (!$rd); my ($rdName, $rdVal) = split(":",$rd, 2); next if (defined $hash->{READINGS}{$rdName} && $hash->{READINGS}{$rdName}{VAL} eq $rdVal); readingsBulkUpdate($hash,$rdName, ((defined($rdVal) && $rdVal ne "")?$rdVal:"-")); } readingsEndUpdate($hash,1); return; } my %tpl = ( autoOff => {p=>"time" ,t=>"staircase - auto off after