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

remove bugs vrom Unit removal

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@5219 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876 2014-03-13 19:34:53 +00:00
parent b84ad9f3eb
commit 1fd15a093f
3 changed files with 428 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
fhem/FHEM/10_CUL_HM.pm
View File

@ -1053,7 +1053,7 @@ sub CUL_HM_Parse($$) {#########################################################
if($modules{CUL_HM}{defptr}{"$src$chn"}); if($modules{CUL_HM}{defptr}{"$src$chn"});
my %errTbl=( 0=>"ok", 1=>"ValveTight", 2=>"adjustRangeTooLarge" my %errTbl=( 0=>"ok", 1=>"ValveTight", 2=>"adjustRangeTooLarge"
,3=>"adjustRangeTooSmall" , 4=>"communicationERR" ,3=>"adjustRangeTooSmall" , 4=>"communicationERR"
,5=>"unknown" , 6=>"lowBat" , 7=>"ValveErrorPosition" ); ,5=>"unknown", 6=>"lowBat", 7=>"ValveErrorPosition" );
push @evtEt,[$shash,1,"motorErr:$errTbl{$err}" ]; push @evtEt,[$shash,1,"motorErr:$errTbl{$err}" ];
push @evtEt,[$shash,1,"measured-temp:$actTemp" ]; push @evtEt,[$shash,1,"measured-temp:$actTemp" ];
@ -1070,7 +1070,10 @@ sub CUL_HM_Parse($$) {#########################################################
push @evtEt,[$dHash,1,"actuator:$vp"]; push @evtEt,[$dHash,1,"actuator:$vp"];
my $wHash = $modules{CUL_HM}{defptr}{$src."01"}; my $wHash = $modules{CUL_HM}{defptr}{$src."01"};
push @evtEt,[$wHash,1,"measured-temp:$actTemp"] if ($wHash); if ($wHash){
push @evtEt,[$wHash,1,"measured-temp:$actTemp"];
push @evtEt,[$wHash,1,"state:$actTemp"];
}
} }
elsif($mTp eq "59" && $p =~ m/^(..)/) {#inform team about new value elsif($mTp eq "59" && $p =~ m/^(..)/) {#inform team about new value
my $setTemp = sprintf("%.1f",int(hex($1)/4)/2); my $setTemp = sprintf("%.1f",int(hex($1)/4)/2);
@ -1334,8 +1337,8 @@ sub CUL_HM_Parse($$) {#########################################################
my $vh = CUL_HM_id2Hash($vDim->{$tmpKey}) if ($vDim->{$tmpKey}); my $vh = CUL_HM_id2Hash($vDim->{$tmpKey}) if ($vDim->{$tmpKey});
next if (!$vh || $vDim->{$tmpKey} eq $chId); next if (!$vh || $vDim->{$tmpKey} eq $chId);
my $vl = ReadingsVal($vh->{NAME},"level","???"); my $vl = ReadingsVal($vh->{NAME},"level","???");
my $vs = ($vl eq "100 %"?"on":($vl eq "0 %"?"off":"$vl")); my $vs = ($vl eq "100"?"on":($vl eq "0"?"off":"$vl"));
$vs = (($pl." %") ne $vl)?"chn:$vs phys:$pl":$vs; $vs = ($pl ne $vl)?"chn:$vs phys:$pl":$vs;
push @evtEt,[$vh,1,"state:$vs"]; push @evtEt,[$vh,1,"state:$vs"];
push @evtEt,[$vh,1,"phyLevel:$pl"]; push @evtEt,[$vh,1,"phyLevel:$pl"];
} }
@ -2748,10 +2751,14 @@ sub CUL_HM_Set($@) {#+++++++++++++++++ set command+++++++++++++++++++++++++++++
$days = $a[3]; $days = $a[3];
($eH,$eM) = split(':',$a[2]); ($eH,$eM) = split(':',$a[2]);
my ($s,$m,$h) = localtime();
return "$eH:$eM passed at $h:$m. Please enter time in the feature"
if ($days == 0 && ($h+($m/60))>=($eH+($eM/60)) );
return "$eM illegal - use 00 or 30 minutes only" if ($eM !~ m/^(00|30)$/); return "$eM illegal - use 00 or 30 minutes only" if ($eM !~ m/^(00|30)$/);
return "$eH illegal - hour must be between 0 and 23" if ($eH < 0 || $eH > 23); return "$eH illegal - hour must be between 0 and 23" if ($eH < 0 || $eH > 23);
return "$days illegal - days must be between 0 and 200" if ($days < 0 || $days > 200); return "$days illegal - days must be between 0 and 200" if ($days < 0 || $days > 200);
$eH += 128 if ($eM eq "30"); $eH += 128 if ($eM eq "30");
my $cHash = CUL_HM_id2Hash($dst."02"); my $cHash = CUL_HM_id2Hash($dst."02");
$cHash->{helper}{partyReg} = sprintf("61%02X62%02X0000",$eH,$days); $cHash->{helper}{partyReg} = sprintf("61%02X62%02X0000",$eH,$days);
$cHash->{helper}{partyReg} =~ s/(..)(..)/ $1:$2/g; $cHash->{helper}{partyReg} =~ s/(..)(..)/ $1:$2/g;
@ -4976,9 +4983,8 @@ sub CUL_HM_getAssChnNames($) { #in: name out:list of assotiated chan and device
sub CUL_HM_Id($) {#in: ioHash out: ioHMid sub CUL_HM_Id($) {#in: ioHash out: ioHMid
my ($io) = @_; my ($io) = @_;
if (ref($io) ne 'HASH'){ return "000000" if (ref($io) ne 'HASH');
return "000000";
}
my $fhtid = defined($io->{FHTID}) ? $io->{FHTID} : "0000"; my $fhtid = defined($io->{FHTID}) ? $io->{FHTID} : "0000";
return AttrVal($io->{NAME},"hmId","F1$fhtid"); return AttrVal($io->{NAME},"hmId","F1$fhtid");
} }
@ -4990,11 +4996,11 @@ sub CUL_HM_IOid($) {#in: hash out: id of IO device
my $fhtid = defined($ioHash->{FHTID}) ? $ioHash->{FHTID} : "0000"; my $fhtid = defined($ioHash->{FHTID}) ? $ioHash->{FHTID} : "0000";
return AttrVal($ioHash->{NAME},"hmId","F1$fhtid"); return AttrVal($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) = @_;
return $hash->{DEF}; return $hash->{DEF};
} }
sub CUL_HM_hash2Name($) {#in: id, out:name sub CUL_HM_hash2Name($) {#in: hash, out:name
my ($hash) = @_; my ($hash) = @_;
return $hash->{NAME}; return $hash->{NAME};
} }

666
fhem/FHEM/98_HMinfo.pm
View File

@ -112,7 +112,188 @@ sub HMinfo_Attr(@) {###########################################################
} }
return; return;
} }
sub HMinfo_autoUpdate($){#in:name, send status-request
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;
}
sub HMinfo_autoUpdate($){#in:name, send status-request#########################
my $name = shift; my $name = shift;
(undef,$name)=split":",$name,2; (undef,$name)=split":",$name,2;
HMinfo_SetFn($defs{$name},$name,"update") if ($name); HMinfo_SetFn($defs{$name},$name,"update") if ($name);
@ -232,12 +413,13 @@ sub HMinfo_burstCheck(@) { ####################################################
my @needBurstFail; my @needBurstFail;
my @peerIDsCond; my @peerIDsCond;
foreach my $eName (@entities){ foreach my $eName (@entities){
next if (!$defs{$eName}{helper}{role}{chn});#device has no channels next if (!$defs{$eName}{helper}{role}{chn} #entity has no channels
next if (!CUL_HM_peerUsed($eName)); || !CUL_HM_peerUsed($eName) #entity not peered
next if (CUL_HM_Get($defs{$eName},$eName,"regList") !~ m/peerNeedsBurst/); || CUL_HM_Get($defs{$eName},$eName,"regList")#option not supported
!~ m/peerNeedsBurst/);
my $peerIDs = AttrVal($eName,"peerIDs",undef); my $peerIDs = AttrVal($eName,"peerIDs",undef);
next if(!$peerIDs); # no peers - noting to check next if(!$peerIDs); # no peers assigned
my $devId = substr($defs{$eName}{DEF},0,6); my $devId = substr($defs{$eName}{DEF},0,6);
foreach (split",",$peerIDs){ foreach (split",",$peerIDs){
@ -285,6 +467,7 @@ sub HMinfo_paramCheck(@) { ####################################################
$ret .="\n\n PairedTo mismatch to IODev"."\n ".(join "\n ",sort @idMismatch) if (@idMismatch); $ret .="\n\n PairedTo mismatch to IODev"."\n ".(join "\n ",sort @idMismatch) if (@idMismatch);
return $ret; return $ret;
} }
sub HMinfo_tempList(@) { ###################################################### sub HMinfo_tempList(@) { ######################################################
my ($filter,$action,$fName)=@_; my ($filter,$action,$fName)=@_;
$filter = "." if (!$filter); $filter = "." if (!$filter);
@ -568,6 +751,7 @@ sub HMinfo_GetFn($@) {#########################################################
} }
$cmd = "?" if(!$cmd);# by default print options $cmd = "?" if(!$cmd);# by default print options
#------------ statistics ---------------
if ($cmd eq "protoEvents"){##print protocol-events------------------------- if ($cmd eq "protoEvents"){##print protocol-events-------------------------
my ($type) = @a; my ($type) = @a;
$type = "long" if(!$type); $type = "long" if(!$type);
@ -683,6 +867,63 @@ sub HMinfo_GetFn($@) {#########################################################
."\n ".(join "\n ",sort @rssiList) ."\n ".(join "\n ",sort @rssiList)
; ;
} }
#------------ checks ---------------
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 "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;
}
#------------ print tables ---------------
elsif($cmd eq "peerXref") {##print cross-references------------------------
my @peerPairs;
my @peerFhem;
my @fheml = ();
foreach my $dName (HMinfo_getEntities($opt,$filter)){
my $peerIDs = AttrVal($dName,"peerIDs",undef);
my $dId = unpack 'A6',CUL_HM_name2Id($dName);
my @pl = ();
foreach (split",",$peerIDs){
next if ($_ eq "00000000");
my $pn = CUL_HM_peerChName($_,$dId);
push @pl,$pn;
push @fheml,"$_$dName" if ($pn =~ m/^fhem..$/);
}
push @peerPairs,$dName." => ".join(", ",(sort @pl)) if (@pl);
}
#--- calculate peerings to Central ---
my %fChn;
foreach (@fheml){
my ($fhId,$fhCh,$p)= unpack 'A6A2A*',$_;
my $fhemCh = "fhem_io_${fhId}_$fhCh";
$fChn{$fhemCh} = ($fChn{$fhemCh}?$fChn{$fhemCh}.", ":"").$p;
}
push @peerFhem,map {"$_ => $fChn{$_}"} keys %fChn;
$ret = $cmd." done:" ."\n x-ref list"."\n ".(join "\n ",sort @peerPairs)
."\n ".(join "\n ",sort @peerFhem)
;
}
elsif($cmd eq "templateList"){##template: list templates --------------------
return HMinfo_templateList($a[0]);
}
elsif($cmd eq "register") {##print register-------------------------------- elsif($cmd eq "register") {##print register--------------------------------
# devicenameFilter # devicenameFilter
my $RegReply = ""; my $RegReply = "";
@ -743,45 +984,7 @@ sub HMinfo_GetFn($@) {#########################################################
.(join "\n ",sort @paramList) .(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);
my $dId = unpack 'A6',CUL_HM_name2Id($dName);
my @pl = ();
my @fheml = ();
foreach (split",",$peerIDs){
next if ($_ eq "00000000");
my $pn = CUL_HM_peerChName($_,$dId);
push @pl,$pn;
push @fheml,$pn.";".$dName if ($pn =~ m/^fhem/);
}
push @peerPairs,$dName." => ".join(", ",(sort @pl)) if (@pl);
my %fChn;
foreach (sort @fheml){
my ($fhemCh,undef,$p)= unpack 'A6A1A*',$_;
$fChn{$fhemCh} => ($fChn{$fhemCh}?$fChn{$fhemCh}.", ":"").$p;
}
push @peerPairs,map {"$_ => $fChn{$_}"}sort keys %fChn;
}
$ret = $cmd." done:" ."\n x-ref list" ."\n ".(join "\n ",sort @peerPairs)
;
}
elsif($cmd eq "models") {##print capability, models---------------------- elsif($cmd eq "models") {##print capability, models----------------------
my $th = \%HMConfig::culHmModel; my $th = \%HMConfig::culHmModel;
my @model; my @model;
@ -824,18 +1027,6 @@ sub HMinfo_GetFn($@) {#########################################################
) )
.join"\n ",grep(/$filter/,sort @model); .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") { elsif($cmd eq "help") {
$ret = " Unknown argument $cmd, choose one of " $ret = " Unknown argument $cmd, choose one of "
."\n ---checks---" ."\n ---checks---"
@ -1038,7 +1229,7 @@ sub HMinfo_SetFn($@) {#########################################################
return $ret; return $ret;
} }
sub HMInfo_help(){ sub HMInfo_help(){ ############################################################
return " Unknown argument choose one of " return " Unknown argument choose one of "
."\n ---checks---" ."\n ---checks---"
."\n get configCheck [<typeFilter>] # perform regCheck and regCheck" ."\n get configCheck [<typeFilter>] # perform regCheck and regCheck"
@ -1271,7 +1462,7 @@ sub HMinfo_archConfigPost($) {################################################
return ; return ;
} }
sub HMinfo_bpPost($) {#bp finished############################################# sub HMinfo_bpPost($) {#bp finished ############################################
my ($rep) = @_; my ($rep) = @_;
my ($name,$id) = split(":",$rep); my ($name,$id) = split(":",$rep);
delete $defs{$name}{nb}{$id}; delete $defs{$name}{nb}{$id};
@ -1284,322 +1475,12 @@ sub HMinfo_bpAbort($) {#bp timeout ############################################
return; 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 <time>, extend time with each trigger"
,reg=>{ OnTime =>"p0"
,OffTime =>111600
,SwJtOn =>"on"
,SwJtOff =>"dlyOn"
,SwJtDlyOn =>"no"
,SwJtDlyOff =>"dlyOn"
}}
,motionOnDim => {p=>"ontime brightness",t=>"Dimmer:on for time if MDIR-brightness below level"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p1"
,CtRampOn =>"ltLo"
,CtRampOff =>"ltLo"
,OffTime =>111600
,OnTime =>"p0"
,ActionTypeDim =>"jmpToTarget"
,DimJtOn =>"on"
,DimJtOff =>"dlyOn"
,DimJtDlyOn =>"rampOn"
,DimJtDlyOff =>"dlyOn"
,DimJtRampOn =>"on"
,DimJtRampOff =>"dlyOn"
}}
,motionOnSw => {p=>"ontime brightness",t=>"Switch:on for time if MDIR-brightness below level"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p1"
,OffTime =>111600
,OnTime =>"p0"
,ActionType =>"jmpToTarget"
,SwJtOn =>"on"
,SwJtOff =>"dlyOn"
,SwJtDlyOn =>"on"
,SwJtDlyOff =>"dlyOn"
}}
,SwCondAbove => {p=>"condition" ,t=>"Switch:execute only if condition level is above limit"
,reg=>{ CtDlyOn =>"geLo"
,CtDlyOff =>"geLo"
,CtOn =>"geLo"
,CtOff =>"geLo"
,CtValLo =>"p0"
}}
,SwCondBelow => {p=>"condition" ,t=>"Switch:execute only if condition level is below limit"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p0"
}}
,SwOnCond => {p=>"level cond" ,t=>"switch:execute only if condition [geLo|ltLo] level is below limit"
,reg=>{ CtDlyOn =>"p1"
,CtDlyOff =>"p1"
,CtOn =>"p1"
,CtOff =>"p1"
,CtValLo =>"p0"
}}
,BlStopDnLg => {p=>"" ,t=>"Blind: stop drive on any key - for long drive down"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"refOff"
,BlJtDlyOn =>"dlyOff"
,BlJtOff =>"dlyOff"
,BlJtOn =>"dlyOff"
,BlJtRampOff =>"rampOff"
,BlJtRampOn =>"on"
,BlJtRefOff =>"rampOff"
,BlJtRefOn =>"on"
}}
,BlStopDnSh => {p=>"" ,t=>"Blind: stop drive on any key - for short drive down"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"refOff"
,BlJtDlyOn =>"dlyOff"
,BlJtOff =>"dlyOff"
,BlJtOn =>"dlyOff"
,BlJtRampOff =>"off"
,BlJtRampOn =>"on"
,BlJtRefOff =>"rampOff"
,BlJtRefOn =>"on"
}}
,BlStopUpLg => {p=>"" ,t=>"Blind: stop drive on any key - for long drive up"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"dlyOn"
,BlJtDlyOn =>"refOn"
,BlJtOff =>"dlyOn"
,BlJtOn =>"dlyOn"
,BlJtRampOff =>"off"
,BlJtRampOn =>"rampOn"
,BlJtRefOff =>"off"
,BlJtRefOn =>"rampOn"
}}
,BlStopUpSh => {p=>"" ,t=>"Blind: stop drive on"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"dlyOn"
,BlJtDlyOn =>"refOn"
,BlJtOff =>"dlyOn"
,BlJtOn =>"dlyOn"
,BlJtRampOff =>"off"
,BlJtRampOn =>"on"
,BlJtRefOff =>"off"
,BlJtRefOn =>"rampOn"
}}
,wmOpen => {p=>"speed" ,t=>"winmatic open window"
,reg=>{ WinJtOn =>"rampOn"
,WinJtOff =>"rampOn"
,WinJtRampOn =>"on"
,WinJtRampOff =>"rampOnFast"
,RampOnSp =>"p0"
}}
,wmClose => {p=>"speed" ,t=>"winmatic close window"
,reg=>{ WinJtOn =>"rampOff"
,WinJtOff =>"rampOff"
,WinJtRampOn =>"on"
,WinJtRampOff =>"rampOnFast"
,RampOffSp =>"p0"
}}
,wmClosed => {p=>"" ,t=>"winmatic lock window"
,reg=>{ OffLevelKm =>"0"
}}
,wmLock => {p=>"" ,t=>"winmatic lock window"
,reg=>{ OffLevelKm =>"127.5"
}}
);
sub HMinfo_templateDef(@){##################################################### sub HMinfo_templateDef(@){#####################################################
my ($name,$param,$desc,@regs) = @_; my ($name,$param,$desc,@regs) = @_;
return "insufficient parameter" if(!defined $param); return "insufficient parameter" if(!defined $param);
if ($param eq "del"){ if ($param eq "del"){
delete $tpl{$name}; delete $HMConfig::tpl{$name};
return; return;
} }
# get description if marked wir "" # get description if marked wir ""
@ -1614,30 +1495,30 @@ sub HMinfo_templateDef(@){#####################################################
splice @regs,0,$cnt; splice @regs,0,$cnt;
} }
return "$name already defined, delete it first" if($tpl{$name}); return "$name already defined, delete it first" if($HMConfig::tpl{$name});
return "insufficient parameter" if(@regs < 1); return "insufficient parameter" if(@regs < 1);
$tpl{$name}{p} = ""; $HMConfig::tpl{$name}{p} = "";
$tpl{$name}{p} = join(" ",split(":",$param)) if($param ne "0"); $HMConfig::tpl{$name}{p} = join(" ",split(":",$param)) if($param ne "0");
$tpl{$name}{t} = $desc; $HMConfig::tpl{$name}{t} = $desc;
my $paramNo = split(":",$param); my $paramNo = split(":",$param);
foreach (@regs){ foreach (@regs){
my ($r,$v)=split":",$_; my ($r,$v)=split":",$_;
if (!defined $v){ if (!defined $v){
delete $tpl{$name}; delete $HMConfig::tpl{$name};
return " empty reg value for $r"; return " empty reg value for $r";
} }
elsif($v =~ m/^p(.)/){ elsif($v =~ m/^p(.)/){
return ($1+1)." params are necessary, only $paramNo aregiven" return ($1+1)." params are necessary, only $paramNo aregiven"
if (($1+1)>$paramNo); if (($1+1)>$paramNo);
} }
$tpl{$name}{reg}{$r} = $v; $HMConfig::tpl{$name}{reg}{$r} = $v;
} }
} }
sub HMinfo_templateSet(@){##################################################### sub HMinfo_templateSet(@){#####################################################
my ($aName,$tmpl,$pSet,@p) = @_; my ($aName,$tmpl,$pSet,@p) = @_;
$pSet = ":" if (!$pSet || $pSet eq "none"); $pSet = ":" if (!$pSet || $pSet eq "none");
my ($pName,$pTyp) = split(":",$pSet); my ($pName,$pTyp) = split(":",$pSet);
return "template undefined $tmpl" if(!$tpl{$tmpl}); return "template undefined $tmpl" if(!$HMConfig::tpl{$tmpl});
return "aktor $aName unknown" if(!$defs{$aName}); return "aktor $aName unknown" if(!$defs{$aName});
return "exec set $aName getConfig first" if(!(grep /RegL_/,keys%{$defs{$aName}{READINGS}})); return "exec set $aName getConfig first" if(!(grep /RegL_/,keys%{$defs{$aName}{READINGS}}));
return "give <peer>:[short|long] with peer, not $pSet" if($pName && $pTyp !~ m/(short|long)/); return "give <peer>:[short|long] with peer, not $pSet" if($pName && $pTyp !~ m/(short|long)/);
@ -1645,11 +1526,11 @@ sub HMinfo_templateSet(@){#####################################################
my $aHash = $defs{$aName}; my $aHash = $defs{$aName};
my @regCh; my @regCh;
foreach (keys%{$tpl{$tmpl}{reg}}){ foreach (keys%{$HMConfig::tpl{$tmpl}{reg}}){
my $regN = $pSet.$_; my $regN = $pSet.$_;
my $regV = $tpl{$tmpl}{reg}{$_}; my $regV = $HMConfig::tpl{$tmpl}{reg}{$_};
if ($regV =~m /^p(.)$/) {#replace with User parameter if ($regV =~m /^p(.)$/) {#replace with User parameter
return "insufficient values - at least ".$tpl{p}." are $1 necessary" if (@p < ($1+1)); return "insufficient values - at least ".$HMConfig::tpl{p}." are $1 necessary" if (@p < ($1+1));
$regV = $p[$1]; $regV = $p[$1];
} }
my ($ret,undef) = CUL_HM_Set($aHash,$aName,"regSet",$regN,"?",$pName); my ($ret,undef) = CUL_HM_Set($aHash,$aName,"regSet",$regN,"?",$pName);
@ -1673,7 +1554,7 @@ sub HMinfo_templateChk(@){#####################################################
my ($aName,$tmpl,$pSet,@p) = @_; my ($aName,$tmpl,$pSet,@p) = @_;
$pSet = "" if (!$pSet || $pSet eq "none"); $pSet = "" if (!$pSet || $pSet eq "none");
my ($pName,$pTyp) = split(":",$pSet); my ($pName,$pTyp) = split(":",$pSet);
return "template undefined $tmpl\n" if(!$tpl{$tmpl}); return "template undefined $tmpl\n" if(!$HMConfig::tpl{$tmpl});
return "aktor $aName unknown\n" if(!$defs{$aName}); return "aktor $aName unknown\n" if(!$defs{$aName});
return "give <peer>:[short|long|all] wrong:$pTyp\n" if($pTyp && $pTyp !~ m/(short|long|all)/); return "give <peer>:[short|long|all] wrong:$pTyp\n" if($pTyp && $pTyp !~ m/(short|long|all)/);
@ -1702,16 +1583,16 @@ sub HMinfo_templateChk(@){#####################################################
} }
else{ else{
my $pRnm = $pName?($pName."-".($pTyp eq "long"?"lg":"sh")):""; my $pRnm = $pName?($pName."-".($pTyp eq "long"?"lg":"sh")):"";
foreach my $rn (keys%{$tpl{$tmpl}{reg}}){ foreach my $rn (keys%{$HMConfig::tpl{$tmpl}{reg}}){
my $regV = ReadingsVal($aName,"R-$pRnm$rn" ,undef); my $regV = ReadingsVal($aName,"R-$pRnm$rn" ,undef);
$regV = ReadingsVal($aName,".R-$pRnm$rn",undef) if (!defined $regV); $regV = ReadingsVal($aName,".R-$pRnm$rn",undef) if (!defined $regV);
$regV = ReadingsVal($aName,"R-".$rn ,undef) if (!defined $regV); $regV = ReadingsVal($aName,"R-".$rn ,undef) if (!defined $regV);
$regV = ReadingsVal($aName,".R-".$rn ,undef) if (!defined $regV); $regV = ReadingsVal($aName,".R-".$rn ,undef) if (!defined $regV);
if (defined $regV){ if (defined $regV){
$regV =~s/ .*//;#strip unit $regV =~s/ .*//;#strip unit
my $tplV = $tpl{$tmpl}{reg}{$rn}; my $tplV = $HMConfig::tpl{$tmpl}{reg}{$rn};
if ($tplV =~m /^p(.)$/) {#replace with User parameter if ($tplV =~m /^p(.)$/) {#replace with User parameter
return "insufficient data - at least ".$tpl{p}." are $1 necessary" return "insufficient data - at least ".$HMConfig::tpl{p}." are $1 necessary"
if (@p < ($1+1)); if (@p < ($1+1));
$tplV = $p[$1]; $tplV = $p[$1];
} }
@ -1729,22 +1610,21 @@ sub HMinfo_templateChk(@){#####################################################
sub HMinfo_templateList($){#################################################### sub HMinfo_templateList($){####################################################
my $templ = shift; my $templ = shift;
my $reply = ""; my $reply = "";
# if(!$templ || !(grep /$templ/,keys%tpl)){# list all templates if(!($templ && (grep /$templ/,keys%HMConfig::tpl))){# list all templates
if(!($templ && (grep /$templ/,keys%tpl))){# list all templates foreach (sort keys%HMConfig::tpl){
foreach (sort keys%tpl){
$reply .= sprintf("%-16s params:%-24s Info:%s\n" $reply .= sprintf("%-16s params:%-24s Info:%s\n"
,$_ ,$_
,$tpl{$_}{p} ,$HMConfig::tpl{$_}{p}
,$tpl{$_}{t} ,$HMConfig::tpl{$_}{t}
); );
} }
} }
else{#details about one template else{#details about one template
$reply = sprintf("%-16s params:%-24s Info:%s\n",$templ,$tpl{$templ}{p},$tpl{$templ}{t}); $reply = sprintf("%-16s params:%-24s Info:%s\n",$templ,$HMConfig::tpl{$templ}{p},$HMConfig::tpl{$templ}{t});
foreach (sort keys %{$tpl{$templ}{reg}}){ foreach (sort keys %{$HMConfig::tpl{$templ}{reg}}){
my $val = $tpl{$templ}{reg}{$_}; my $val = $HMConfig::tpl{$templ}{reg}{$_};
if ($val =~m /^p(.)$/){ if ($val =~m /^p(.)$/){
my @a = split(" ",$tpl{$templ}{p}); my @a = split(" ",$HMConfig::tpl{$templ}{p});
$val = $a[$1]; $val = $a[$1];
} }
$reply .= sprintf(" %-16s :%s\n",$_,$val); $reply .= sprintf(" %-16s :%s\n",$_,$val);
@ -1801,7 +1681,7 @@ sub HMinfo_cpRegs(@){##########################################################
my ($ret,undef) = CUL_HM_Set($defs{$dstCh},$dstCh,"regBulk",$srcRegLn,split(" ",$srcData)); my ($ret,undef) = CUL_HM_Set($defs{$dstCh},$dstCh,"regBulk",$srcRegLn,split(" ",$srcData));
return $ret; return $ret;
} }
sub HMinfo_noDup(@) {#return list with no duplicates sub HMinfo_noDup(@) {#return list with no duplicates###########################
my %all; my %all;
return "" if (scalar(@_) == 0); return "" if (scalar(@_) == 0);
$all{$_}=0 foreach (grep {defined($_)} @_); $all{$_}=0 foreach (grep {defined($_)} @_);

144
fhem/FHEM/HMConfig.pm
View File

@ -423,7 +423,7 @@ my $K_actDetID = '000000'; # id of actionDetector
cyclicInfoMsgDis=>{a=> 17.0,s=>1.0,l=>0,min=>0 ,max=>255 ,c=>'' ,f=>'' ,u=>'' ,d=>1,t=>"cyclic message"}, cyclicInfoMsgDis=>{a=> 17.0,s=>1.0,l=>0,min=>0 ,max=>255 ,c=>'' ,f=>'' ,u=>'' ,d=>1,t=>"cyclic message"},
lowBatLimit =>{a=> 18.0,s=>1.0,l=>0,min=>10 ,max=>12 ,c=>'' ,f=>10 ,u=>'V' ,d=>1,t=>"low batterie limit, step .1V"}, lowBatLimit =>{a=> 18.0,s=>1.0,l=>0,min=>10 ,max=>12 ,c=>'' ,f=>10 ,u=>'V' ,d=>1,t=>"low batterie limit, step .1V"},
lowBatLimitBA =>{a=> 18.0,s=>1.0,l=>0,min=>5 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"}, lowBatLimitBA =>{a=> 18.0,s=>1.0,l=>0,min=>5 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},
lowBatLimitBA_4 =>{a=> 28.0,s=>1.0,l=>0,min=>5 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},# bug in SW4? strange - at least one user... lowBatLimitBA_4 =>{a=> 24.0,s=>1.0,l=>0,min=>5 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},# bug in SW4? strange - at least one user...
lowBatLimitBA2 =>{a=> 18.0,s=>1.0,l=>0,min=>0 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"}, lowBatLimitBA2 =>{a=> 18.0,s=>1.0,l=>0,min=>0 ,max=>15 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},
lowBatLimitFS =>{a=> 18.0,s=>1.0,l=>0,min=>2 ,max=>3 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"}, lowBatLimitFS =>{a=> 18.0,s=>1.0,l=>0,min=>2 ,max=>3 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},
lowBatLimitRT =>{a=> 18.0,s=>1.0,l=>0,min=>2 ,max=>2.5 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"}, lowBatLimitRT =>{a=> 18.0,s=>1.0,l=>0,min=>2 ,max=>2.5 ,c=>'' ,f=>10 ,u=>'V' ,d=>0,t=>"low batterie limit, step .1V"},
@ -1052,7 +1052,137 @@ $culHmRegChan{"HM-TC-IT-WM-W-EU07"} = $culHmRegType{remote}; # type has
$culHmRegChan{"ROTO_ZEL-STG-RM-FWT02"}= $culHmRegChan{"HM-CC-TC02"}; $culHmRegChan{"ROTO_ZEL-STG-RM-FWT02"}= $culHmRegChan{"HM-CC-TC02"};
$culHmRegChan{"ROTO_ZEL-STG-RM-FWT03"}= $culHmRegChan{"HM-CC-TC03"}; $culHmRegChan{"ROTO_ZEL-STG-RM-FWT03"}= $culHmRegChan{"HM-CC-TC03"};
##--------------- Conversion routines for register settings ##############################---templates---##################################
#en-block programming of funktions
my %tpl = (
autoOff => {p=>"time" ,t=>"staircase - auto off after <time>, extend time with each trigger"
,reg=>{ OnTime =>"p0"
,OffTime =>111600
,SwJtOn =>"on"
,SwJtOff =>"dlyOn"
,SwJtDlyOn =>"no"
,SwJtDlyOff =>"dlyOn"
}}
,motionOnDim => {p=>"ontime brightness",t=>"Dimmer: on for time if MDIR-brightness below level"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p1"
,CtRampOn =>"ltLo"
,CtRampOff =>"ltLo"
,OffTime =>111600
,OnTime =>"p0"
,ActionTypeDim =>"jmpToTarget"
,DimJtOn =>"on"
,DimJtOff =>"dlyOn"
,DimJtDlyOn =>"rampOn"
,DimJtDlyOff =>"dlyOn"
,DimJtRampOn =>"on"
,DimJtRampOff =>"dlyOn"
}}
,motionOnSw => {p=>"ontime brightness",t=>"Switch: on for time if MDIR-brightness below level"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p1"
,OffTime =>111600
,OnTime =>"p0"
,ActionType =>"jmpToTarget"
,SwJtOn =>"on"
,SwJtOff =>"dlyOn"
,SwJtDlyOn =>"on"
,SwJtDlyOff =>"dlyOn"
}}
,SwCondAbove => {p=>"condition" ,t=>"Switch: execute only if condition level is above limit"
,reg=>{ CtDlyOn =>"geLo"
,CtDlyOff =>"geLo"
,CtOn =>"geLo"
,CtOff =>"geLo"
,CtValLo =>"p0"
}}
,SwCondBelow => {p=>"condition" ,t=>"Switch: execute only if condition level is below limit"
,reg=>{ CtDlyOn =>"ltLo"
,CtDlyOff =>"ltLo"
,CtOn =>"ltLo"
,CtOff =>"ltLo"
,CtValLo =>"p0"
}}
,SwOnCond => {p=>"level cond" ,t=>"switch: execute only if condition [geLo|ltLo] level is below limit"
,reg=>{ CtDlyOn =>"p1"
,CtDlyOff =>"p1"
,CtOn =>"p1"
,CtOff =>"p1"
,CtValLo =>"p0"
}}
,BlStopDnLg => {p=>"" ,t=>"Blind: stop drive on any key - for long drive down"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"refOff"
,BlJtDlyOn =>"dlyOff"
,BlJtOff =>"dlyOff"
,BlJtOn =>"dlyOff"
,BlJtRampOff =>"rampOff"
,BlJtRampOn =>"on"
,BlJtRefOff =>"rampOff"
,BlJtRefOn =>"on"
}}
,BlStopDnSh => {p=>"" ,t=>"Blind: stop drive on any key - for short drive down"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"refOff"
,BlJtDlyOn =>"dlyOff"
,BlJtOff =>"dlyOff"
,BlJtOn =>"dlyOff"
,BlJtRampOff =>"off"
,BlJtRampOn =>"on"
,BlJtRefOff =>"rampOff"
,BlJtRefOn =>"on"
}}
,BlStopUpLg => {p=>"" ,t=>"Blind: stop drive on any key - for long drive up"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"dlyOn"
,BlJtDlyOn =>"refOn"
,BlJtOff =>"dlyOn"
,BlJtOn =>"dlyOn"
,BlJtRampOff =>"off"
,BlJtRampOn =>"rampOn"
,BlJtRefOff =>"off"
,BlJtRefOn =>"rampOn"
}}
,BlStopUpSh => {p=>"" ,t=>"Blind: stop drive on"
,reg=>{ ActionType =>"jmpToTarget"
,BlJtDlyOff =>"dlyOn"
,BlJtDlyOn =>"refOn"
,BlJtOff =>"dlyOn"
,BlJtOn =>"dlyOn"
,BlJtRampOff =>"off"
,BlJtRampOn =>"on"
,BlJtRefOff =>"off"
,BlJtRefOn =>"rampOn"
}}
,wmOpen => {p=>"speed" ,t=>"winmatic: open window"
,reg=>{ WinJtOn =>"rampOn"
,WinJtOff =>"rampOn"
,WinJtRampOn =>"on"
,WinJtRampOff =>"rampOnFast"
,RampOnSp =>"p0"
}}
,wmClose => {p=>"speed" ,t=>"winmatic: close window"
,reg=>{ WinJtOn =>"rampOff"
,WinJtOff =>"rampOff"
,WinJtRampOn =>"on"
,WinJtRampOff =>"rampOnFast"
,RampOffSp =>"p0"
}}
,wmClosed => {p=>"" ,t=>"winmatic: lock window"
,reg=>{ OffLevelKm =>"0"
}}
,wmLock => {p=>"" ,t=>"winmatic: lock window"
,reg=>{ OffLevelKm =>"127.5"
}}
);
##############################---get---######################################## ##############################---get---########################################
#define gets - try use same names as for set #define gets - try use same names as for set
@ -1496,6 +1626,10 @@ $culHmChanSets{"ROTO_ZEL-STG-RM-FWT02"} = $culHmChanSets{"HM-CC-TC02"};
LOWBAT => '00,2,$val=(hex($val)&0x80)?1:0', LOWBAT => '00,2,$val=(hex($val)&0x80)?1:0',
NBR => '02,2,$val=(hex($val))', NBR => '02,2,$val=(hex($val))',
VALUE => '04,2,$val=(hex($val))',} }, VALUE => '04,2,$val=(hex($val))',} },
"42" => { txt => "SwitchLevel", params => {
BUTTON => '00,2,$val=(hex($val)&0x3F)',
NBR => '02,2,$val=(hex($val))',
LEVEL => '04,2,$val=(hex($val))',} },
"53" => { txt => "SensorData" , params => { "53" => { txt => "SensorData" , params => {
CMD => "00,2", CMD => "00,2",
Fld1=> "02,2", Fld1=> "02,2",
@ -1513,18 +1647,18 @@ $culHmChanSets{"ROTO_ZEL-STG-RM-FWT02"} = $culHmChanSets{"HM-CC-TC02"};
CMD => "00,2", CMD => "00,2",
desTemp => '02,2,$val=((hex($val)>>2) /2)', desTemp => '02,2,$val=((hex($val)>>2) /2)',
mode => '02,2,$val=(hex($val) & 0x3)',} }, mode => '02,2,$val=(hex($val) & 0x3)',} },
"5A" => { txt => "ThermCtrl" , params => { "5A" => { txt => "ThermCtrl" , params => {
setTemp => '00,2,$val=(((hex($val)>>2)&0x3f) /2)', setTemp => '00,2,$val=(((hex($val)>>2)&0x3f) /2)',
actTemp => '00,4,$val=((hex($val)>>6) /10)', actTemp => '00,4,$val=((hex($val)>>6) /10)',
hum => '04,2,$val=(hex($val) & 0x3)',} }, hum => '04,2,$val=(hex($val) & 0x3)',} },
"5E" => { txt => "powerEvntCyc" , params => { "5E" => { txt => "powerEvntCyc", params => {
energy => '00,6,$val=((hex($val)) /10)', energy => '00,6,$val=((hex($val)) /10)',
power => '06,6,$val=((hex($val)) /100)', power => '06,6,$val=((hex($val)) /100)',
current => '12,4,$val=((hex($val)) /1)', current => '12,4,$val=((hex($val)) /1)',
voltage => '16,4,$val=((hex($val)) /10)', voltage => '16,4,$val=((hex($val)) /10)',
frequency=> '20,2,$val=((hex($val)) /100+50)', frequency=> '20,2,$val=((hex($val)) /100+50)',
} }, } },
"5F" => { txt => "powerEvnt" , params => { "5F" => { txt => "powerEvnt" , params => {
energy => '00,6,$val=((hex($val)) /10)', energy => '00,6,$val=((hex($val)) /10)',
power => '06,6,$val=((hex($val)) /100)', power => '06,6,$val=((hex($val)) /100)',
current => '12,4,$val=((hex($val)) /1)', current => '12,4,$val=((hex($val)) /1)',