98_HMtemplate.pm 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710
  1. ##############################################
  2. # $Id: 98_HMtemplate.pm 16604 2018-04-13 18:00:46Z martinp876 $
  3. package main;
  4. use strict;
  5. use warnings;
  6. my $culHmRegDef =\%HMConfig::culHmRegDefine;
  7. my $culHmRegDefLS =\%HMConfig::culHmRegDefShLg;
  8. my $culHmTpl =\%HMConfig::culHmTpl;
  9. sub HMtemplate_Initialize($$);
  10. sub HMtemplate_Define($$);
  11. sub HMtemplate_SetFn($@);
  12. sub HMtemplate_noDup(@);
  13. use Blocking;
  14. use HMConfig;
  15. my %HtState =(
  16. s0=>{name=>"init" ,cmd=>["select" ,"defTmpl","delete","edit"] ,info=>[ "delete to unassign a template definition"
  17. ,"defTmpl to greate a template"
  18. ,"- use an entity as default"
  19. ,"edit to modify a template definition"
  20. ,"select to assign a template to a entity"
  21. ]}
  22. ,s1=>{name=>"edit" ,cmd=>["dismiss","save" ,"saveAs","importReg"] ,info=>[ "change attr Reg_ as desired"
  23. ,"change attr tpl_params ':' separated"
  24. ,"save if finished"
  25. ,"saveAs to create a copy"
  26. ,"dismiss will reset HMtemplate"
  27. ]}
  28. ,s2=>{name=>"defTmpl",cmd=>["dismiss","save" ,"saveAs"] ,info=>[ "1)set attr tpl_type"
  29. ,"2)set attr tpl_source"
  30. ,"3)set attr tpl_peer if peer required"
  31. ,"4)set attr tpl_params ':' separated"
  32. ,"5)set attr tpl_description for the template"
  33. ]}
  34. ,s3=>{name=>"defTmpl",cmd=>["defTmpl","edit" ,"delete"] ,info=>[ "delete"
  35. ]}
  36. ,s4=>{name=>"select" ,cmd=>["dismiss","assign" ,"select","unassign"] ,info=>[ "assign/unassign the selected template to an entity"
  37. ,"1) choose target entity"
  38. ,"2) select a peer if required"
  39. ,"3) select type if required"
  40. ,"4) fill all attr tpl_param_"
  41. ,"5) set assign to execute and write the register"
  42. ]}
  43. ,s5=>{name=>"defTmpl",cmd=>["defTmpl","edit" ,"delete"] ,info=>[ "s5 info1"
  44. ,"s5 info2"
  45. ]}
  46. );
  47. sub HMtemplate_Initialize($$) {################################################
  48. my ($hash) = @_;
  49. $hash->{DefFn} = "HMtemplate_Define";
  50. $hash->{UndefFn} = "HMtemplate_Undef";
  51. $hash->{SetFn} = "HMtemplate_SetFn";
  52. $hash->{GetFn} = "HMtemplate_GetFn";
  53. $hash->{AttrFn} = "HMtemplate_Attr";
  54. $hash->{NotifyFn} = "HMtemplate_Notify";
  55. $hash->{AttrList} = "";
  56. $hash->{NOTIFYDEV} = "global";
  57. }
  58. sub HMtemplate_Define($$){#####################################################
  59. my ($hash, $def) = @_;
  60. my ($n) = devspec2array("TYPE=HMtemplate");
  61. return "only one instance of HMInfo allowed, $n already instantiated"
  62. if ($n && $hash->{NAME} ne $n);
  63. $hash->{helper}{attrList} = "tpl_params tpl_description "
  64. .$readingFnAttributes;
  65. $hash->{helper}{cSt} = "s0";
  66. $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList};
  67. return;
  68. }
  69. sub HMtemplate_Undef($$){######################################################
  70. my ($hash, $name) = @_;
  71. return undef;
  72. }
  73. sub HMtemplate_Attr(@) {#######################################################
  74. my ($cmd,$name,$attrName,$attrVal) = @_;
  75. my @hashL;
  76. my $hash = $defs{$name};
  77. #return "$attrName not an option in this state" if($modules{HMtemplate}{AttrList}!~ m/$attrName/);
  78. if ($attrName =~ m/^Reg_/){
  79. if (!$init_done){
  80. return "remove attr $attrName after restart - start again with template definition";
  81. }
  82. elsif ($cmd eq "set"){
  83. #burstRx =>{min=>0,max=>255 ,c=>'lit',f=>'',t=>'device reacts on Burst' ,lit=>{off=>0,on=>1}},
  84. #MaxTimeF =>{min=>0,max=>25.5 ,c=>'' ,f=>10,t=>"max time first direction." ,lit=>{unused=>25.5}},
  85. my $rN = substr($attrName,4);
  86. my $ty = (AttrVal($name,"tpl_type",InternalVal($name,"tpl_type","")) =~ m/peer-both/) ? "" : "lg"; #RegDef for long and short is identical. Just extend to any sh or lg
  87. my $calc = $culHmRegDef->{$ty.$rN}{c};
  88. if ($attr{$name}{tpl_params} && $attr{$name}{tpl_params} =~ m/\b$attrVal\b/){
  89. # allow any parameter in any string
  90. }
  91. elsif ($calc eq "lit"){
  92. return "value $attrVal not allowed for $rN" if (!defined $culHmRegDef->{$ty.$rN}{lit}{$attrVal});
  93. }
  94. elsif ($calc eq "fltCvT" ){ my $calcVal = CUL_HM_CvTflt (CUL_HM_fltCvT ($attrVal)); return "Value $attrVal not possible. Use $calcVal" if ($attrVal != $calcVal); }
  95. elsif ($calc eq "fltCvT60"){ my $calcVal = CUL_HM_CvTflt60(CUL_HM_fltCvT60($attrVal)); return "Value $attrVal not possible. Use $calcVal" if ($attrVal != $calcVal); }
  96. elsif ($calc eq "min2time"){ my $calcVal = CUL_HM_min2time(CUL_HM_time2min($attrVal)); return "Value $attrVal not possible. Use $calcVal" if ($attrVal != $calcVal); }
  97. else{
  98. return "value $attrVal not numeric for $rN" if ($attrVal !~/^\d+?\.?\d?$/);
  99. return "value $attrVal out of range for $rN :"
  100. .$culHmRegDef->{$ty.$rN}{min} ."..."
  101. .$culHmRegDef->{$ty.$rN}{max} if ($culHmRegDef->{$ty.$rN}{min} > $attrVal
  102. || $culHmRegDef->{$ty.$rN}{max} < $attrVal);
  103. }
  104. }
  105. else{# delete is ok anyhow
  106. }
  107. }
  108. elsif($attrName eq "tpl_params"){
  109. if (!$init_done){
  110. return "remove attr $attrName after restart - start again with template definition";
  111. }
  112. elsif ($cmd eq "set"){
  113. my @param = split(" ",$attrVal);
  114. my $paramCnt = scalar @param;
  115. foreach my $pN (grep /^p(.)/,values %{$culHmTpl->{$hash->{tpl_Name}}{reg}}){
  116. return "still $paramCnt in use. Remove those from template first" if($1 > ($paramCnt - 1));
  117. }
  118. foreach my $rN (keys %{$culHmTpl->{$hash->{tpl_Name}}{reg}}){#now we need to rename all readings if parameter are in use
  119. next if ($culHmTpl->{$hash->{tpl_Name}}{reg}{$rN} !~ m/^p(.)$/);
  120. my $no = $1;
  121. $attr{$name}{"Reg_".$rN} = $param[$no];
  122. }
  123. #remove old params
  124. if ($attr{$name}{tpl_params}){# first setting
  125. my @atS;
  126. foreach my $atS (split(" ",$modules{HMtemplate}{AttrList})){
  127. if ($atS !~ m/:/){# no values
  128. push @atS,$atS;
  129. next;
  130. }
  131. my ($aN,$aV) = split (":",$atS);
  132. my @aVaNew;
  133. foreach my $curAV(split(",",$aV)){
  134. next if (!$curAV);
  135. foreach my $curParam (split(",",$attr{$name}{tpl_params})){
  136. push @aVaNew,$_ if($curAV ne $curParam);
  137. }
  138. }
  139. push @atS,"$aN:".join(",",@aVaNew);
  140. }
  141. $modules{HMtemplate}{AttrList} = join(" ",sort @atS);
  142. }
  143. #now add new ones
  144. my $paramSnew = join(",",@param);
  145. my @at = split(" ",$modules{HMtemplate}{AttrList});
  146. $_ .= ",".$paramSnew foreach (grep (m/:/,@at));
  147. my $paramSold = join(",",split(" ",$attr{$name}{tpl_params}));
  148. #$modules{HMtemplate}{AttrList} =~ s/$paramSold/$paramSnew/g;
  149. $modules{HMtemplate}{AttrList} = join(" ",@at);
  150. $hash->{tpl_Param} = $attrVal;
  151. }
  152. }
  153. elsif($attrName eq "tpl_type"){
  154. if ($cmd eq "set"){
  155. my @list = HMtemplate_sourceList($attrVal);
  156. $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList}
  157. ." tpl_type:peer-Long,peer-Short,peer-both,basic "
  158. ." tpl_source:".join(",",@list)
  159. ." tpl_peer"
  160. ;
  161. $attr{$name}{tpl_source} = $attr{$name}{tpl_peer} = "";
  162. }
  163. }
  164. elsif($attrName eq "tpl_source"){
  165. if ($cmd eq "set"){
  166. $attr{$name}{tpl_peer} = "";
  167. if($attr{$name}{tpl_type} eq "basic"){# we dont need peer - import now
  168. HMtemplate_import($name,$attrVal,"basic");
  169. }
  170. else{# need peer
  171. my $peerList = InternalVal($attrVal,"peerList","");
  172. return "no peer present for $attrVal" if (!$peerList );
  173. $modules{HMtemplate}{AttrList} =~ s/tpl_peer.*?( |$)//;
  174. $modules{HMtemplate}{AttrList} .=" tpl_peer:$peerList";
  175. }
  176. }
  177. }
  178. elsif($attrName eq "tpl_peer"){
  179. if ($cmd eq "set"){
  180. HMtemplate_import($name,$attr{$name}{tpl_source},$attr{$name}{tpl_type},$attrVal);
  181. }
  182. }
  183. elsif($attrName eq "tpl_entity"){# used with select option
  184. if ($cmd eq "set"){
  185. return "entity:$attrVal not defined" if(!defined $defs{$attrVal});
  186. $attr{$name}{tpl_ePeer} = "";
  187. if($hash->{tpl_type} eq "basic"){# we dont need peer - import now
  188. }
  189. else{# need peer
  190. my $peerList = InternalVal($attrVal,"peerList","");
  191. return "no peer present for $attrVal" if (!$peerList );
  192. $modules{HMtemplate}{AttrList} =~ s/tpl_ePeer.*?( |$)//;
  193. $modules{HMtemplate}{AttrList} .=" tpl_ePeer:$peerList";
  194. }
  195. ############ set attr param from device if selected
  196. if(ReadingsVal($hash->{NAME},"state","") eq "select"){# do we have to set params?
  197. my $dh = $defs{$attrVal};
  198. my ($tName,$tType) = (InternalVal($name,"tpl_Name",""),InternalVal($name,"tpl_type",""));
  199. if ( $tType eq "basic"){ #we have enough to prefill parameter
  200. my @pN = split(" ",$culHmTpl->{$tName}{p});## get param Names template
  201. my @pD ;
  202. @pD = split(" ",$dh->{helper}{tmpl}{"0>$tName"})
  203. if( defined $dh->{helper}{tmpl}
  204. && defined $dh->{helper}{tmpl}{"0>$tName"});
  205. for (my $cnt = 0;$cnt < scalar(@pN); $cnt++){
  206. $attr{$name}{"tpl_param_$pN[$cnt]"} = defined $pD[$cnt] ? $pD[$cnt] : "";
  207. }
  208. }
  209. }
  210. }
  211. else{
  212. $attr{$name}{tpl_ePeer} = "";
  213. $modules{HMtemplate}{AttrList} =~ s/ tpl_ePeer.*?\ / tpl_ePeer/;
  214. }
  215. }
  216. elsif($attrName eq "tpl_ePeer"){# used with select option
  217. if ($cmd eq "set"){
  218. }
  219. }
  220. elsif($attrName eq "tpl_eType"){# used with select option
  221. if ($cmd eq "set"){
  222. }
  223. }
  224. elsif($attrName eq "tpl_description"){# used with select option
  225. if ($cmd eq "set"){
  226. }
  227. }
  228. return;
  229. }
  230. sub HMtemplate_Notify(@){######################################################
  231. my ($hash,$dev) = @_;
  232. return "" if ($dev->{NAME} ne "global");
  233. if (grep (m/^INITIALIZED$/,@{$dev->{CHANGED}})){
  234. if ($hash->{helper}{attrPend}){
  235. my $aVal = AttrVal($hash->{NAME},"logIDs","");
  236. HMLAN_Attr("set",$hash->{NAME},"logIDs",$aVal) if($aVal);
  237. delete $hash->{helper}{attrPend};
  238. }
  239. }
  240. elsif (grep (m/^SHUTDOWN$/,@{$dev->{CHANGED}})){
  241. HMtemplate_init($hash->{name});# clear attribut bevore safe
  242. }
  243. return undef;
  244. }
  245. sub HMtemplate_GetFn($@) {#####################################################
  246. my ($hash,$name,$cmd,@a) = @_;
  247. my $ret;
  248. $cmd = "?" if(!$cmd);# by default print options
  249. #------------ statistics ---------------
  250. if($cmd eq "defineCmd"){##print protocol-events-------------------------
  251. my ($tN) = @a;
  252. return "template not given" if(!defined $tN);
  253. return "template unknown $tN" if(!defined $culHmTpl->{$tN});
  254. return "set hm templateDef $tN "
  255. .join(":",split(" ",($culHmTpl->{$tN}{p} ? $culHmTpl->{$tN}{p} : "0")))
  256. ." \"$culHmTpl->{$tN}{t}\""
  257. ." ".join(" ",map{$_.=":".$culHmTpl->{$tN}{reg}{$_}} keys %{$culHmTpl->{$tN}{reg}})
  258. ;
  259. }
  260. elsif($cmd eq "regInfo"){##print protocol-events-------------------------
  261. my @regArr = map { $_ =~ s/Reg_//g; $_ }
  262. grep /^Reg_/,keys %{$attr{$name}};
  263. if (InternalVal($name,"tpl_type","") =~ m/peer-(short|long)/){
  264. $_ = "lg".$_ foreach (@regArr);
  265. }
  266. return CUL_HM_getRegInfo($name); #
  267. }
  268. else{
  269. my @cmdLst = ( "defineCmd"
  270. ,"regInfo"
  271. );
  272. my $tList = ":".join(",",sort keys%{$culHmTpl});
  273. $_ .=$tList foreach(grep/^(defineCmd)$/,@cmdLst);
  274. $_ .=":noArg" foreach(grep/^(regInfo)$/,@cmdLst);# no arguments
  275. $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst);
  276. }
  277. return $ret;
  278. }
  279. sub HMtemplate_SetFn($@) {#####################################################
  280. my ($hash,$name,$cmd,@a) = @_;
  281. my $ret = "";
  282. my $eSt = \$hash->{helper}{cSt};# shortcut
  283. $cmd = "?" if(!$cmd);# by default print options
  284. $cmd .=" " if ($cmd ne "?" && !(grep /$cmd/,@{$HtState{${$eSt}}{cmd}}));
  285. HMtemplate_setUsageReading($hash);
  286. if ($cmd eq "delete" ) {##actionImmediate: delete template--------------
  287. my ($tName) = @a;
  288. return "$tName is not defined" if (! defined $culHmTpl->{$tName});
  289. ${$eSt} = "s0";
  290. if (eval "defined(&HMinfo_templateMark)"){
  291. HMinfo_templateDef($tName,"del");
  292. }
  293. else{
  294. return "HMInfo is not defined";
  295. }
  296. HMtemplate_init($name);
  297. }
  298. elsif ($cmd eq "dismiss" ) {##actionImmediate: clear parameter--------------
  299. ${$eSt}="s0";
  300. HMtemplate_init($name);
  301. }
  302. elsif ($cmd eq "defTmpl" ) {#
  303. my ($tName) = @a;
  304. return "specify template name" if (!defined $tName);
  305. return "$tName is already defined" if (defined $culHmTpl->{$tName});
  306. readingsSingleUpdate($hash,"state","define",0);
  307. ${$eSt}="s2";
  308. HMtemplate_init($name);
  309. $modules{HMtemplate}{AttrList} .= " tpl_type:peer-Short,peer-Long,peer-both,basic "
  310. ." tpl_source"
  311. ." tpl_peer"
  312. ;
  313. $hash->{tpl_Name} = $tName;
  314. delete $attr{$name}{$_} foreach(grep /^tpl_/,keys %{$attr{$name}});#clean the settings
  315. $attr{$name}{tpl_type} = "";
  316. $attr{$name}{tpl_source} = "";
  317. $attr{$name}{tpl_peer} = "";
  318. $attr{$name}{tpl_params} = "";
  319. $attr{$name}{tpl_description} = "";
  320. $hash->{tpl_Info} = "please enter attr tpl_type tpl_source and tpl_peer";
  321. }
  322. elsif ($cmd eq "select" ) {#
  323. my ($templ) = @a;
  324. return "$templ is not defined" if (! defined $culHmTpl->{$templ});
  325. readingsSingleUpdate($hash,"state","assign",0);
  326. HMtemplate_init($name);
  327. ${$eSt}="s4";
  328. if ($culHmTpl->{$templ}{p}){
  329. foreach(split(" ",$culHmTpl->{$templ}{p})){
  330. $modules{HMtemplate}{AttrList} .=" tpl_param_$_" ;
  331. $attr{$name}{"tpl_param_$_"} = "";
  332. }
  333. }
  334. my @r = keys %{$culHmTpl->{$templ}{reg}};
  335. ################### maybe store type in template hash##########
  336. my $tType;
  337. foreach my $rN (@r){
  338. if ($culHmRegDefLS->{$rN}){# template for short/long
  339. $tType = "peer-Long";
  340. }
  341. elsif ($culHmRegDef->{$rN}){
  342. if($culHmRegDef->{$rN}{l} eq 3){$tType = "peer-both"}
  343. else{ $tType = "basic"; }
  344. }
  345. }
  346. ###################
  347. #### find matching entities ##########
  348. my @e = HMtemplate_sourceList($tType);
  349. my @eOk;
  350. foreach my $eN(@e){
  351. my @eR = grep /\.?R-/,keys %{$defs{$eN}{READINGS}};
  352. my $match = 1;
  353. foreach my $rN (@r){
  354. if (!grep (/$rN/,@eR)){
  355. $match = 0;
  356. last;
  357. }
  358. }
  359. push @eOk,$eN if ($match);
  360. }
  361. ##################
  362. $hash->{tpl_Name} = $templ;
  363. $hash->{tpl_type} = $tType;
  364. $hash->{tpl_description} = $culHmTpl->{$templ}{t}?$culHmTpl->{$templ}{t}:"";
  365. $modules{HMtemplate}{AttrList} .=" tpl_entity:".join(",",@eOk);
  366. $attr{$name}{"tpl_entity"} = "";
  367. if ($tType ne "basic"){
  368. $modules{HMtemplate}{AttrList} .=" tpl_ePeer";
  369. $attr{$name}{"tpl_ePeer"} = "";
  370. if ($tType ne "peer-both"){
  371. $modules{HMtemplate}{AttrList} .=" tpl_eType:long,short";
  372. $attr{$name}{"tpl_eType"} = "";
  373. }
  374. }
  375. }
  376. elsif ($cmd eq "assign" ) {#
  377. my @p = split(" ",$culHmTpl->{$hash->{tpl_Name}}{p});## get params in correct order
  378. $_ = $attr{$name}{"tpl_param_$_"} foreach (@p);
  379. return HMinfo_templateSet( $attr{$name}{tpl_entity}
  380. ,$hash->{tpl_Name}
  381. ,($hash->{tpl_type} eq "basic" ? "0"
  382. : $attr{$name}{tpl_ePeer}.":".AttrVal($name,"tpl_eType","both"))# type either long/short/both
  383. ,@p
  384. );
  385. }
  386. elsif ($cmd eq "unassign" ) {# General - still open
  387. my ($entityName,$entityPeer) = split(";",$a[0]);
  388. return HMinfo_templateDel( $entityName
  389. ,$hash->{tpl_Name}
  390. ,$entityPeer);
  391. }
  392. elsif ($cmd eq "importReg" ){#
  393. my ($eName) = @a;
  394. return "please enter a device to be used "if(!$eName);
  395. my @fnd = grep /^$eName /,
  396. map {$hash->{READINGS}{$_}{VAL}}
  397. grep /^usage_/,keys %{$hash->{READINGS}};
  398. return "template not assigned to $eName" if (scalar(@fnd) != 1);
  399. HMtemplate_import($name,$eName,InternalVal($name,"tpl_type",""),InternalVal($name,"tpl_peer",""));
  400. }
  401. elsif ($cmd eq "edit" ) {#
  402. my ($templ) = @a;
  403. return "$templ is not defined" if (! defined $culHmTpl->{$templ});
  404. readingsSingleUpdate($hash,"state","edit",0);
  405. HMtemplate_init($name);
  406. ${$eSt}="s1";
  407. my $tType = "";
  408. $attr{$name}{tpl_params} = $culHmTpl->{$templ}{p} ? $culHmTpl->{$templ}{p} : "";
  409. $attr{$name}{tpl_description} = $culHmTpl->{$templ}{t} ? $culHmTpl->{$templ}{t} : "";
  410. my @param = split(" ",$culHmTpl->{$templ}{p});
  411. my $paramS = join(",",@param);# whatchout: dont change order, may be replaced!
  412. foreach my $rN (sort keys %{$culHmTpl->{$templ}{reg}}){
  413. my $val = $culHmTpl->{$templ}{reg}{$rN};
  414. if ($val =~m /^p(.)$/){# this is a parameter!!
  415. $val = $param[$1];
  416. }
  417. $attr{$name}{"Reg_".$rN} = $val;
  418. my $lits = "";
  419. if ($culHmRegDefLS->{$rN}){# template for short/long
  420. next if($tType && $tType !~ m/peer-(Long|Short)/);
  421. $tType = "peer-Long";
  422. $lits = ":".join(",",(sort(keys %{$culHmRegDefLS->{$rN}{lit}}),$paramS)) if ($culHmRegDefLS->{$rN}{c} eq "lit");
  423. }
  424. elsif ($culHmRegDef->{$rN}){
  425. if($culHmRegDef->{$rN}{l} eq 3){
  426. next if($tType && $tType ne "peer-both");
  427. $tType = "peer-both";
  428. }
  429. else{
  430. next if($tType && $tType ne "basic");
  431. $tType = "basic";
  432. }
  433. $lits = ":".join(",",(sort(keys %{$culHmRegDef->{$rN}{lit}}),$paramS)) if ($culHmRegDef->{$rN}{c} eq "lit");
  434. }
  435. else{
  436. next;
  437. }
  438. $modules{HMtemplate}{AttrList} .= " Reg_".$rN.$lits;
  439. }
  440. $hash->{tpl_Name} = $templ;
  441. $hash->{tpl_type} = $tType;
  442. $hash->{tpl_Param} = $culHmTpl->{$templ}{p};
  443. }
  444. elsif ($cmd eq "save" ) {#
  445. my $tName = $hash->{tpl_Name};
  446. if (eval "defined(&HMinfo_templateMark)"){
  447. HMinfo_templateDef($tName,"del");# overwrite means: delete and write!
  448. return HMtemplate_save($name,$tName);
  449. }
  450. else{
  451. return "HMInfo is not defined";
  452. }
  453. }
  454. elsif ($cmd eq "saveAs" ) {#
  455. my ($tName) = @a;
  456. return HMtemplate_save($name,$tName);
  457. }
  458. else{
  459. #"select","edit","delete", "defTmpl","dismiss","save","saveAs","importReg","assign"]
  460. my @cmdLst = @{$HtState{${$eSt}}{cmd}};
  461. my $tList = ":".join(",",sort keys%{$culHmTpl});
  462. $_ .=$tList foreach(grep/^(edit|delete|select)$/,@cmdLst);
  463. $tList = ":". join(",",map{(my $foo = $_) =~ s/^(.*?)\s*\|(.*?)\s*\|.*/$1;$2/;$foo}
  464. map{$defs{ht}{READINGS}{$_}{VAL}}
  465. grep /^usage/,keys %{$defs{$name}{READINGS}});
  466. $tList =~ s/ //g;
  467. $_ .= $tList foreach(grep/^(unassign)$/,@cmdLst);
  468. if (grep/^importReg$/,@cmdLst){
  469. my @fnd = map { $_ =~ s/ .*//g; $_ }
  470. map {$hash->{READINGS}{$_}{VAL}}
  471. grep /^usage_/,keys %{$hash->{READINGS}};
  472. my $eList = ":".join(",",sort @fnd);
  473. $_ .= $eList foreach(grep/^(importReg)$/,@cmdLst);
  474. }
  475. $_ .= ":noArg" foreach(grep/^(save|dismiss|assign)$/,@cmdLst);# no arguments
  476. $ret = "Unknown argument $cmd, choose one of ".join (" ",sort @cmdLst);
  477. }
  478. my $i = 0;
  479. readingsSingleUpdate($hash,"state",$HtState{${$eSt}}{name},0);
  480. $hash->{"tpl_Info".$i++}= $_ foreach (@{$HtState{${$eSt}}{info}});
  481. return $ret;
  482. }
  483. sub HMtemplate_intersection($$) {#
  484. my ($x, $y) = @_;
  485. my %seen;
  486. @seen{ @$x } = (1) x @$x;
  487. return grep { $seen{ $_} } @$y;
  488. }
  489. sub HMtemplate_import(@){####################################################
  490. my ($name,$eName,$tType,$tPeer) = @_;
  491. my @regReads;
  492. my ($ty,$match) = ("","");
  493. if ($tType eq "basic"){
  494. @regReads = grep !/\-.*\-/ ,grep /\.?R-/ ,keys %{$defs{$eName}{READINGS}};
  495. }
  496. elsif ($tType =~ m/peer-(Long|Short)/){
  497. $ty = $1 eq "Long" ? "lg" : "sh";
  498. $match = ".*-";
  499. @regReads = grep /\-.*\-$ty/ ,grep /\.?R-$tPeer/,keys %{$defs{$eName}{READINGS}};
  500. }
  501. elsif ($tType eq "peer-both"){
  502. $match = ".*-";
  503. @regReads = grep /\-.*\-/ ,grep /\.?R-$tPeer/,keys %{$defs{$eName}{READINGS}};
  504. }
  505. foreach my $rR (@regReads){
  506. my $rN = $rR;
  507. $rN =~ s/\.?R-$match$ty//;
  508. if (!$attr{$name}{"Reg_".$rN}){ #dont overwrite existing
  509. $attr{$name}{"Reg_".$rN} = $defs{$eName}{READINGS}{$rR}{VAL};
  510. $attr{$name}{"Reg_".$rN} =~ s/ .*//;# remove units which are in the readings
  511. my $lits = ":".join(",",(sort (keys %{$culHmRegDef->{$ty.$rN}{lit}}))) if ($culHmRegDef->{$ty.$rN}{c} eq "lit");
  512. $modules{HMtemplate}{AttrList} .= " Reg_".$rN.$lits;
  513. }
  514. }
  515. }
  516. sub HMtemplate_save($$) {#
  517. my ($name,$tName) = @_;
  518. return "$tName aleady defned - please choose a different name" if (defined $culHmTpl->{$tName});
  519. return "enter tpl_description" if (!$attr{$name}{tpl_description});
  520. return "enter at least one register" if ( !(grep /^Reg_/,keys %{$attr{$name}}));
  521. if (eval "defined(&HMinfo_templateMark)"){
  522. my @regs;
  523. push @regs,substr($_,4).":".$attr{$name}{$_} foreach ( grep /^Reg_/,keys %{$attr{$name}});
  524. my @params = split(" ",AttrVal($name,"tpl_params",""));
  525. my $i = 0;
  526. foreach my $p (@params){
  527. $_ =~ s/(.*:)$p$/$1p$i/ foreach(@regs) ;
  528. $i++;
  529. }
  530. HMinfo_templateDef( $tName
  531. ,join(":",@params)
  532. ,AttrVal($name,"tpl_description","")
  533. ,@regs);
  534. }
  535. else{
  536. return "HMInfo is not defined";
  537. }
  538. }
  539. sub HMtemplate_init(@) {#
  540. my $name = shift;
  541. return if(!defined $name || !defined $defs{$name});
  542. my $hash = $defs{$name};
  543. delete $hash->{$_} foreach(grep /^tpl_/,keys %{$hash});
  544. delete $attr{$name}{$_} foreach(grep /^Reg_/,keys %{$attr{$name}});#clean the settings
  545. delete $attr{$name}{$_} foreach(grep /^tpl_/,keys %{$attr{$name}});#clean the settings
  546. $modules{HMtemplate}{AttrList} = $hash->{helper}{attrList};
  547. }
  548. sub HMtemplate_noDup(@) {#return list with no duplicates###########################
  549. my %all;
  550. return "" if (scalar(@_) == 0);
  551. $all{$_}=0 foreach (grep {defined($_)} @_);
  552. delete $all{""}; #remove empties if present
  553. return (sort keys %all);
  554. }
  555. sub HMtemplate_sourceList($){
  556. my $type = shift;
  557. my $match;
  558. if ($type =~ m/peer-(Long|Short|both)/){$match = "RegL_03"}
  559. elsif($type eq "basic" ){$match = "RegL_(01|00)"}
  560. my @list;
  561. foreach my $e (devspec2array("TYPE=CUL_HM:FILTER=subType!=virtual")){
  562. my @l1 = grep/$match/,CUL_HM_reglUsed($e);
  563. $_ = $e foreach(@l1);
  564. push @list,@l1;
  565. }
  566. for (@list) { s/:.*//};
  567. return HMtemplate_noDup(@list);
  568. }
  569. sub HMtemplate_setUsageReading($){
  570. my ($hash) = @_;
  571. delete $hash->{READINGS}{$_} foreach (grep /^usage_/,keys %{$hash->{READINGS}});
  572. if (eval "defined(&HMinfo_templateUsg)" && $hash->{tpl_Name}){
  573. my $tu = HMinfo_templateUsg("","",$hash->{tpl_Name});
  574. $tu =~ s/\|$hash->{tpl_Name}//g;
  575. my $usgCnt = 1;
  576. readingsBeginUpdate($hash);
  577. readingsBulkUpdate($hash,"usage_".$usgCnt++,$_) foreach(split("\n",$tu));
  578. readingsEndUpdate($hash,1);
  579. }
  580. }
  581. 1;
  582. =pod
  583. =item command
  584. =item summary definition and modification of homematic register templates
  585. =item summary_DE definition und modifikation von homematic register templates
  586. =begin html
  587. <a name="HMtemplate"></a><h3>HMtemplate</h3>
  588. <ul>
  589. Edit templates for HM entities. Programming register of HM devices can be bundled to templates and then being assigned to the devices. The editor might be instantiated ony once. Templates will be organized, handled and loaded in HMinfo. <br>
  590. The editor allowes to define, edit, copy and assign and delete templates.
  591. <br>
  592. Required: HMinfo needs to be instantiated.
  593. <a name="HMtemplate"></a><b>Set</b>
  594. <ul>
  595. following commands are available:
  596. <ul>
  597. <li><B>defTmpl &lt;name&gt;</B><a name="HMtemplate_defTmpl"></a><br>
  598. Define a new template. Procedure is given in internals once the command is issued.<br>
  599. <li><B><a href="#HMtemplate_tpl_type">tpl_type</a></B>choose whether the template will be:
  600. <ul>
  601. <li><B>basic</B> not peer related register only</li>
  602. <li><B>peer-both</B> only peer related register, setting short and long press reaction in one template</li>
  603. <li><B>peer-Short</B> only peer related register, will define one short or long press behavior</li>
  604. <li><B>peer-Long</B> only peer related register, will define one short or long press behavior</li>
  605. </ul>
  606. </li>
  607. <li><B><a href="#HMtemplate_tpl_source">tpl_source</a></B>select the entity which will be used as master for the template
  608. </li>
  609. <li><B><a href="#HMtemplate_tpl_peer">tpl_peer</a></B>select the peer of the entity which will be used as master for the template. This is only necessary for types that require peers.
  610. </li>
  611. <li><B><a href="#HMtemplate_tpl_params">tpl_params</a></B>if the template shall have parameter those need to be defined next. <br>
  612. parameter will allow to use one template with selected registers to be defined upon appling to the entity.
  613. </li>
  614. <li><B><a href="#HMtemplate_tpl_description">tpl_description</a></B>enter a free text to describe what the entity is about
  615. </li>
  616. <li><B><a href="#HMtemplate_tpl_Reg">tpl_Reg</a></B>a list of attributes will be available after all attribtes above are set. Not edit them. Delete registers which are not used for the template, edit the values as desired.
  617. </li>
  618. <li><B><a href="#HMtemplate_save">save</a></B>save the template. After that the template is defined. saveas will allow to define the template with a different name.
  619. </li>
  620. </li>
  621. <li><B>delete &lt;name&gt;</B><a name="HMtemplate_delete"></a><br>
  622. Delete an existing template<br>
  623. </li>
  624. <li><B>edit &lt;name&gt;</B><a name="HMtemplate_edit"></a><br>
  625. Edit an existing template. Change register, parameter and description by change the attributes. See also defTmpl<br>
  626. saveAs can be used to create a copy of the template.<br>
  627. </li>
  628. <li><B>select &lt;name&gt;</B><a name="HMtemplate_select"></a><br>
  629. Apply an existing template to a entity<br>
  630. Once the command is issued it is necessary to select the entity, peer and short/long which the entity shall be applied to.<br>
  631. If the template has parameter the value needs to be set. <br>
  632. Finally <B>assign</B> the template to teh entity.
  633. </li>
  634. <li><B>dismiss</B><a name="HMtemplate_dismiss"></a><br>
  635. reset HMtemplate and come back to init status
  636. </li>
  637. <li><B>assign</B><a name="HMtemplate_assign"></a><br>
  638. assign a template to an entity
  639. </li>
  640. <li><B>unassign &lt;entity&gt; &lt;peer&gt;</B><a name="HMtemplate_unassign"></a><br>
  641. unassign an entity from an entity
  642. </li>
  643. <li><B>save, saveAs</B><a name="HMtemplate_save"></a><br>
  644. save a template once it is defined
  645. </li>
  646. </ul>
  647. </ul>
  648. </ul>
  649. =end html
  650. =begin html_DE
  651. <a name="HMtemplate"></a>
  652. <h3>HMtemplate</h3>
  653. <ul>
  654. </ul>
  655. =end html_DE
  656. =cut