############################################## # $Id$ package main; my %templates; my $initialized; my %cachedUsage; sub AttrTemplate_Initialize() { my $me = "AttrTemplate_Initialize"; my $dir = $attr{global}{modpath}."/FHEM/lib/AttrTemplate"; if(!opendir(dh, $dir)) { Log 1, "$me: cant open $dir: $!"; return; } my @files = grep /\.template$/, sort readdir dh; closedir(dh); %templates = (); %cachedUsage = (); for my $file (@files) { if(!open(fh,"$dir/$file")) { Log 1, "$me: cant open $dir/$file: $!"; next; } my ($name, %h, $lastComment); while(my $line = ) { chomp($line); next if($line =~ m/^$/); if($line =~ m/^# *(.*)$/) { # just a replacement for missing desc $lastComment = $1; next; } elsif($line =~ m/^name:(.*)/) { $name = $1; my (@p,@c); $templates{$name}{pars} = \@p; $templates{$name}{cmds} = \@c; $templates{$name}{desc} = $lastComment if($lastComment); $lastComment = ""; } elsif($line =~ m/^filter:(.*)=(.*)/) { $templates{$name}{filterName} = $1; $templates{$name}{filterVal} = $2; } elsif($line =~ m/^par:(.*)/) { push(@{$templates{$name}{pars}}, $1); } elsif($line =~ m/^desc:(.*)/) { $templates{$name}{desc} = $1; } else { push(@{$templates{$name}{cmds}}, $line); } } close(fh); } my $nr = (int keys %templates); $initialized = 1; Log 2, "AttrTemplates: got $nr entries" if($nr); } sub AttrTemplate_Set($$@) { my ($hash, $list, $name, $cmd, @a) = @_; AttrTemplate_Initialize() if(!$initialized); my $haveDesc; if($cmd ne "attrTemplate") { if(!$cachedUsage{$name}) { my @list; for my $k (sort keys %templates) { my $h = $templates{$k}; if(!$h->{filterName} || $hash->{$h->{filterName}} eq $h->{filterVal}) { push @list, $k; $haveDesc = 1 if($h->{desc}); } } $cachedUsage{$name} = (@list ? "attrTemplate:".($haveDesc ? "?,":"").join(",",@list) : ""); } $list .= " " if($list ne ""); return "Unknown argument $cmd, choose one of $list$cachedUsage{$name}"; } return "Missing template_entry_name parameter for attrTemplate" if(@a < 1); my $entry = shift(@a); if($entry eq "?") { my @hlp; for my $k (sort keys %templates) { my $h = $templates{$k}; if(!$h->{filterName} || $hash->{$h->{filterName}} eq $h->{filterVal}) { push @hlp, "$k: $h->{desc}" if($h->{desc}); } } return "no help available" if(!@hlp); if($hash->{CL} && $hash->{CL}{TYPE} eq "FHEMWEB") { return ""; } return join("\n", @hlp); } my $h = $templates{$entry}; return "Unknown template_entry_name $entry" if(!$h); my (%repl, @mComm, @mList, $missing); for my $k (@{$h->{pars}}) { my ($parname, $comment, $perl_code) = split(";",$k,3); if(@a) { $repl{$parname} = $a[0]; push(@mList, $parname); push(@mComm, "$parname: with the $comment"); shift(@a); next; } if($perl_code) { $perl_code =~ s/DEVICE/$name/g; my $ret = eval $perl_code; return "Error checking template regexp: $@" if($@); if($ret) { $repl{$parname} = $ret; next; } } push(@mList, $parname); push(@mComm, "$parname: with the $comment"); $missing = 1; } if($missing) { if($hash->{CL} && $hash->{CL}{TYPE} eq "FHEMWEB") { return "". "". "

Replace
".join("
",@mComm). ' '; } else { return "Usage: set $name attrTemplate $entry @mList\nReplace\n". join("\n", @mComm); } } my $cmdlist = join("\n",@{$h->{cmds}}); $repl{DEVICE} = $name; map { $cmdlist =~ s/$_/$repl{$_}/g; } keys %repl; my $cmd = ""; my @ret; map { if($_ =~ m/^(.*)\\$/) { $cmd .= "$1\n"; } else { my $r = AnalyzeCommand($hash->{CL}, $cmd.$_); push(@ret, $r) if($r); $cmd = ""; } } split("\n", $cmdlist); return @ret ? join("\n", @ret) : undef; } 1;