############################################## # $Id$ package main; use strict; use warnings; my $culHmRegDef =\%HMConfig::culHmRegDefine; my $culHmRegDefLS =\%HMConfig::culHmRegDefShLg; my $culHmTpl =\%HMConfig::culHmTpl; sub HMtemplate_Initialize($$); sub HMtemplate_Define($$); sub HMtemplate_SetFn($@); sub HMtemplate_noDup(@); use Blocking; use HMConfig; my %HtState =( s0=>{name=>"init" ,cmd=>["defTmpl","edit","delete","select"] ,info=>[ "delete to remove a template definition" ,"defTmpl to greate a template" ,"- use an entity as default" ,"edit to modify a template definition" ,"select to apply a template to a entity" ]} ,s1=>{name=>"edit" ,cmd=>["dismiss","save","saveAs"] ,info=>[ "change attr Reg_ as desired" ,"change attr tpl_params as desired" ,"save if finished" ,"saveAs to create a copy" ,"dismiss will reset HMtemplate" ]} ,s2=>{name=>"defTmpl",cmd=>["dismiss","save","saveAs"] ,info=>[ "1)set attr tpl_type" ,"2)set attr tpl_source" ,"3)set attr tpl_peer if peer required" ,"4)set attr tpl_params if params are desired" ,"5)set attr tpl_description for the template" ]} ,s3=>{name=>"defTmpl",cmd=>["defTmpl","edit","delete"] ,info=>[ "delete" ]} ,s4=>{name=>"select" ,cmd=>["dismiss","apply"] ,info=>[ "apply the selected template to an entity" ,"1) choose target entity" ,"2) select a peer if required" ,"3) select type if required" ,"4) fill all attr tpl_param_" ,"5) set apply to execute and write the register" ]} ,s5=>{name=>"defTmpl",cmd=>["defTmpl","edit","delete"] ,info=>[ "s5 info1" ,"s5 info2" ]} ); sub HMtemplate_Initialize($$) {################################################ my ($hash) = @_; $hash->{DefFn} = "HMtemplate_Define"; $hash->{UndefFn} = "HMtemplate_Undef"; $hash->{SetFn} = "HMtemplate_SetFn"; $hash->{GetFn} = "HMtemplate_GetFn"; $hash->{AttrFn} = "HMtemplate_Attr"; $hash->{NotifyFn} = "HMtemplate_Notify"; $hash->{AttrList} = ""; $hash->{NOTIFYDEV} = "global"; } sub HMtemplate_Define($$){##################################################### my ($hash, $def) = @_; my ($n) = devspec2array("TYPE=HMtemplate"); return "only one instance of HMInfo allowed, $n already instantiated" if ($n && $hash->{NAME} ne $n); $hash->{helper}{attrList} = "tpl_params tpl_description " .$readingFnAttributes; $hash->{helper}{cSt} = "s0"; $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList}; return; } sub HMtemplate_Undef($$){###################################################### my ($hash, $name) = @_; return undef; } sub HMtemplate_Attr(@) {####################################################### my ($cmd,$name,$attrName,$attrVal) = @_; my @hashL; my $hash = $defs{$name}; return "$attrName not an option in this state" if($modules{HMtemplate}{AttrList}!~ m/$attrName/); if ($attrName =~ m/^Reg_/){ if (!$init_done){ return "remove attr $attrName after restart - start again with template definition"; } elsif ($cmd eq "set"){ #burstRx =>{min=>0,max=>255 ,c=>'lit',f=>'',t=>'device reacts on Burst' ,lit=>{off=>0,on=>1}}, #MaxTimeF =>{min=>0,max=>25.5 ,c=>'' ,f=>10,t=>"max time first direction." ,lit=>{unused=>25.5}}, my $rN = substr($attrName,4); my $ty = (InternalVal($name,"tpl_type","") eq "peer-Long")?"lg":""; if ($attr{$name}{tpl_params} && $attr{$name}{tpl_params} =~ m/\b$attrVal\b/){ # allow any parameter in any string } elsif ($culHmRegDef->{$ty.$rN}{c} eq "lit"){ return "value $attrVal not allowed for $rN" if (!defined $culHmRegDef->{$ty.$rN}{lit}{$attrVal}); } else{ return "value $attrVal not numeric for $rN" if ($attrVal !~/^\d+?\.?\d?$/); return "value $attrVal out of range for $rN :" .$culHmRegDef->{$ty.$rN}{min} ."..." .$culHmRegDef->{$ty.$rN}{max} if ($culHmRegDef->{$ty.$rN}{min} < $attrVal || $culHmRegDef->{$ty.$rN}{max} > $attrVal); } } else{# delete is ok anyhow } } elsif($attrName eq "tpl_params"){ if (!$init_done){ return "remove attr $attrName after restart - start again with template definition"; } elsif ($cmd eq "set"){ my @param = split(" ",$attrVal); my $paramCnt = scalar @param; foreach my $pN (grep /^p(.)/,values %{$culHmTpl->{$hash->{tpl_Name}}{reg}}){ return "still $paramCnt in use. Remove those from template first" if($1 > ($paramCnt - 1)); } foreach my $rN (keys %{$culHmTpl->{$hash->{tpl_Name}}{reg}}){#now we need to rename all readings if parameter are in use next if ($culHmTpl->{$hash->{tpl_Name}}{reg}{$rN} !~ m/^p(.)/); my $no = $1; $attr{$name}{"Reg_".$rN} = $param[$no]; } my $paramSnew = join(",",@param); my $paramSold = join(",",split(" ",$attr{$name}{tpl_params})); $modules{HMtemplate}{AttrList} =~ s/$paramSold/$paramSnew/g; $hash->{tpl_Param} = $attrVal; } } elsif($attrName eq "tpl_type"){ if ($cmd eq "set"){ my @list = HMtemplate_sourceList($attrVal); $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList} ." tpl_type:peer-Long,peer-Short,peer-both,basic " ." tpl_source:".join(",",@list) ." tpl_peer" ; $attr{$name}{tpl_source} = $attr{$name}{tpl_peer} = ""; } } elsif($attrName eq "tpl_source"){ if ($cmd eq "set"){ $attr{$name}{tpl_peer} = ""; if($attr{$name}{tpl_type} eq "basic"){# we dont need peer - import now HMtemplate_import($name,$attrVal,"basic"); } else{# need peer my $peerList = InternalVal($attrVal,"peerList",""); return "no peer present for $attrVal" if (!$peerList ); $modules{HMtemplate}{AttrList} =~ s/tpl_peer.*?( |$)//; $modules{HMtemplate}{AttrList} .=" tpl_peer:$peerList"; } } } elsif($attrName eq "tpl_peer"){ if ($cmd eq "set"){ HMtemplate_import($name,$attr{$name}{tpl_source},$attr{$name}{tpl_type},$attrVal); } } elsif($attrName eq "tpl_entity"){# used with select option if ($cmd eq "set"){ $attr{$name}{tpl_ePeer} = ""; if($hash->{tpl_type} eq "basic"){# we dont need peer - import now } else{# need peer my $peerList = InternalVal($attrVal,"peerList",""); return "no peer present for $attrVal" if (!$peerList ); $modules{HMtemplate}{AttrList} =~ s/tpl_ePeer.*?( |$)//; $modules{HMtemplate}{AttrList} .=" tpl_ePeer:$peerList"; } } else{ $attr{$name}{"tpl_ePeer"} = ""; $modules{HMtemplate}{AttrList} =~ s/ tpl_ePeer.*?\ / tpl_ePeer/; } } elsif($attrName eq "tpl_ePeer"){# used with select option if ($cmd eq "set"){ } } elsif($attrName eq "tpl_eType"){# used with select option if ($cmd eq "set"){ } } return; } sub HMtemplate_Notify(@){###################################################### my ($hash,$dev) = @_; return "" if ($dev->{NAME} ne "global"); if (grep (m/^INITIALIZED$/,@{$dev->{CHANGED}})){ if ($hash->{helper}{attrPend}){ my $aVal = AttrVal($hash->{NAME},"logIDs",""); HMLAN_Attr("set",$hash->{NAME},"logIDs",$aVal) if($aVal); delete $hash->{helper}{attrPend}; } } elsif (grep (m/^SHUTDOWN$/,@{$dev->{CHANGED}})){ HMtemplate_init($hash->{name});# clear attribut bevore safe } return undef; } sub HMtemplate_GetFn($@) {##################################################### my ($hash,$name,$cmd,@a) = @_; my $ret; $cmd = "?" if(!$cmd);# by default print options #------------ statistics --------------- if ($cmd eq "usage"){##print protocol-events------------------------- my ($type) = @a; my $tN = InternalVal($name,"tpl_Name",undef); return "template not defined" if (!$tN || ! defined $culHmTpl->{$tN}); Log 1,"General ######### my template $tN"; $ret = HMinfo_templateUsg("","",$tN); } else{ my @cmdLst = ( "usage" ); $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst); } return $ret; } sub HMtemplate_SetFn($@) {##################################################### my ($hash,$name,$cmd,@a) = @_; my $ret = ""; my $eSt = \$hash->{helper}{cSt};# shortcut $cmd = "?" if(!$cmd);# by default print options $cmd .=" " if ($cmd ne "?" && !(grep /$cmd/,@{$HtState{${$eSt}}{cmd}})); if ($cmd eq "delete" ) {##actionImmediate: delete template-------------- my ($tName) = @a; return "$tName is not defined" if (! defined $culHmTpl->{$tName}); ${$eSt} = "s0"; if (eval "defined(&HMinfo_templateMark)"){ HMinfo_templateDef($tName,"del"); } else{ return "HMInfo is not defined"; } HMtemplate_init($name); } elsif ($cmd eq "dismiss" ) {##actionImmediate: clear parameter-------------- ${$eSt}="s0"; HMtemplate_init($name); } elsif ($cmd eq "defTmpl" ) {# my ($tName) = @a; return "spezify template name" if (!defined $tName); return "$tName is already defined" if (defined $culHmTpl->{$tName}); readingsSingleUpdate($hash,"state","define",0); ${$eSt}="s2"; HMtemplate_init($name); $modules{HMtemplate}{AttrList} .= " tpl_type:peer-Short,peer-Long,peer-both,basic " ." tpl_source" ." tpl_peer" ; $hash->{tpl_Name} = $tName; delete $attr{$name}{$_} foreach(grep /^tpl_/,keys %{$attr{$name}});#clean the settings $attr{$name}{tpl_type} = ""; $attr{$name}{tpl_source} = ""; $attr{$name}{tpl_peer} = ""; $attr{$name}{tpl_params} = ""; $attr{$name}{tpl_description} = ""; $hash->{tpl_Info} = "please enter attr tpl_type tpl_source and tpl_peer"; } elsif ($cmd eq "select" ) {# my ($templ) = @a; return "$templ is not defined" if (! defined $culHmTpl->{$templ}); readingsSingleUpdate($hash,"state","assign",0); HMtemplate_init($name); ${$eSt}="s4"; if ($culHmTpl->{$templ}{p}){ foreach(split(" ",$culHmTpl->{$templ}{p})){ $modules{HMtemplate}{AttrList} .=" tpl_param_$_" ; $attr{$name}{"tpl_param_$_"} = ""; } } my @r = keys %{$culHmTpl->{$templ}{reg}}; ################### maybe store type in template hash########## my $tType; foreach my $rN (@r){ if ($culHmRegDefLS->{$rN}){# template for short/long $tType = "peer-Long"; } elsif ($culHmRegDef->{$rN}){ if($culHmRegDef->{$rN}{l} eq 3){$tType = "peer-both"} else{ $tType = "basic"; } } } ################### #### find matching entities ########## my @e = HMtemplate_sourceList($tType); my @eOk; foreach my $eN(@e){ my @eR = grep /\.?R-/,keys %{$defs{$eN}{READINGS}}; my $match = 1; foreach my $rN (@r){ if (!grep (/$rN/,@eR)){ $match = 0; last; } } push @eOk,$eN if ($match); } ################## $hash->{tpl_Name} = $templ; $hash->{tpl_type} = $tType; $hash->{tpl_description} = $culHmTpl->{$templ}{t}?$culHmTpl->{$templ}{t}:""; $modules{HMtemplate}{AttrList} .=" tpl_entity:".join(",",@eOk); $attr{$name}{"tpl_entity"} = ""; if ($tType ne "basic"){ $modules{HMtemplate}{AttrList} .=" tpl_ePeer"; $attr{$name}{"tpl_ePeer"} = ""; if ($tType ne "peer-both"){ $modules{HMtemplate}{AttrList} .=" tpl_eType:long,short"; $attr{$name}{"tpl_eType"} = ""; } } } elsif ($cmd eq "apply" ) {# my @p = split(" ",$culHmTpl->{$hash->{tpl_Name}}{p});## get params in correct order $_ = $attr{$name}{"tpl_param_$_"} foreach (@p); return HMinfo_templateSet( $attr{$name}{tpl_entity} ,$hash->{tpl_Name} ,($hash->{tpl_type} eq "basic"?"none" :$attr{$name}{tpl_ePeer}.":".AttrVal($name,"tpl_eType","both"))# type either long/short/both ,@p ); return; } elsif ($cmd eq "edit" ) {# my ($templ) = @a; return "$templ is not defined" if (! defined $culHmTpl->{$templ}); readingsSingleUpdate($hash,"state","edit",0); HMtemplate_init($name); ${$eSt}="s1"; my $tType = ""; $attr{$name}{tpl_params} = $culHmTpl->{$templ}{p}?$culHmTpl->{$templ}{p}:""; $attr{$name}{tpl_description} = $culHmTpl->{$templ}{t}?$culHmTpl->{$templ}{t}:""; my @param = split(" ",$culHmTpl->{$templ}{p}); my $paramS = join(",",@param);# whatchout: dont change order, may be replaced! foreach my $rN (sort keys %{$culHmTpl->{$templ}{reg}}){ my $val = $culHmTpl->{$templ}{reg}{$rN}; if ($val =~m /^p(.)$/){# this is a parameter!! $val = $param[$1]; } $attr{$name}{"Reg_".$rN} = $val; my $lits = ""; if ($culHmRegDefLS->{$rN}){# template for short/long next if($tType && $tType !~ m/peer-(Long|Short)/); $tType = "peer-Long"; $lits = ":".join(",",(sort(keys %{$culHmRegDefLS->{$rN}{lit}}),$paramS)) if ($culHmRegDefLS->{$rN}{c} eq "lit"); } elsif ($culHmRegDef->{$rN}){ if($culHmRegDef->{$rN}{l} eq 3){ next if($tType && $tType ne "peer-both"); $tType = "peer-both"; } else{ next if($tType && $tType ne "basic"); $tType = "basic"; } $lits = ":".join(",",(sort(keys %{$culHmRegDef->{$rN}{lit}}),$paramS)) if ($culHmRegDef->{$rN}{c} eq "lit"); } else{ next; } $modules{HMtemplate}{AttrList} .= " Reg_".$rN.$lits; } $hash->{tpl_Name} = $templ; $hash->{tpl_type} = $tType; $hash->{tpl_Param} = $culHmTpl->{$templ}{p}; } elsif ($cmd eq "save" ) {# my $tName = $hash->{tpl_Name}; if (eval "defined(&HMinfo_templateMark)"){ HMinfo_templateDef($tName,"del");# overwrite means: delete and write! return HMtemplate_save($name,$tName); } else{ return "HMInfo is not defined"; } } elsif ($cmd eq "saveAs" ) {# my ($tName) = @a; return HMtemplate_save($name,$tName); } else{ my @cmdLst = @{$HtState{${$eSt}}{cmd}}; my $tList = ":".join(",",sort keys%{$culHmTpl}); Log 1,"General start\n".join("\n :",sort keys%{$culHmTpl}); $_ .=$tList foreach(grep/^(edit|delete|select)$/,@cmdLst); $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst); } my $i = 0; readingsSingleUpdate($hash,"state",$HtState{${$eSt}}{name},0); $hash->{"tpl_Info".$i++}= $_ foreach (@{$HtState{${$eSt}}{info}}); return $ret; } sub HMtemplate_import(@){#################################################### my ($name,$eName,$tType,$tPeer) = @_; my @regReads; my ($ty,$match) = ("",""); if ($tType eq "basic"){ @regReads = grep !/\-.*\-/ ,grep /\.?R-/,keys %{$defs{$eName}{READINGS}}; } elsif ($tType =~ m/peer-(Long|Short)/){ $ty = $1 eq "Long" ? "lg" : "sh"; $match = ".*-"; @regReads = grep /\-.*\-$ty/ ,grep /\.?R-$tPeer/,keys %{$defs{$eName}{READINGS}}; } elsif ($tType eq "peer-both"){ $match = ".*-"; @regReads = grep /\-.*\-/ ,grep /\.?R-$tPeer/,keys %{$defs{$eName}{READINGS}}; } foreach my $rR (@regReads){ my $rN = $rR; $rN =~ s/\.?R-$match$ty//; $attr{$name}{"Reg_".$rN} = $defs{$eName}{READINGS}{$rR}{VAL}; $attr{$name}{"Reg_".$rN} =~ s/ .*//;# remove units which are in the readings my $lits = ":".join(",",(sort (keys %{$culHmRegDef->{$ty.$rN}{lit}}))) if ($culHmRegDef->{$ty.$rN}{c} eq "lit"); $modules{HMtemplate}{AttrList} .= " Reg_".$rN.$lits; } } sub HMtemplate_save($$) {# my ($name,$tName) = @_; return "$tName aleady defned - please choose a different name" if (defined $culHmTpl->{$tName}); return "enter tpl_description" if (!$attr{$name}{tpl_description}); return "enter at least one register" if ( !(grep /^Reg_/,keys %{$attr{$name}})); if (eval "defined(&HMinfo_templateMark)"){ my @regs; push @regs,substr($_,4).":".$attr{$name}{$_} foreach ( grep /^Reg_/,keys %{$attr{$name}}); my @params = split(" ",AttrVal($name,"tpl_params","")); my $i = 0; foreach my $p (@params){ $_ =~ s/$p/p$i/ foreach(@regs) ; $i++; } HMinfo_templateDef( $tName ,join(":",@params) ,AttrVal($name,"tpl_description","") ,@regs); } else{ return "HMInfo is not defined"; } } sub HMtemplate_init(@) {# my $name = shift; return if(!defined $defs{$name}); my $hash = $defs{$name}; delete $hash->{$_} foreach(grep /^tpl_/,keys %{$hash}); delete $attr{$name}{$_} foreach(grep /^Reg_/,keys %{$attr{$name}});#clean the settings delete $attr{$name}{$_} foreach(grep /^tpl_/,keys %{$attr{$name}});#clean the settings $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList}; } sub HMtemplate_noDup(@) {#return list with no duplicates########################### my %all; return "" if (scalar(@_) == 0); $all{$_}=0 foreach (grep {defined($_)} @_); delete $all{""}; #remove empties if present return (sort keys %all); } sub HMtemplate_sourceList($){ my $type = shift; my $match; if ($type =~ m/peer-(Long|Short|both)/){$match = "RegL_03"} elsif($type eq "basic" ){$match = "RegL_(01|00)"} my @list; foreach my $e (devspec2array("TYPE=CUL_HM:FILTER=subType!=virtual")){ my @l1 = grep/$match/,CUL_HM_reglUsed($e); $_ = $e foreach(@l1); push @list,@l1; } for (@list) { s/:.*//}; return HMtemplate_noDup(@list); } 1; =pod =item command =item summary definition and modification of homematic register templates =item summary_DE definition und modifikation von homematic register templates =begin html

HMtemplate

=begin html_DE

HMtemplate

=end html_DE =cut