############################################# # $Id$ # # This file is part of fhem. # # Fhem is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # Fhem is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License655 # along with fhem. If not, see . # ############################################## package main; use strict; use warnings; use Blocking; use Color; use vars qw($FW_CSRF $FW_room); my $hs; sub DOIF_cmd ($$$$); sub DOIF_Notify ($$); sub DOIF_delTimer($) { my ($hash) = @_; RemoveInternalTimer($hash); foreach my $key (keys %{$hash->{triggertime}}) { RemoveInternalTimer (\$hash->{triggertime}{$key}); } foreach my $key (keys %{$hash->{ptimer}}) { RemoveInternalTimer (\$hash->{ptimer}{$key}); } } sub DOIF_killBlocking($) { my ($hash) = @_; foreach my $key (keys %{$hash->{var}{blockingcalls}}) { BlockingKill($hash->{var}{blockingcalls}{$key}) if(defined($hash->{var}{blockingcalls}{$key})); } } sub DOIF_delAll($) { my ($hash) = @_; DOIF_killBlocking($hash); delete ($hash->{helper}); delete ($hash->{condition}); delete ($hash->{do}); #delete ($hash->{devices}); delete ($hash->{time}); delete ($hash->{timer}); delete ($hash->{timers}); delete ($hash->{itimer}); delete ($hash->{timeCond}); delete ($hash->{realtime}); delete ($hash->{localtime}); delete ($hash->{days}); delete ($hash->{readings}); delete ($hash->{internals}); delete ($hash->{trigger}); delete ($hash->{triggertime}); delete ($hash->{ptimer}); delete ($hash->{interval}); delete ($hash->{intervaltimer}); delete ($hash->{intervalfunc}); delete ($hash->{perlblock}); delete ($hash->{var}); delete ($hash->{accu}); delete ($hash->{collect}); delete ($hash->{Regex}); delete ($hash->{defs}); #foreach my $key (keys %{$hash->{Regex}}) { # delete $hash->{Regex}{$key} if ($key !~ "STATE|DOIF_Readings|uiTable"); #} my $readings = ($hash->{MODEL} eq "Perl") ? "^(Device|error|warning|cmd|e_|timer_|wait_|matched_|last_cmd|mode|block_)":"^(Device|state|error|warning|cmd|e_|timer_|wait_|matched_|last_cmd|mode|block_)"; foreach my $key (keys %{$defs{$hash->{NAME}}{READINGS}}) { delete $defs{$hash->{NAME}}{READINGS}{$key} if ($key =~ $readings); } } sub DOIF_Initialize($) { my ($hash) = @_; $hash->{DefFn} = "DOIF_Define"; $hash->{SetFn} = "DOIF_Set"; $hash->{GetFn} = "DOIF_Get"; $hash->{UndefFn} = "DOIF_Undef"; $hash->{ShutdownFn} = "DOIF_Shutdown"; $hash->{AttrFn} = "DOIF_Attr"; $hash->{NotifyFn} = "DOIF_Notify"; $hash->{FW_deviceOverview} = 1; $hash->{FW_addDetailToSummary} = 1; $hash->{FW_detailFn} = "DOIF_detailFn"; $hash->{FW_summaryFn} = "DOIF_summaryFn"; #$hash->{FW_atPageEnd} = 1; $data{FWEXT}{DOIF}{SCRIPT} = "doif.js"; $hash->{AttrList} = "disable:0,1 loglevel:0,1,2,3,4,5,6 wait:textField-long do:always,resetwait cmdState startup:textField-long state:textField-long initialize repeatsame repeatcmd waitsame waitdel cmdpause timerWithWait:1,0 notexist selftrigger:wait,all timerevent:1,0 checkReadingEvent:0,1 addStateEvent:1,0 checkall:event,timer,all weekdays setList:textField-long readingList DOIF_Readings:textField-long event_Readings:textField-long uiTable:textField-long ".$readingFnAttributes; } # uiTable sub DOIF_reloadFW { map { FW_directNotify("#FHEMWEB:$_", "location.reload()", "") } devspec2array("TYPE=FHEMWEB"); } sub DOIF_hsv { my ($cur,$min,$max,$min_s,$max_s,$s,$v)=@_; $s=100 if (!defined ($s)); $v=100 if (!defined ($v)); my $m=($max_s-$min_s)/($max-$min); my $n=$min_s-$min*$m; if ($cur>$max) { $cur=$max; } elsif ($cur<$min) { $cur=$min; } my $h=$cur*$m+$n; $h /=360; $s /=100; $v /=100; my($r,$g,$b)=Color::hsv2rgb ($h,$s,$v); $r *= 255; $g *= 255; $b *= 255; return sprintf("#%02X%02X%02X", $r+0.5, $g+0.5, $b+0.5); } sub DOIF_rgb { my ($sc,$ec,$pct,$max,$cur) = @_; $cur = ($cur =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); $pct = ($cur-$pct)/($max-$pct) if (@_ == 5); my $prefix = ""; $prefix = "#" if ("$sc $ec"=~"#"); $sc =~ s/^#//; $ec =~ s/^#//; $pct = $pct > 1 ? 1 : $pct; $pct = $pct < 0 ? 0 : $pct; $sc =~/([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})/; my @sc = (hex($1),hex($2),hex($3)); $ec =~/([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})/; my @ec = (hex($1),hex($2),hex($3)); my @rgb; for (0..2) { $rgb[$_] = sprintf("%02X", int(($ec[$_] - $sc[$_])*$pct + $sc[$_] + .5)); } return $prefix.join("",@rgb); } #sub DOIF_Icon { # my ($dev, $reading, $icon, $cmd, $type) = @_; # my $val = ReadingsVal($dev,$reading,"???"); # $type= $reading eq 'state' ? 'set' : 'setreading' if (!defined $type); # my $ret = FW_makeImage($icon,$cmd,"icon"); # $ret = FW_pH "cmd.$dev=$type $dev $reading $cmd", $ret, 0, "webCmd", 1; # return "$ret"; #} sub DOIF_UpdateCell { my ($hash,$doifId,$dev,$reading) =@_; my $pn = $hash->{NAME}; my $retVal=""; my $retStyle=""; my $reg=""; my $VALUE=""; if ($doifId =~ /.*_(.*)_c_(.*)_(.*)_(.*)_(.*)$/) { my $command=$hash->{$1}{table}{$2}{$3}{$4}{$5}; eval ($command); if ($@) { my $err="$pn: eval: $command error: $@" ; Log3 $pn,3,$err; } } } sub DOIF_Widget { my ($hash,$reg,$doifId,$value,$style,$widget,$command,$dev,$reading)=@_; if ($reg) { return DOIF_Widget_Register($doifId,$value,$style,$widget,$dev,$reading,$command); } else { DOIF_Widget_Update($hash->{NAME},$doifId,$value,$style,$widget,$command,$dev,$reading); } } sub DOIF_Widget_Update { my ($pn,$doifId,$value,$style,$widget,$command,$dev,$reading)=@_; if (defined $widget and $widget ne "") { map { FW_directNotify("#FHEMWEB:$_", "doifUpdateCell('$pn','informid','$dev-$reading','$value')",""); } devspec2array("TYPE=FHEMWEB"); } else { map { FW_directNotify("#FHEMWEB:$_", "doifUpdateCell('$pn','doifId','$doifId','$value','display:inline-table;$style')",""); } devspec2array("TYPE=FHEMWEB") if ($value ne ""); } } sub DOIF_Widget_Register { my ($doifId,$value,$style,$widget,$dev,$reading,$command)=@_; my $type; my $cmd=''; if (defined $widget and $widget ne "") { if (defined $command and $command ne "") { if ($command =~ /^([^ ]*) *(.*)/) { $type = !defined $1 ? '': $1; $cmd = !defined $2 ? '': $2; } else { $type=$command; } } else { $type= $reading eq 'state' ? 'set' : 'setreading'; } $cmd = $cmd eq '' ? $reading : $cmd; return "
"; } else { return "
$value
"; } } sub DOIF_RegisterCell { my ($hash,$table,$func,$r,$c,$cc,$cr) =@_; my $event; my $err; my $dev=""; my $reading=""; my $value=""; my $expr; my $style; my $widget; my $command; my $cell; my $widsty=0; my $trigger=0; if ($func=~ /^\s*(STY[ \t]*\(|WID[ \t]*\()/) { my ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($func,'[\(\)]'); if ($err) { return $err; } elsif ($currentBlock ne "") { $cell=$currentBlock; } } else { $cell=$func; } my $doifId="$hash->{NAME}_".$table."_c_".$r."_".$c."_".$cc."_".$cr; if ($func=~ /^\s*STY[ \t]*\(/) { $widsty=1; ($expr,$style) = SplitDoIf(',',$cell); } elsif ($func=~ /^\s*WID[ \t]*\(/) { $widsty=2; ($expr,$widget,$command) = SplitDoIf(',',$cell); } else { $expr=$cell; } ($expr,$err,$event)=ReplaceAllReadingsDoIf($hash,$expr,($table eq "uiTable" ? -5:-6),0,$doifId); if ($err) { $err="'error $err: in expression: $expr'"; return $err; } else { $lastWarningMsg=""; my ($exp,$sty,$wid,$com)=eval ($hash->{$table}{package}.$expr); return "'error $@ in expression: $expr'" if ($@); if ($lastWarningMsg) { $lastWarningMsg =~ s/^(.*) at \(eval.*$/$1/; Log3 ($hash->{NAME},3,"$hash->{NAME}:Warning in DOIF_RegisterCell:$hash->{$table}{package}.$expr"); $lastWarningMsg=""; } if (defined $sty and $sty eq "" and defined $wid and $wid ne "") { if ($event) { $dev=$hash->{$table}{dev} if (defined $hash->{$table}{dev}); $reading=$hash->{$table}{reading} if (defined $hash->{$table}{reading}); } else { return "'no trigger reading in widget: $expr'"; } $reading="state" if ($reading eq '&STATE'); return "$hash->{$table}{package}::DOIF_Widget(".'$hash,$reg,'."'$doifId',$expr,".(defined $com ? "":"'',")."'$dev','$reading')"; } elsif (defined $sty) { $widsty=3; } } $trigger=$event; if (defined $widget and $widget ne "") { if ($event) { $dev=$hash->{$table}{dev} if (defined $hash->{$table}{dev}); $reading=$hash->{$table}{reading} if (defined $hash->{$table}{reading}); } else { return "'no trigger reading in widget: $expr'"; } ($widget,$err,$event)=ReplaceAllReadingsDoIf($hash,$widget,($table eq "uiTable" ? -5:-6),0,$doifId); $trigger=$event if ($event); if ($err) { $err="'error $err: in widget: $widget'"; return $err; } else { $lastWarningMsg=""; eval ($widget); return "'error $@ in widget: $widget'" if ($@); if ($lastWarningMsg) { Log3 ($hash->{NAME},3,"$hash->{NAME}:Warning in DOIF_RegisterCell:$widget"); $lastWarningMsg=""; } } } else { $widget=""; } if ($style) { ($style,$err,$event)=ReplaceAllReadingsDoIf($hash,$style,($table eq "uiTable" ? -5:-6),0,$doifId); $trigger=$event if ($event); if ($err) { $err="'error $err: in style: $style'"; return $err; } else { $lastWarningMsg=""; eval $style; return "'error $@ in style: $style'" if ($@); if ($lastWarningMsg) { Log3 ($hash->{NAME},3,"$hash->{NAME}:Warning in DOIF_RegisterCell:$style"); $lastWarningMsg=""; } } } else { $style='""'; } if ($widsty==2) { $reading="state" if ($reading eq '&STATE'); return "$hash->{$table}{package}::DOIF_Widget(".'$hash,$reg,'."'$doifId',$expr,$style,$widget,".(defined $command ? "$command":"''").",'$dev','$reading')"; } elsif ($widsty==3) { return "$hash->{$table}{package}::DOIF_Widget(".'$hash,$reg,'."'$doifId',$expr)"; } elsif (($widsty==1) or $trigger) { return "$hash->{$table}{package}::DOIF_Widget(".'$hash,$reg,'."'$doifId',$expr,$style)"; } else { return ("$hash->{$table}{package}".$expr); } return "" } sub DOIF_DEF_TPL { my ($hash,$table,$tail) = @_; my $beginning; my $currentBlock; my $output=""; my $err; while ($tail ne "") { if ($tail =~ /(?:^|\n)\s*DEF\s/g) { my $prefix=substr($tail,0,pos($tail)); my $begin=substr($tail,0,pos($tail)-4); $tail=substr($tail,pos($tail)-4); if ($tail =~ /^DEF\s*(TPL_[^ ^\t^\(]*)[^\(]*\(/) { ($beginning,$currentBlock,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); if ($err) { return ("DEF TPL: $err",$currentBlock); } elsif ($currentBlock ne "") { $hash->{$table}{tpl}{$1}=$currentBlock; $output.=$begin; } } else { $tail=substr($tail,4); $output.=$prefix; } } else { $output.=$tail; $tail=""; } } return ("",$output); } sub DOIF_DEF_TPL_OLD { my ($hash,$table,$tail) =@_; my ($beginning,$currentBlock,$err); while($tail =~ /(?:^|\n)\s*DEF\s*(TPL_[^ ^\t^\(]*)[^\(]*\(/g) { ($beginning,$currentBlock,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); if ($err) { return ("DEF TPL: $err",$currentBlock); } elsif ($currentBlock ne "") { $hash->{$table}{tpl}{$1}=$currentBlock; } } return ("",$tail); } sub parse_tpl { my ($hash,$wcmd,$table) = @_; my $d=$hash->{NAME}; my $err=""; $hash->{$table}{header}=""; while ($wcmd =~ /\s*IMPORT\s*(.*)(\n|$)/g) { $err=import_tpl($hash,$1,$table); return ($err,"") if ($err); } $wcmd =~ s/(##.*\n)|(##.*$)/\n/g; $wcmd =~ s/\s*IMPORT.*(\n|$)//g; $wcmd =~ s/\$TPL\{/\$hash->\{$table\}\{template\}\{/g; $wcmd =~ s/\$ATTRIBUTESFIRST/\$hash->{$table}{attributesfirst}/; $wcmd =~ s/\$TC\{/\$hash->{$table}{tc}\{/g; $wcmd =~ s/\$hash->\{$table\}\{tc\}\{([\d,.]*)?\}.*(\".*\")/for my \$i ($1) \{\$hash->\{$table\}\{tc\}\{\$i\} = $2\}/g; $wcmd =~ s/\$TR\{/\$hash->{$table}{tr}\{/g; $wcmd =~ s/\$hash->\{$table\}\{tr\}\{([\d,.]*)?\}.*(\".*\")/for my \$i ($1) \{\$hash->\{$table\}\{tr\}\{\$i\} = $2\}/g; $wcmd =~ s/\$TD\{(.*)?\}\{(.*)?\}.*(\".*\")/for my \$rowi ($1) \{for my \$coli ($2) \{\$hash->\{$table\}\{td\}\{\$rowi\}\{\$coli\} = $3\}\}/g; $wcmd =~ s/\$TABLE/\$hash->{$table}{tablestyle}/; $wcmd =~ s/<\s*\n/\."<\/tbody><\/table>\$hash->{$table}{header}"\n/g; $wcmd =~ s/\$VAR/\$hash->{var}/g; $wcmd =~ s/\$_(\w+)/\$hash->\{var\}\{$1\}/g; $wcmd =~ s/\$SELF/$d/g; $wcmd =~ s/FUNC_/::DOIF_FUNC_$d\_/g; $wcmd =~ s/PUP[ \t]*\(/::DOIF_tablePopUp(\"$d\",/g; $wcmd =~ s/\$SHOWNOSTATE/\$hash->{$table}{shownostate}/; $wcmd =~ s/\$SHOWNODEVICELINK/\$hash->{$table}{shownodevicelink}/; $wcmd =~ s/\$SHOWNODEVICELINE/\$hash->{$table}{shownodeviceline}/; $wcmd =~ s/\$SHOWNOUITABLE/\$hash->{$table}{shownouitable}/; $hash->{$table}{package} = "" if (!defined ($hash->{$table}{package})); if ($wcmd=~ /^\s*\{/) { # perl block my ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($wcmd,'[\{\}]'); if ($err) { return ("error in $table: $err",""); } elsif ($currentBlock ne "") { $currentBlock ="no warnings 'redefine';".$currentBlock; if ($currentBlock =~ /\s*package\s*(\w*)/) { $hash->{$table}{package}="package $1;"; } eval ($currentBlock); if ($@) { $err="$d: error: $@ in $table: $currentBlock"; return ($err,""); } $wcmd=$tailBlock; } } ($err,$wcmd)=DOIF_FOR($hash,$table,$wcmd); if ($err) { return($err,""); } $wcmd =~ s/^\s*//; $wcmd =~ s/[ \t]*\n/\n/g; $wcmd =~ s/,[ \t]*[\n]+/,/g; $wcmd =~ s/\.[ \t]*[\n]+/\./g; $wcmd =~ s/\|[ \t]*[\n]+/\|/g; $wcmd =~ s/>[ \t]*[\n]+/>/g; my $tail=$wcmd; my $beginning; my $currentBlock; ($err,$tail)=DOIF_DEF_TPL($hash,$table,$wcmd); return ("$err: $tail") if ($err); return ("",$tail); } sub import_tpl { my ($hash,$file,$table) = @_; my $fh; my $err; if(!open($fh, $file)) { return "Can't open $file: $!"; } my @tpl=<$fh>; close $fh; my $wcmd=join("",@tpl); ($err,$wcmd)=parse_tpl($hash,$wcmd,$table); return $err if ($err); return ""; } sub DOIF_FOR { my ($hash,$table,$wcmd,$count)=@_; my $err=""; my $tail=$wcmd; my $beginning; my $currentBlock; my $output=""; while ($tail ne "") { if ($tail =~ /FOR/g) { my $prefix=substr($tail,0,pos($tail)); my $begin=substr($tail,0,pos($tail)-3); $tail=substr($tail,pos($tail)-3); if ($tail =~ /^FOR\s*\(/) { ($beginning,$currentBlock,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); if ($err) { return ("FOR: $err $currentBlock",""); } elsif ($currentBlock ne "") { my ($array,$command) = SplitDoIf(',',$currentBlock); my $cmd=$command; if ($cmd =~ /^\s*\(/) { my ($begin,$curr,$error,$end)=GetBlockDoIf($command,'[\(\)]'); if ($error) { return ("FOR: $error $curr",""); } else { $command=$curr; } } my $commandoutput=""; if (!defined $count) { $count=0; } $count++; my $i=0; for (eval($array)) { my $temp=$command; my $item=$_; if (ref($item) eq "ARRAY"){ my $j=1; for (@{$item}) { $temp =~ s/\$_\$$j/$_/g; $temp =~ s/\$$count\$$j/$_/g; $j++; } } else { $temp =~ s/\$$count/$_/g; $temp =~ s/\$_/$_/g; } $temp =~ s/\$COUNT$count/$i/g; if ($temp =~ /FOR\s*\(/) { ($err,$temp)=DOIF_FOR($hash,"defs",$temp,$count); return($temp,$err) if ($err); } $commandoutput.=$temp."\n"; $i++; } $output.=($begin.$commandoutput); } } else { $tail=substr($tail,3); $output.=$prefix; } } else { $output.=$tail; $tail=""; } $count=undef; } return ("",$output); } sub DOIF_TPL { my ($hash,$table,$tail) = @_; my $beginning; my $currentBlock; my $output=""; my $err; while ($tail ne "") { if ($tail =~ /(\w*)\s*TPL_/g) { next if $1 eq "DEF"; my $prefix=substr($tail,0,pos($tail)); my $begin=substr($tail,0,pos($tail)-4); $tail=substr($tail,pos($tail)-4); if ($tail =~ /^(TPL_\w*)\s*\(/) { my $template=$1; if (defined $hash->{$table}{tpl}{$template}) { my $templ=$hash->{$table}{tpl}{$template}; ($beginning,$currentBlock,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); if ($err) { return "error: $err"; } elsif ($currentBlock ne "") { my @param = SplitDoIf(',',$currentBlock); for (my $j=@param;$j>0;$j--) { my $p=$j; $templ =~ s/\$$p/$param[$j-1]/g; } } $output.=($begin.$templ); } else { return ("no Template $template defined",$tail); } } else { $tail=substr($tail,4); $output.=$prefix; } } else { $output.=$tail; $tail=""; } } return ("",$output); } sub DOIF_uiTable_def { my ($hash,$wcmd,$table) = @_; return undef if (!$wcmd); my $err=""; delete ($hash->{Regex}{$table}); delete ($hash->{$table}); ($err,$wcmd)=parse_tpl($hash,$wcmd,$table); return $err if ($err); my $output=""; my $tail=$wcmd; ($err,$output)=DOIF_TPL($hash,$table,$tail); return ("$err: $output") if ($err); $wcmd=$output; my @rcmd = split(/\n/,$wcmd); my $ii=0; for (my $i=0; $i<@rcmd; $i++) { next if ($rcmd[$i] =~ /^\s*$/); my @ccmd = SplitDoIf('|',$rcmd[$i]); for (my $k=0;$k<@ccmd;$k++) { my @cccmd = SplitDoIf(',',$ccmd[$k]); for (my $l=0;$l<@cccmd;$l++) { my @crcmd = SplitDoIf('.',$cccmd[$l]); for (my $m=0;$m<@crcmd;$m++) { $hash->{$table}{table}{$ii}{$k}{$l}{$m}= DOIF_RegisterCell($hash,$table,$crcmd[$m],$ii,$k,$l,$m); } } } $ii++; } return undef; ##$hash->{$table}{tabledef}=DOIF_RegisterEvalAll($hash); } sub DOIF_RegisterEvalAll { my ($hash,$d,$table) = @_; my $ret = ""; my $reg=1; return undef if (!defined $hash->{$table}{table}); if ($table eq "uiTable") { $ret.= "\n{$table}{shownostate} ? $hash->{$table}{shownostate} : "")."'"; $ret.=" doifnodevline='".($hash->{$table}{shownodeviceline} ? $hash->{$table}{shownodeviceline} : "")."'"; $ret.=" doifattrfirst='".($hash->{$table}{attributesfirst} ? $hash->{$table}{attributesfirst} : "")."'"; $ret.= ">"; $hash->{$table}{header}= "\n
"; } else { $ret.= "\n
{$table}{attributesfirst} ? $hash->{$table}{attributesfirst} : "")."'"; $ret.= ">"; $hash->{$table}{header}= "\n
"; } my $class=""; my $lasttr =scalar keys %{$hash->{$table}{table}}; for (my $i=0;$i < $lasttr;$i++){ if ($table eq "uiTable") { $class = ($i&1)?"class='odd'":"class='even'"; } $ret .="{$table}{tr}{$i}) ? $hash->{$table}{tr}{$i}:""); $ret .=" ".(($i&1) ? $hash->{$table}{tr}{odd}:"") if (defined $hash->{$table}{tr}{odd}); $ret .=" ".((!($i&1)) ? $hash->{$table}{tr}{even}:"") if (defined $hash->{$table}{tr}{even}); $ret .=" ".(($i==$lasttr-1) ? $hash->{$table}{tr}{last}:"") if (defined $hash->{$table}{tr}{last}); $ret .=" $class >"; my $lastc =scalar keys %{$hash->{$table}{table}{$i}}; for (my $k=0;$k < $lastc;$k++){ $ret .=""; } $ret .= ""; } $ret .= "
{$table}{td}{$i}{$k}) ? $hash->{$table}{td}{$i}{$k}:""); $ret .=" ".((defined $hash->{$table}{tc}{$k} )? $hash->{$table}{tc}{$k}:""); $ret .=" ".(($k&1)?$hash->{$table}{tc}{odd}:"") if (defined $hash->{$table}{tc}{odd}); $ret .=" ".((!($k&1))?$hash->{$table}{tc}{even}:"") if (defined $hash->{$table}{tc}{even}); $ret .=" ".(($k==$lastc-1)?$hash->{$table}{tc}{last}:"") if (defined $hash->{$table}{tc}{last}); $ret .=">"; my $lastcc =scalar keys %{$hash->{$table}{table}{$i}{$k}}; for (my $l=0;$l < $lastcc;$l++){ for (my $m=0;$m < scalar keys %{$hash->{$table}{table}{$i}{$k}{$l}};$m++) { if (defined $hash->{$table}{table}{$i}{$k}{$l}{$m}){ $lastWarningMsg=""; my $value= eval($hash->{$table}{table}{$i}{$k}{$l}{$m}); if ($lastWarningMsg) { Log3 ($hash->{NAME},3,"$hash->{NAME}:Warning in DOIF_RegisterEvalAll:$hash->{$table}{table}{$i}{$k}{$l}{$m}"); $lastWarningMsg=""; } if (defined ($value)) { if (defined $defs{$value} and (!defined $hash->{$table}{shownodevicelink} or !$hash->{$table}{shownodevicelink})) { $ret.="$value"; } else { $ret.=$value; } } } } $ret.="
" if ($l+1 != $lastcc); } $ret.="
\n"; # if ($table eq "uiTable"); #$hash->{$table}{deftable}=$ret; return $ret; } sub DOIF_tablePopUp { my ($pn,$d,$icon,$table) = @_; $table = $table ? $table : "uiTable"; my ($ic,$itext,$iclass)=split(",",$icon); if ($defs{$d} && AttrVal($d,$table,"")) { my $ret = "".FW_makeImage($ic,$itext,$iclass).""; } else { return "no device $d or attribut $table"; } } sub DOIF_summaryFn ($$$$) { my ($FW_wname, $d, $room, $pageHash) = @_; # pageHash is set for summaryFn. my $hash = $defs{$d}; my $ret = ""; # if ($hash->{uiTable}{shownostate}) { # return ""; # } #Log3 $d,1,"vor DOIF_RegisterEvalAll uiState d: $d"; $ret=DOIF_RegisterEvalAll($hash,$d,"uiState"); #Log3 $d,1,"nach DOIF_RegisterEvalAll"; return $ret; } sub DOIF_detailFn ($$$$) { my ($FW_wname, $d, $room, $pageHash) = @_; # pageHash is set for summaryFn. my $hash = $defs{$d}; my $ret = ""; return "" if (defined $hash->{"uiTable"}{shownouitable} and $FW_room =~ /$hash->{"uiTable"}{shownouitable}/); $ret=DOIF_RegisterEvalAll($hash,$d,"uiTable"); return $ret; } sub GetBlockDoIf ($$) { my ($cmd,$match) = @_; my $count=0; my $first_pos=0; my $last_pos=0; my $err=""; while($cmd =~ /$match/g) { if (substr($cmd,pos($cmd)-1,1) eq substr($match,2,1)) { $count++; $first_pos=pos($cmd) if ($count == 1); } elsif (substr($cmd,pos($cmd)-1,1) eq substr($match,4,1)) { $count--; } if ($count < 0) { $err="right bracket without left bracket"; return ("",substr($cmd,pos($cmd)-1),$err,""); } if ($count == 0) { $last_pos=pos($cmd); last; } } if ($count > 0) { $err="no right bracket"; return ("",substr($cmd,$first_pos-1),$err); } if ($first_pos) { return (substr($cmd,0,$first_pos-1),substr($cmd,$first_pos,$last_pos-$first_pos-1),"",substr($cmd,$last_pos)); } else { return ($cmd,"","",""); } } sub GetCommandDoIf ($$) { my ($separator,$tailBlock) = @_; my $char; my $beginning; my $currentBlock; my $err; my $cmd=""; while ($tailBlock=~ /^([^$separator^"^\[^\{^\(]*)/g) { $char=substr($tailBlock,pos($tailBlock),1); if ($char eq $separator) { $cmd=$cmd.substr($tailBlock,0,pos($tailBlock)); $tailBlock=substr($tailBlock,pos($tailBlock)+1); return($cmd,$tailBlock,""); } elsif ($char eq '{') { ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\{\}]'); return ($currentBlock,$tailBlock,$err) if ($err); $cmd=$cmd.$beginning."{$currentBlock}"; } elsif ($char eq '(') { ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\(\)]'); return ($currentBlock,$tailBlock,$err) if ($err); $cmd=$cmd.$beginning."($currentBlock)"; } elsif ($char eq '[') { ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\[\]]'); return ($currentBlock,$tailBlock,$err) if ($err); $cmd=$cmd.$beginning."[$currentBlock]"; } elsif ($char eq '"') { if ($tailBlock =~ /(^[^"]*"[^"]*")(.*)/) { $cmd=$cmd.$1; $tailBlock=$2; } } } if ($cmd eq "") { $cmd=$tailBlock; } else { $cmd=$cmd.$tailBlock } return ($cmd,"",""); } sub EvalValueDoIf($$$) { my ($hash,$attr,$value)=@_; return "" if (!defined($value) or $value eq ""); my $err=""; my $pn=$hash->{NAME}; $value =~ s/\$SELF/$pn/g; ($value,$err)=ReplaceAllReadingsDoIf($hash,$value,-1,1); if ($err) { my $error="$pn: error in $attr: $err"; Log3 $pn,4 , $error; readingsSingleUpdate ($hash, "error", $error,1); $value=0; } else { my $ret = eval $value; if ($@) { my $error="$pn: error in $attr: $value"; Log3 $pn,4 , $error; readingsSingleUpdate ($hash, "error", $error,1); $value=0; } else { $value=$ret; } } return ($value); } sub EvalCmdStateDoIf($$) { my ($hash,$state)=@_; my $err; my $pn=$hash->{NAME}; ($state,$err)=ReplaceAllReadingsDoIf($hash,$state,-1,1); if ($err) { Log3 $pn,4 , "$pn: error in state: $err" if ($err); $state=$err; } else { ($state,$err)=EvalAllDoIf($hash, $state); if ($err) { Log3 $pn,4 , "$pn: error in state: $err" if ($err); $state=$err; } } return($state) } sub SplitDoIf($$) { my ($separator,$tailBlock)=@_; my @commands; my $cmd; my $err; if (defined $tailBlock) { while ($tailBlock ne "") { ($cmd,$tailBlock,$err)=GetCommandDoIf($separator,$tailBlock); push(@commands,$cmd) if (defined $cmd); } } return(@commands); } sub EventCheckDoif($$$$) { my ($n,$dev,$eventa,$NotifyExp)=@_; my $found=0; my $s; return 0 if ($dev ne $n); return 0 if(!$eventa); my $max = int(@{$eventa}); my $ret = 0; if ($NotifyExp eq "") { return 1 ; } for (my $i = 0; $i < $max; $i++) { $s = $eventa->[$i]; $s = "" if(!defined($s)); $found = ($s =~ m/$NotifyExp/); if ($found) { return 1; } } return 0; } sub AggrIntDoIf { my ($hash,$modeType,$device,$reading,$cond,$default)=@_; my $num=0; my $value=""; my $sum=0; my $average; my $extrem; my $name; my $devname; my $err; my ($median, @median_values); my $ret; my $result; my @devices; my $group; my $room; my $STATE; my $TYPE; my $warning=0; my $mode=substr($modeType,0,1); my $type; my $format; my $place; my $number; my $readingRegex; if ($modeType =~ /.(sum|average|max|min|median)?[:]?(?:(a|d)?(\d)?)?/) { $type = (defined $1)? $1 : ""; $format= (defined $2)? $2 : ""; $place= $3; } if (defined $default) { if ($default =~ /^"(.*)"$/) { $default = $1; } else { $default=EvalValueDoIf($hash,"default",$default); } } if (defined $reading) { if ($reading =~ /^"(.*)"$/) { $readingRegex = $1; } } foreach my $name (($device eq "") ? keys %defs:grep {/$device/} keys %defs) { next if($attr{$name} && $attr{$name}{ignore}); foreach my $reading ((defined $readingRegex) ? grep {/$readingRegex/} keys %{$defs{$name}{READINGS}} : $reading) { $value=""; $number=""; if ($reading) { if (defined $defs{$name}{READINGS}{$reading}) { $value=$defs{$name}{READINGS}{$reading}{VAL}; $number = ($value =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); } else { next; } } if ($cond) { if ($cond =~ /^"(.*)"$/) { if (defined $defs{$name}{READINGS}{$reading}) { $ret=($value =~ /$1/); } } else { $_=$value; $STATE=Value($name); $TYPE=$defs{$name}{TYPE}; $group=AttrVal($name,"group",""); $room=AttrVal($name,"room",""); $lastWarningMsg=""; $ret = eval $cond; if ($@) { $@ =~ s/^(.*) at \(eval.*\)(.*)$/$1,$2/; if (defined $hash) { Log3 ($hash->{NAME},3 , "$hash->{NAME}: aggregate function: error in condition: $cond, $@"); } return("error in aggregate function: ".$@); } if ($lastWarningMsg) { $warning=1; $lastWarningMsg =~ s/^(.*) at \(eval.*$/$1/; Log3 ($hash->{NAME},3 , "$hash->{NAME}: aggregate function: warning in condition: $cond, Device: $name"); readingsSingleUpdate ($hash, "warning_aggr", "condition: $cond , device: $name, $lastWarningMsg",1); } $lastWarningMsg=""; } } else { $ret=1; } if ($format eq "a") { $devname=AttrVal($name,"alias",$name); } else { $devname=$name; } if ($ret) { if ($type eq ""){ $num++; push (@devices,$devname); } elsif (defined $value) { if ($type eq "sum" or $type eq "average") { $num++; push (@devices,$devname); $sum+=$number; } elsif ($type eq "max") { if (!defined $extrem or $number>$extrem) { $extrem=$number; @devices=($devname); } } elsif ($type eq "min") { if (!defined $extrem or $number<$extrem) { $extrem=$number; @devices=($devname); } } elsif ($type eq "median") { $num++; push @median_values, $number; push (@devices,$devname); } } } } } delete ($defs{$hash->{NAME}}{READINGS}{warning_aggr}) if (defined $hash and $warning==0); if ($type eq "max" or $type eq "min") { $extrem=0 if (!defined $extrem); $result=$extrem; } elsif ($type eq "sum") { $result= $sum; } elsif ($type eq "average") { if ($num>0) { $result=($sum/$num) } } elsif ($type eq "median"){ $result = &{ sub { return 0 if $num == 0; my @vals = sort{ $a <=> $b } @median_values; # odd amount of values, return the middle one return $vals[int($num / 2)] if ( $num % 2); # even amount of values, return the median return ( $vals[int($num / 2) - 1] + $vals[int($num / 2)] ) / 2; } }; } else { $result=$num; } if ($mode eq "#") { if ($format eq "d") { $result = ($result =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); $result = round ($result,$place) if (defined $place); } if ($num==0 and defined $default) { return ($default); } else { return ($result); } } elsif ($mode eq "@") { if ($num==0 and defined $default) { @devices =($default); } return (sort @devices); } return 0; } sub AggrDoIf { my ($modeType,$device,$reading,$cond,$default)=@_; return (AggrIntDoIf(undef,$modeType,$device,$reading,$cond,$default)); } sub AggregateDoIf { my ($hash,$modeType,$device,$reading,$cond,$default)=@_; my $mode=substr($modeType,0,1); my $type=substr($modeType,1); my $splittoken=","; if ($modeType =~ /.(?:sum|average|max|min|median)?[:]?[^s]*(?:s\((.*)\))?/) { $splittoken=$1 if (defined $1); } if ($mode eq "#") { return (AggrIntDoIf($hash,$modeType,$device,$reading,$cond,$default)); } elsif ($mode eq "@") { return (join ($splittoken,AggrIntDoIf($hash,$modeType,$device,$reading,$cond,$default))); } return (""); } sub EventDoIf { my ($n,$hash,$NotifyExp,$check,$filter,$output,$default)=@_; my $dev=$hash->{helper}{triggerDev}; my $eventa=$hash->{helper}{triggerEvents}; return 0 if (!defined $dev); if ($check) { if ($dev eq "" or $dev ne $n) { if (defined $filter) { return ($default) } else { return 0; } } } else { if ($dev eq "" or $n and $dev !~ /$n/) { if (defined $filter) { return ($default) } else { return 0; } } } return 0 if(!$eventa); my $max = int(@{$eventa}); my $ret = 0; if ($NotifyExp eq "") { return 1 if (!defined $filter); } my $s; my $found; my $element; for (my $i = 0; $i < $max; $i++) { $s = $eventa->[$i]; $s = "" if(!defined($s)); $found = ($s =~ m/$NotifyExp/); if ($found or $NotifyExp eq "") { $hash->{helper}{event}=$s; if (defined $filter) { $element = ($s =~ /$filter/) ? $1 : ""; if ($element) { if ($output ne "") { $element= eval $output; if ($@) { Log3 ($hash->{NAME},4 , "$hash->{NAME}: $@"); readingsSingleUpdate ($hash, "error", $@,1); return(undef); } } return ($element); } } else { return 1; } } #if(!$found && AttrVal($n, "eventMap", undef)) { # my @res = ReplaceEventMap($n, [$n,$s], 0); # shift @res; # $s = join(" ", @res); # $found = ("$n:$s" =~ m/^$re$/); } if (defined $filter) { return ($default); } else { return 0; } } sub InternalDoIf { my ($hash,$name,$internal,$default,$regExp,$output)=@_; $default=AttrVal($hash->{NAME},'notexist','') if (!defined $default); $regExp='' if (!defined $regExp); $output='' if (!defined $output); if ($default =~ /^"(.*)"$/) { $default = $1; } else { $default=EvalValueDoIf($hash,"default",$default); } my $r=""; my $element; return ($default) if (!defined $defs{$name}); return ($default) if (!defined $defs{$name}{$internal}); $r=$defs{$name}{$internal}; if ($regExp) { $element = ($r =~ /$regExp/) ? $1 : ""; if ($output) { $element= eval $output; if ($@) { Log3 ($hash->{NAME},4 , "$hash->{NAME}: $@"); readingsSingleUpdate ($hash, "error", $@,1); return(undef); } } } else { $element=$r; } return($element); } sub ReadingSecDoIf($$) { my ($name,$reading)=@_; my ($seconds, $microseconds) = gettimeofday(); return ($seconds - time_str2num(ReadingsTimestamp($name, $reading, "1970-01-01 01:00:00"))); } sub ReadingValDoIf { my ($hash,$name,$reading,$default,$regExp,$output)=@_; $default=AttrVal($hash->{NAME},'notexist','') if (!defined $default); $output='' if (!defined $output); $regExp='' if (!defined $regExp); if ($default =~ /^"(.*)"$/) { $default = $1; } else { $default=EvalValueDoIf($hash,"default",$default); } my $r; my $element; return ($default) if (!defined $defs{$name}); return ($default) if (!defined $defs{$name}{READINGS}); return ($default) if (!defined $defs{$name}{READINGS}{$reading}); $r=$defs{$name}{READINGS}{$reading}{VAL}; $r="" if (!defined($r)); if ($regExp) { if ($regExp =~ /^(avg|med|diff|inc)(\d*)/) { my @a=@{$hash->{accu}{"$name $reading"}{value}}; my $func=$1; my $dim=$2; $dim=2 if (!defined $dim or !$dim); my $num=@a < $dim ? @a : $dim; @a=splice (@a, -$num,$num); if ($func eq "avg" or $func eq "med") { return ($r) if (!@a); } elsif ($func eq "diff" or $func eq "inc") { return (0) if (@a <= 1); } if ($func eq "avg") { my $sum=0; foreach (@a) { $sum += $_; } return ($sum/$num); } elsif ($func eq "med") { my @vals = sort{$a <=> $b} @a; if ($num % 2) { return $vals[int($num/2)] if ($num % 2) } else { return ($vals[int($num/2) - 1] + $vals[int($num/2)])/2; } } elsif ($func eq "diff") { return (($a[-1]-$a[0])); } elsif ($func eq "inc") { if ($a[0] == 0) { return(0); } else { return (($a[-1]-$a[0])/$a[0]); } } } elsif ($regExp =~ /^(col(\d*)(.?))/) { my $num=$2; my $time=$3; my $hours=24; if ($num ne "") { if($time eq "d") { $hours=24*$num; }elsif ($time eq "w") { $hours=24*$num*7; } else { $hours=$num; } } # $hash->{collect}{"$name $reading"}{$hours}{value}=$r; # $hash->{collect}{"$name $reading"}{$hours}{time}=time_str2num(ReadingsTimestamp($name, $reading, "1970-01-01 01:00:00")); return (\%{$hash->{collect}{"$name $reading"}{$hours}}); } elsif ($regExp =~ /^d(\d)?/) { my $round=$1; $r = ($r =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); $r = round ($r,$round) if (defined $round); $regExp="(.*)"; } "" =~ /()()()()()()()()()/; #reset $1, $2... $element = ($r =~ /$regExp/) ? $1 : ""; if ($output) { $element= eval $output; if ($@) { Log3 ($hash->{NAME},4 , "$hash->{NAME}: $@"); readingsSingleUpdate ($hash, "error", $@,1); return(undef); } } } else { $element=$r; } return($element); } sub accu_setValue { my ($hash,$name,$reading)=@_; if (defined $hash->{accu}{"$name $reading"}) { my $a=$hash->{accu}{"$name $reading"}{value}; my $dim=$hash->{accu}{"$name $reading"}{dim}; shift (@{$a}) if (@{$a} >= $dim); my $r=ReadingsVal($name,$reading,0); $r = ($r =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); push (@{$a},$r); } } sub DOIF_collect_save_values { my ($hash)=@_; foreach my $key (keys %{$defs{$hash->{NAME}}{READINGS}}) { delete $defs{$hash->{NAME}}{READINGS}{$key} if ($key =~ /^\.col/); } foreach my $dev_reading (keys %{$hash->{collect}}) { foreach my $hours (keys %{$hash->{collect}{"$dev_reading"}}) { if (ref($hash->{collect}{$dev_reading}{$hours}{values}) eq "ARRAY") { my @va=@{$hash->{collect}{$dev_reading}{$hours}{values}}; my @ta=@{$hash->{collect}{$dev_reading}{$hours}{times}}; for (@va) { $_ = "" if (!defined $_); }; for (@ta) { $_ = "" if (!defined $_); }; my $dim=$hash->{collect}{$dev_reading}{$hours}{dim}; my $devReading=$dev_reading; $devReading =~ s/ /_/g; ::readingsSingleUpdate($hash,".col_".$dim."_".$devReading."_".$hours."_values",join(",",@va),0); ::readingsSingleUpdate($hash,".col_".$dim."_".$devReading."_".$hours."_times",join(",",@ta),0); } } } } sub collect_setValue { my ($hash,$name,$reading,$hours)=@_; my $diff_slots=1; my $last_slot; my $collect=\%{$hash->{collect}{"$name $reading"}{$hours}}; my $dim=${$collect}{dim}; my $va=${$collect}{values}; my $ta=${$collect}{times}; my $seconds_per_slot=$hours*3600/$dim; if (@{$ta} == $dim) { $last_slot=int (${$ta}[-1]/$seconds_per_slot); } my $r=ReadingsVal($name,$reading,0); $r = ($r =~ /(-?\d+(\.\d+)?)/ ? $1 : 0); my $seconds=time_str2num(ReadingsTimestamp($name, $reading, "1970-01-01 01:00:00")); my $slot_nr=int ($seconds/$seconds_per_slot); if (defined $last_slot) { $diff_slots=$slot_nr-$last_slot; if ($diff_slots > 0) { if ($diff_slots >= $dim) { ${$collect}{last_value}=${$collect}{value} if (defined ${$collect}{value}); @{$va}=(); @{$ta}=(); } else { my @rv=splice (@{$va},0,$diff_slots); my @rt=splice (@{$ta},0,$diff_slots); if ($diff_slots > 1 and !defined ${$va}[$dim-$diff_slots] and defined ${$collect}{value} and ${$collect}{value} != ${$va}[$dim-$diff_slots-1]) { ${$va}[$dim-$diff_slots]=${$collect}{value}; ${$ta}[$dim-$diff_slots]=(int(${$ta}[$dim-$diff_slots-1]/$seconds_per_slot)+1)*60*$seconds_per_slot; } for (my $i=@rv-1;$i>=0;$i--) { if (defined ($rv[$i])) { ${$collect}{last_value}=$rv[$i]; last; } } } } } ${$collect}{avg} = defined ${$collect}{max_value} ? (${$collect}{max_value}-${$collect}{min_value})/2 + ${$collect}{min_value}: $r; if (!defined ${$va}[$dim-1] or $r >= ${$collect}{avg} and $r > ${$va}[$dim-1] or $r < ${$collect}{avg} and $r < ${$va}[$dim-1]) { ${$va}[$dim-1]=$r; ${$ta}[$dim-1]=$seconds; } ${$collect}{value}=$r; ${$collect}{time}=$seconds; my $maxVal; my $maxValTime; my $maxValSlot; my $minVal; my $minValTime; my $minValSlot; for (my $i=0;$i<@{$va};$i++) { my $value=${$va}[$i]; my $time=${$ta}[$i]; if (defined $value and defined $time) { if (!defined $maxVal or $value > $maxVal) { $maxVal=$value; $maxValTime=$time; $maxValSlot=$i; } if (!defined $minVal or $value < $minVal) { $minVal=$value; $minValTime=$time; $minValSlot=$i; } } } ${$collect}{max_value}=$maxVal; ${$collect}{max_value_time}=$maxValTime; ${$collect}{max_value_slot}=$maxValSlot; ${$collect}{min_value}=$minVal; ${$collect}{min_value_time}=$minValTime; ${$collect}{min_value_slot}=$minValSlot; if (defined ${$collect}{last_value}) { if (${$collect}{last_value} > $maxVal) { ${$collect}{last_value}=$maxVal; } elsif (${$collect}{last_value} < $minVal) { ${$collect}{last_value}=$minVal; } } } sub EvalAllDoIf($$) { my ($hash,$tailBlock)= @_; my $eval=""; my $beginning; my $err; my $cmd=""; my $ret=""; my $eventa=$hash->{helper}{triggerEvents}; my $device=$hash->{helper}{triggerDev}; my $event=$hash->{helper}{event}; my $events=""; if ($eventa) { $events=join(",",@{$eventa}); } while ($tailBlock ne "") { ($beginning,$eval,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\{\}]'); return ($eval,$err) if ($err); if ($eval) { if (substr($eval,0,1) eq "(") { $eval=$1 if ($eval =~/^\((.*)\)$/); my $ret = eval $eval; return($eval." ",$@) if ($@); $eval=$ret; } else { $eval="{".$eval."}"; } } $cmd.=$beginning.$eval; } return ($cmd,""); } sub ReplaceAggregateDoIf($$$) { my ($hash,$block,$eval) = @_; my $exp; my $nameExp; my $notifyExp; my $match; my $reading; my $aggrType; my $default; ($block,$default)=SplitDoIf(",",$block); if ($block =~ /^([^"]*)(.*)/) { $aggrType=$1; $block=$2; } ($exp,$reading,$match)=SplitDoIf(":",$block); if ($exp =~ /^"(.*)"/){ $exp=$1; if ($exp =~ /([^\:]*):(.*)/) { $nameExp=$1; $notifyExp=$2; } else { $nameExp=$exp; } } $nameExp="" if (!defined $nameExp); $notifyExp="" if (!defined $notifyExp); if (defined $default) { $match="" if (!defined $match); $block="::AggregateDoIf(".'$hash'.",'$aggrType','$nameExp','$reading','$match','$default')"; } elsif (defined $match) { $block="::AggregateDoIf(".'$hash'.",'$aggrType','$nameExp','$reading','$match')"; } elsif (defined $reading) { $block="::AggregateDoIf(".'$hash'.",'$aggrType','$nameExp','$reading')"; } else { $block="::AggregateDoIf(".'$hash'.",'$aggrType','$nameExp')"; } if ($eval) { my $ret = eval $block; return($block." ",$@) if ($@); $block=$ret; } return ($block,undef); } sub ReplaceEventDoIf($) { my ($block) = @_; my $exp; my $exp2; my $nameExp; my $notifyExp; my $default; my $filter; my $output; ($exp,$default)=SplitDoIf(",",$block); ($exp2,$filter,$output)=SplitDoIf(":",$exp); if ($exp2 =~ /^"(.*)"/){ $exp2=$1; if ($exp2 =~ /([^\:]*):(.*)/) { $nameExp=$1; $notifyExp=$2; } else { $nameExp=$exp2; } } $nameExp="" if (!defined $nameExp); $notifyExp="" if (!defined $notifyExp); $output="" if (!defined $output); if (defined $default) { if ($default =~ /"(.*)"/) { $default = $1; } if (defined $filter) { if ($filter =~ /"(.*)"/) { $filter=$1; } else { return ($filter,"wrong filter Regex") } } else { $filter='[^\:]*: (.*)'; } } else { if (defined $filter) { return ($block,"default value must be defined") } else { $block="::EventDoIf('$nameExp',".'$hash,'."'$notifyExp',0)"; return ($block,undef); } } $block="::EventDoIf('$nameExp',".'$hash,'."'$notifyExp',0,'$filter','$output','$default')"; return ($block,undef); } sub ReplaceReadingDoIf { my ($hash,$element) = @_; my $beginning; my $tailBlock; my $err; my $regExp=""; my $name; my $reading; my $format; my $output=""; my $exp; my $default; my $param=""; ($exp,$default)=SplitDoIf(",",$element); $default="" if (!defined($default)); my $internal=""; my $notifyExp=""; if ($exp =~ /^([^:]*):(".*")/) { $name=$1; $reading=$2; } elsif ($exp =~ /^([^:]*)(?::([^:]*)(?::(.*))?)?/) { $name=$1; $reading=$2; $format=$3; } if ($name) { if ($reading) { if (substr($reading,0,1) eq "\?") { $notifyExp=substr($reading,1); return("::EventDoIf('$name',".'$hash,'."'$notifyExp',1)","",$name,undef,undef); } elsif ($reading =~ /^"(.*)"$/g) { $notifyExp=$1; return("::EventDoIf('$name',".'$hash,'."'$notifyExp',1)","",$name,undef,undef); } $internal = substr($reading,1) if (substr($reading,0,1) eq "\&"); if ($format) { if ($format eq "sec") { return("::ReadingSecDoIf('$name','$reading')","",$name,$reading,undef); } elsif (substr($format,0,1) eq '[') { #old Syntax ($beginning,$regExp,$err,$tailBlock)=GetBlockDoIf($format,'[\[\]]'); return ($regExp,$err) if ($err); return ($regExp,"no round brackets in regular expression") if ($regExp !~ /.*\(.*\)/); } elsif ($format =~ /^"([^"]*)"(?::(.*))?/){ $regExp=$1; $output=$2; return ($regExp,"no round brackets in regular expression") if ($regExp !~ /.*\(.*\)/); } elsif ($format =~ /^((avg|med|diff|inc)(\d*))/) { AddRegexpTriggerDoIf($hash,"accu","","accu",$name,$reading); $regExp =$1; my $dim=$3; $dim=2 if (!defined $dim or !$dim); if (defined $hash->{accu}{"$name $reading"}{dim}) { $hash->{accu}{"$name $reading"}{dim}=$hash->{accu}{"$name $reading"}{dim} < $dim ? $dim : $hash->{accu}{"$name $reading"}{dim}; } else { $hash->{accu}{"$name $reading"}{dim}=$dim; @{$hash->{accu}{"$name $reading"}{value}}=(); } } elsif ($format =~ /^(col(\d*)(.?))/) { $regExp =$1; my $num=$2; my $time=$3; my $hours=24; if ($num ne "") { if($time eq "d") { $hours=24*$num; }elsif ($time eq "w") { $hours=24*$num*7; } else { $hours=$num; } } AddRegexpTriggerDoIf($hash,"collect","","collect",$name,$reading); if (ref($hash->{collect}{"$name $reading"}{$hours}{values}) ne "ARRAY") { delete $hash->{collect}{"$name $reading"}{$hours}; $hash->{collect}{"$name $reading"}{$hours}{hours}=$hours; $hash->{collect}{"$name $reading"}{$hours}{dim}=72; my $values=::ReadingsVal($hash->{NAME},".col_".$hash->{collect}{"$name $reading"}{$hours}{dim}."_".$name."_".$reading."_".$hours."_values",""); my $times=::ReadingsVal($hash->{NAME},".col_".$hash->{collect}{"$name $reading"}{$hours}{dim}."_".$name."_".$reading."_".$hours."_times",""); my $va; my $ta; @{$va}=split (",",$values); for (@{$va}) { $_ = undef if ($_ eq ""); }; @{$ta}=split (",",$times); for (@{$ta}) { $_ = undef if ($_ eq ""); }; $hash->{collect}{"$name $reading"}{$hours}{values}=$va; $hash->{collect}{"$name $reading"}{$hours}{times}=$ta; $hash->{collect}{"$name $reading"}{$hours}{dim}=72; collect_setValue($hash,$name,$reading,$hours); } } elsif ($format =~ /^(d[^:]*)(?::(.*))?/) { $regExp =$1; $output=$2; }else { return($format,"unknown expression format"); } } $output="" if (!defined($output)); if ($output) { $param=",'$default','$regExp','$output'"; } elsif ($regExp) { $param=",'$default','$regExp'"; } elsif ($default ne "") { $param=",'$default'"; } if ($internal) { return("::InternalDoIf(".'$hash'.",'$name','$internal'".$param.")","",$name,undef,$internal); } else { return("::ReadingValDoIf(".'$hash'.",'$name','$reading'".$param.")","",$name,$reading,undef); } } else { if ($default ne "") { $param=",'$default'"; } return("::InternalDoIf(".'$hash'.",'$name','STATE'".$param.")","",$name,undef,'STATE'); } } } sub ReplaceReadingEvalDoIf($$$) { my ($hash,$element,$eval) = @_; my ($block,$err,$device,$reading,$internal)=ReplaceReadingDoIf($hash,$element); return ($block,$err) if ($err); if ($eval) { # return ("[".$element."]","") if(!$defs{$device}); # return ("[".$element."]","") if (defined ($reading) and !defined($defs{$device}{READINGS}{$reading})); # return ("[".$element."]","") if (defined ($internal) and !defined($defs{$device}{$internal})); my $ret = eval $block; return($block." ",$@) if ($@); $block=$ret; } return ($block,"",$device,$reading,$internal); } sub AddItemDoIf($$) { my ($items,$item)=@_; if (!$items) { $items=" $item "; } elsif ($items !~ / $item /) { $items.="$item "; } return $items; } sub AddRegexpTriggerDoIf { my ($hash,$type,$regexp,$element,$dev,$reading)= @_; $dev="" if (!defined($dev)); $reading="" if (!defined($reading)); my $regexpid='"'.$regexp.'"'; if ($dev) { if ($reading){ $hash->{Regex}{$type}{$dev}{$element}{$reading}=(($reading =~ "^\&") ? "\^$dev\$":"\^$dev\$:\^$reading: "); } elsif ($regexp) { $hash->{Regex}{$type}{$dev}{$element}{$regexpid}="\^$dev\$:$regexp"; } return; } $hash->{Regex}{$type}{$dev}{$element}{$regexpid}=$regexp; } sub addDOIF_Readings { my ($hash,$DOIF_Readings,$ReadingType) = @_; delete $hash->{$ReadingType}; delete $hash->{Regex}{$ReadingType}; $DOIF_Readings =~ s/\n/ /g; my @list=SplitDoIf(',',$DOIF_Readings); my $reading; my $readingdef; for (my $i=0;$i<@list;$i++) { ($reading,$readingdef)=SplitDoIf(":",$list[$i]); if (!$readingdef) { return ($DOIF_Readings,"no reading definiton: $list[$i]"); } if ($reading =~ /^\s*([a-z0-9._-]*[a-z._-]+[a-z0-9._-]*)\s*$/i) { my ($def,$err)=ReplaceAllReadingsDoIf($hash,$readingdef,($ReadingType eq "event_Readings" ? -7 : -4),0,$1); return ($def,$err) if ($err); $hash->{$ReadingType}{$1}=$def; } else { return ($list [$i],"wrong reading specification for: $reading"); } } return ("",""); } sub setDOIF_Reading { my ($hash,$DOIF_Reading,$reading,$ReadingType,$eventa,$eventas,$dev) = @_; $lastWarningMsg=""; $hash->{helper}{triggerEvents}=$eventa; $hash->{helper}{triggerEventsState}=$eventas; $hash->{helper}{triggerDev}=$dev; $hash->{helper}{event}=join(",",@{$eventa}) if ($eventa); my $ret = eval $hash->{$ReadingType}{$DOIF_Reading}; if ($@) { $@ =~ s/^(.*) at \(eval.*\)(.*)$/$1,$2/; $ret="error in $ReadingType: ".$@; } if ($lastWarningMsg) { $lastWarningMsg =~ s/^(.*) at \(eval.*$/$1/; Log3 ($hash->{NAME},3 , "$hash->{NAME}: warning in $ReadingType: $DOIF_Reading"); } $lastWarningMsg=""; if ($ReadingType eq "event_Readings") { readingsSingleUpdate ($hash,$DOIF_Reading,$ret,1); } elsif ($ret ne ReadingsVal($hash->{NAME},$DOIF_Reading,"") or !defined $defs{$hash->{NAME}}{READINGS}{$DOIF_Reading}) { push (@{$hash->{helper}{DOIF_Readings_events}},"$DOIF_Reading: $ret"); push (@{$hash->{helper}{DOIF_Readings_eventsState}},"$DOIF_Reading: $ret"); readingsSingleUpdate ($hash,$DOIF_Reading,$ret,0); } } sub ReplaceAllReadingsDoIf { my ($hash,$tailBlock,$condition,$eval,$id)= @_; my $block=""; my $beginning; my $err; my $cmd=""; my $ret=""; my $device=""; my $nr; my $timer=""; my $event=0; my $definition=$tailBlock; my $reading; my $internal; my $trigger=1; if (!defined $tailBlock) { return ("",""); } $tailBlock =~ s/\$SELF/$hash->{NAME}/g; while ($tailBlock ne "") { ($beginning,$block,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\[\]]'); return ($block,$err) if ($err); if ($block ne "") { if (substr($block,0,1) eq "?") { $block=substr($block,1); $trigger=0; } else { $trigger=1; } if ($block =~ /^(?:(?:#|@)[^"]*)"([^"]*)"/) { ($block,$err)=ReplaceAggregateDoIf($hash,$block,$eval); return ($block,$err) if ($err); if ($trigger) { $event=1; if ($condition >= 0) { AddRegexpTriggerDoIf($hash,"cond",$1,$condition); } elsif ($condition == -2) { AddRegexpTriggerDoIf($hash,"STATE",$1,"STATE"); } elsif ($condition == -4) { AddRegexpTriggerDoIf($hash,"DOIF_Readings",$1,$id); } elsif ($condition == -5) { AddRegexpTriggerDoIf($hash,"uiTable",$1,$id); } elsif ($condition == -6) { AddRegexpTriggerDoIf($hash,"uiState",$1,$id); } elsif ($condition == -7) { AddRegexpTriggerDoIf($hash,"event_Readings",$1,$id); } } } elsif ($block =~ /^"([^"]*)"/) { ($block,$err)=ReplaceEventDoIf($block); return ($block,$err) if ($err); if ($trigger) { if ($condition>=0) { AddRegexpTriggerDoIf($hash,"cond",$1,$condition); $event=1; } elsif ($condition == -4) { AddRegexpTriggerDoIf($hash,"DOIF_Readings",$1,$id); } elsif ($condition == -7) { AddRegexpTriggerDoIf($hash,"event_Readings",$1,$id); } else { $block="[".$block."]"; } } else { $block="[".$block."]"; } } else { $trigger=0 if (substr($block,0,7) eq "\$DEVICE"); if ($block =~ /^(\$DEVICE|[a-z0-9._]*[a-z._]+[a-z0-9._]*)($|:.+$|,.+$)/i) { ($block,$err,$device,$reading,$internal)=ReplaceReadingEvalDoIf($hash,$block,$eval); return ($block,$err) if ($err); if ($condition >= 0) { if ($trigger) { AddRegexpTriggerDoIf($hash,"cond","",$condition,$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $event=1; } $hash->{readings}{all} = AddItemDoIf($hash->{readings}{all},"$device:$reading") if (defined ($reading) and $trigger); $hash->{internals}{all} = AddItemDoIf($hash->{internals}{all},"$device:$internal") if (defined ($internal)); $hash->{trigger}{all} = AddItemDoIf($hash->{trigger}{all},"$device") if (!defined ($internal) and !defined($reading)); } elsif ($condition == -2) { if ($trigger) { AddRegexpTriggerDoIf($hash,"STATE","","STATE",$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $event=1; } } elsif ($condition == -3) { AddRegexpTriggerDoIf($hash,"itimer","","itimer",$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); } elsif ($condition == -4) { if ($trigger) { AddRegexpTriggerDoIf($hash,"DOIF_Readings","",$id,$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $event=1; } } elsif ($condition == -5) { if ($trigger) { AddRegexpTriggerDoIf($hash,"uiTable","",$id,$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $hash->{uiTable}{dev}=$device; $hash->{uiTable}{reading}=((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE")); $event=1; } } elsif ($condition == -6) { if ($trigger) { AddRegexpTriggerDoIf($hash,"uiState","",$id,$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $hash->{uiState}{dev}=$device; $hash->{uiState}{reading}=((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE")); $event=1; } } elsif ($condition == -7) { if ($trigger) { AddRegexpTriggerDoIf($hash,"event_Readings","",$id,$device,((defined $reading) ? $reading :((defined $internal) ? ("&".$internal):"&STATE"))); $event=1; } } } elsif ($condition >= 0) { ($timer,$err)=DOIF_CheckTimers($hash,$block,$condition,$trigger); if ($err eq "no timer") { $block="[".$block."]"; } else { return($timer,$err) if ($err); if ($timer) { $block=$timer; $event=1 if ($trigger); } } } else { $block="[".$block."]"; } } } $cmd.=$beginning.$block; } #return ($definition,"no trigger in condition") if ($condition >=0 and $event == 0); return ($cmd,"",$event); } sub ParseCommandsDoIf($$$) { my($hash,$tailBlock,$eval) = @_; my $pn=$hash->{NAME}; my $currentBlock=""; my $beginning=""; my $err=""; my $pos=0; my $last_error=""; my $ifcmd; my $ret; my $eventa=$hash->{helper}{triggerEvents}; my $device=$hash->{helper}{triggerDev}; my $event=$hash->{helper}{event}; my $events=""; if ($eventa) { $events=join(",",@{$eventa}); } while ($tailBlock ne "") { if ($tailBlock=~ /^\s*\{/) { # perl block ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\{\}]'); return ($currentBlock,$err) if ($err); if ($currentBlock ne "") { ($currentBlock,$err)=ReplaceAllReadingsDoIf($hash,$currentBlock,-1,$eval); return ($currentBlock,$err) if ($err); if ($eval) { ($currentBlock,$err)=EvalAllDoIf($hash,$currentBlock); return ($currentBlock,$err) if ($err); } } $currentBlock="{".$currentBlock."}"; } elsif ($tailBlock =~ /^\s*IF/) { my $ifcmd=""; ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\(\)]'); #condition return ($currentBlock,$err) if ($err); $ifcmd.=$beginning."(".$currentBlock.")"; ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\(\)]'); #if case return ($currentBlock,$err) if ($err); $ifcmd.=$beginning."(".$currentBlock.")"; if ($tailBlock =~ /^\s*ELSE/) { ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\(\)]'); #else case return ($currentBlock,$err) if ($err); $ifcmd.=$beginning."(".$currentBlock.")"; } $currentBlock=$ifcmd; } else { if ($tailBlock =~ /^\s*\(/) { # remove bracket ($beginning,$currentBlock,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\(\)]'); return ($currentBlock,$err) if ($err); #$tailBlock=substr($tailBlock,pos($tailBlock)) if ($tailBlock =~ /^\s*,/g); } else { ($currentBlock,$tailBlock)=GetCommandDoIf(',',$tailBlock); } if ($currentBlock ne "") { ($currentBlock,$err)=ReplaceAllReadingsDoIf($hash,$currentBlock,-1,$eval); return ($currentBlock,$err) if ($err); if ($eval) { ($currentBlock,$err)=EvalAllDoIf($hash, $currentBlock); return ($currentBlock,$err) if ($err); } } } if ($eval) { if ($currentBlock =~ /^{.*}$/) { $ret = AnalyzePerlCommand(undef,$currentBlock); } else { $ret = AnalyzeCommandChain(undef,$currentBlock); } if ($ret) { Log3 $pn,2 , "$pn: $currentBlock: $ret"; $last_error.="$currentBlock: $ret "; } } $tailBlock=substr($tailBlock,pos($tailBlock)) if ($tailBlock =~ /^\s*,/g); } return("",$last_error); } sub DOIF_weekdays($$) { my ($hash,$weekdays)=@_; my @days=split(',',AttrVal($hash->{NAME},"weekdays","So|Su,Mo,Di|Tu,Mi|We,Do|Th,Fr,Sa,WE,AT|WD,MWE|TWE")); for (my $i=@days-1;$i>=0;$i--) { $weekdays =~ s/$days[$i]/$i/; } return($weekdays); } sub DOIF_CheckTimers($$$$) { my ($hash,$timer,$condition,$trigger)=@_; my $i=0; my $days; my $err; my $time; my $block; my $result; my $end; my $intervaltimer; $timer =~ s/\s//g; ($timer,$days)=SplitDoIf('|',$timer); $days="" if (!defined $days); ($timer,$intervaltimer)=SplitDoIf(',',$timer); ($time,$end)=SplitDoIf('-',$timer); if (defined $intervaltimer) { if (!defined $end) { return($timer,"intervaltimer without time interval"); } } $i=$hash->{helper}{last_timer}; if (defined $time) { if ($time !~ /^\s*(\[.*\]|\{.*\}|\(.*\)|\+.*|[0-9][0-9]:.*|:[0-5][0-9])$/ and $hash->{MODEL} eq "Perl") { return ($timer,"no timer"); } ($result,$err) = DOIF_getTime($hash,$condition,$time,$trigger,$i,$days); return ($result,$err) if ($err); $hash->{helper}{last_timer}++; } else { return($timer,"no timer defined"); } if (defined $end) { if ($end !~ /^\s*(\[.*\]|\{.*\}|\(.*\)|\+.*|[0-9][0-9]:.*|:[0-5][0-9])$/ and $hash->{MODEL} eq "Perl") { return ($timer,"no timer"); } ($result,$err) = DOIF_getTime($hash,$condition,$end,$trigger,$i+1,$days); return ($result,$err) if ($err); $hash->{helper}{last_timer}++ } if (defined $intervaltimer) { ($result,$err) = DOIF_getTime($hash,$condition,$intervaltimer,$trigger,$i+2,$days); return ($result,$err) if ($err); $hash->{helper}{last_timer}++ } if (defined $end) { if ($days eq "") { $block='::DOIF_time($hash,'.$i.','.($i+1).',$wday,$hms)'; } else { $block='::DOIF_time($hash,'.$i.','.($i+1).',$wday,$hms,"'.$days.'")'; } $hash->{interval}{$i}=-1; $hash->{interval}{($i+1)}=$i; if (defined ($intervaltimer)) { $hash->{intervaltimer}{$i}=($i+2); $hash->{intervaltimer}{($i+1)}=($i+2); $hash->{intervalfunc}{($i+2)}=$block; } } else { if ($days eq "") { $block='::DOIF_time_once($hash,'.$i.',$wday)'; } else { $block='::DOIF_time_once($hash,'.$i.',$wday,"'.$days.'")'; } } if ($init_done) { DOIF_SetTimer ($hash,"DOIF_TimerTrigger",$i); DOIF_SetTimer ($hash,"DOIF_TimerTrigger",($i+1)) if (defined $end); DOIF_SetTimer ($hash,"DOIF_TimerTrigger",($i+2)) if (defined $intervaltimer); } return ($block,""); } sub DOIF_getTime { my ($hash,$condition,$time,$trigger,$nr,$days)=@_; my ($result,$err)=ReplaceAllReadingsDoIf($hash,$time,-3,0); return ($time,$err) if ($err); $time .=":00" if ($time =~ m/^[0-9][0-9]:[0-5][0-9]$/); $hash->{timer}{$nr}=0; $hash->{time}{$nr}=$time; $hash->{timeCond}{$nr}=$condition; $hash->{days}{$nr}=$days if ($days); $hash->{timers}{$condition}.=" $nr " if ($trigger); } sub DOIF_time { my $ret=0; my ($hash,$b,$e,$wday,$hms,$days)=@_; $days="" if (!defined ($days)); return 0 if (!defined $hash->{realtime}{$b}); return 0 if (!defined $hash->{realtime}{$e}); my $begin=$hash->{realtime}{$b}; my $end=$hash->{realtime}{$e}; my $err; return 0 if ($begin eq $end); ($days,$err)=ReplaceAllReadingsDoIf($hash,$days,-1,1); if ($err) { my $errmsg="error in days: $err"; Log3 ($hash->{NAME},4 , "$hash->{NAME}: $errmsg"); readingsSingleUpdate ($hash, "error", $errmsg,1); return 0; } $days=DOIF_weekdays($hash,$days); my $we=DOIF_we($wday); my $twe=DOIF_tomorrow_we($wday); if ($end gt $begin) { if ($hms ge $begin and $hms lt $end) { $ret=1; } } else { if ($hms ge $begin) { $ret=1; } elsif ($hms lt $end) { $wday=6 if ($wday-- == 0); $we=DOIF_we($wday); $ret=1; } } if ($ret == 1) { return 1 if ($days eq "" or $days =~ /$wday/ or ($days =~ /7/ and $we) or ($days =~ /8/ and !$we) or ($days =~ /9/ and $twe)); } return 0; } sub DOIF_time_once { my ($hash,$nr,$wday,$days)=@_; $days="" if (!defined ($days)); my $flag=$hash->{timer}{$nr}; my $err; ($days,$err)=ReplaceAllReadingsDoIf($hash,$days,-1,1); if ($err) { my $errmsg="error in days: $err"; Log3 ($hash->{NAME},4 , "$hash->{NAME}: $errmsg"); readingsSingleUpdate ($hash, "error", $errmsg,1); return 0; } $days=DOIF_weekdays($hash,$days); my $we=DOIF_we($wday); my $twe=DOIF_tomorrow_we($wday); if ($flag) { return 1 if ($days eq "" or $days =~ /$wday/ or ($days =~ /7/ and $we) or ($days =~ /8/ and !$we) or ($days =~ /9/ and $twe)); } return 0; } sub DOIF_SetState($$$$$) { my ($hash,$nr,$subnr,$event,$last_error)=@_; my $pn=$hash->{NAME}; my $cmdNr=""; my $cmd=""; my $err=""; my $state=AttrVal($hash->{NAME},"state",""); $state =~ s/\$SELF/$pn/g; $nr=ReadingsVal($pn,"cmd_nr",0)-1 if (!$event); if ($nr!=-1) { $cmdNr=$nr+1; my @cmdState; @cmdState=@{$hash->{attr}{cmdState}{$nr}} if (defined $hash->{attr}{cmdState}{$nr}); if (defined $cmdState[$subnr]) { $cmd=EvalCmdStateDoIf($hash,$cmdState[$subnr]); } else { if (defined $hash->{do}{$nr}{$subnr+1}) { $cmd="cmd_".$cmdNr."_".($subnr+1); } else { if (defined ($cmdState[0])) { $cmd=EvalCmdStateDoIf($hash,$cmdState[0]); } else { $cmd="cmd_$cmdNr"; } } } } if ($cmd =~ /^"(.*)"$/) { $cmd=$1; } delete $hash->{helper}{DOIF_eventa}; delete $hash->{helper}{DOIF_eventas}; readingsBeginUpdate($hash); if ($event) { push (@{$hash->{helper}{DOIF_eventas}},"cmd_nr: $cmdNr"); readingsBulkUpdate($hash,"cmd_nr",$cmdNr); if (defined $hash->{do}{$nr}{1}) { readingsBulkUpdate($hash,"cmd_seqnr",$subnr+1); push (@{$hash->{helper}{DOIF_eventas}},("cmd_seqnr: ".($subnr+1))); readingsBulkUpdate($hash,"cmd",$cmdNr.".".($subnr+1)); } else { delete ($defs{$hash->{NAME}}{READINGS}{cmd_seqnr}); push (@{$hash->{helper}{DOIF_eventas}},"cmd: $cmdNr"); readingsBulkUpdate($hash,"cmd",$cmdNr); } push (@{$hash->{helper}{DOIF_eventas}},"cmd_event: $event"); readingsBulkUpdate($hash,"cmd_event",$event); if ($last_error) { push (@{$hash->{helper}{DOIF_eventas}},"error: $last_error"); readingsBulkUpdate($hash,"error",$last_error); } else { delete ($defs{$hash->{NAME}}{READINGS}{error}); } } if ($state) { my $stateblock='\['.$pn.'\]'; $state =~ s/$stateblock/$cmd/g; $state=EvalCmdStateDoIf($hash,$state); } else { $state=$cmd; } if (defined($hash->{helper}{DOIF_eventas})) { @{$hash->{helper}{DOIF_eventa}}=@{$hash->{helper}{DOIF_eventas}}; } push (@{$hash->{helper}{DOIF_eventas}},"state: $state"); push (@{$hash->{helper}{DOIF_eventa}},"$state"); readingsBulkUpdate($hash, "state", $state); if (defined $hash->{uiState}{table}) { readingsEndUpdate ($hash, 0); } else { readingsEndUpdate ($hash, 1); } } sub DOIF_we($) { my ($wday)=@_; my $we=IsWe("",$wday); #my $we = (($wday==0 || $wday==6) ? 1 : 0); #if(!$we) { # foreach my $h2we (split(",", AttrVal("global", "holiday2we", ""))) { # if($h2we && Value($h2we)) { # my ($a, $b) = ReplaceEventMap($h2we, [$h2we, Value($h2we)], 0); # $we = 1 if($b ne "none"); # } # } #} return $we; } sub DOIF_tomorrow_we($) { my ($wday)=@_; my $we=IsWe("tomorrow",$wday); #my $we = (($wday==5 || $wday==6) ? 1 : 0); #if(!$we) { # foreach my $h2we (split(",", AttrVal("global", "holiday2we", ""))) { # if($h2we && ReadingsVal($h2we,"tomorrow",0)) { # my ($a, $b) = ReplaceEventMap($h2we, [$h2we, ReadingsVal($h2we,"tomorrow",0)], 0); # $we = 1 if($b ne "none"); # } # } #} return $we; } sub DOIF_CheckCond($$) { my ($hash,$condition) = @_; my $err=""; my ($seconds, $microseconds) = gettimeofday(); my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($seconds); $month++; $year+=1900; my $week=strftime ('%V', localtime($seconds)); my $hms = sprintf("%02d:%02d:%02d", $hour, $min, $sec); my $hm = sprintf("%02d:%02d", $hour, $min); my $ymd = sprintf("%02d-%02d-%02d", $year, $month,$mday); my $md = sprintf("%02d-%02d",$month,$mday); my $dev; my $reading; my $internal; my $we=DOIF_we($wday); my $twe=DOIF_tomorrow_we($wday); my $eventa=$hash->{helper}{triggerEvents}; my $device=$hash->{helper}{triggerDev}; my $event=$hash->{helper}{event}; my $events=""; my $cmd=ReadingsVal($hash->{NAME},"cmd",0); if ($eventa) { $events=join(",",@{$eventa}); } my $command=$hash->{condition}{$condition}; if ($command) { my $eventa=$hash->{helper}{triggerEvents}; my $events=""; if ($eventa) { $events=join(",",@{$eventa}); } $command =~ s/\$DEVICE/$hash->{helper}{triggerDev}/g; $command =~ s/\$EVENTS/$events/g; $command =~ s/\$EVENT/$hash->{helper}{event}/g; } $cmdFromAnalyze="$hash->{NAME}: ".sprintf("warning in condition c%02d",($condition+1)); $lastWarningMsg=""; my $cur_hs=$hs; $hs=$hash; my $ret=$hash->{MODEL} eq "Perl" ? eval("package DOIF; $command"):eval ($command); if($@){ $@ =~ s/^(.*) at \(eval.*\)(.*)$/$1,$2/; $err = sprintf("condition c%02d",($condition+1)).": $@"; $ret = 0; } if ($lastWarningMsg) { $lastWarningMsg =~ s/^(.*) at \(eval.*$/$1/; readingsSingleUpdate ($hash, "warning", sprintf("condition c%02d",($condition+1)).": $lastWarningMsg",1); } else { delete ($defs{$hash->{NAME}}{READINGS}{warning}); } $lastWarningMsg=""; $cmdFromAnalyze = undef; $hs=$cur_hs; return ($ret,$err); } sub DOIF_cmd ($$$$) { my ($hash,$nr,$subnr,$event)=@_; my $pn = $hash->{NAME}; my $ret; my $cmd; my $err=""; my $repeatnr; my $last_cmd=ReadingsVal($pn,"cmd_nr",0)-1; my ($seconds, $microseconds) = gettimeofday(); if (defined $hash->{attr}{cmdpause}) { my @cmdpause=@{$hash->{attr}{cmdpause}}; my $cmdpauseValue=EvalValueDoIf($hash,"cmdpause",$cmdpause[$nr]); if ($cmdpauseValue and $subnr==0) { return undef if ($seconds - time_str2num(ReadingsTimestamp($pn, "state", "1970-01-01 01:00:00")) < $cmdpauseValue); } } my @sleeptimer; if (defined $hash->{attr}{repeatcmd}) { @sleeptimer=@{$hash->{attr}{repeatcmd}}; } if (defined $hash->{attr}{repeatsame}) { my @repeatsame=@{$hash->{attr}{repeatsame}}; my $repeatsameValue=EvalValueDoIf($hash,"repeatsame",$repeatsame[$nr]); if ($subnr == 0) { if ($repeatsameValue) { $repeatnr=ReadingsVal($pn,"cmd_count",0); if ($last_cmd == $nr) { if ($repeatnr < $repeatsameValue) { $repeatnr++; } else { delete ($defs{$hash->{NAME}}{READINGS}{cmd_count}) if (defined ($sleeptimer[$nr]) and (AttrVal($pn,"do","") eq "always" or AttrVal($pn,"do","") eq "resetwait")); return undef; } } else { $repeatnr=1; } readingsSingleUpdate ($hash, "cmd_count", $repeatnr,1); } else { return undef if ($last_cmd == $nr and $subnr==0 and (AttrVal($pn,"do","") ne "always" and AttrVal($pn,"do","") ne "resetwait")); delete ($defs{$hash->{NAME}}{READINGS}{cmd_count}); } } } if (defined $hash->{attr}{waitsame}) { my @waitsame=@{$hash->{attr}{waitsame}}; my $waitsameValue=EvalValueDoIf($hash,"waitsame",$waitsame[$nr]); if ($subnr == 0) { if ($waitsameValue) { my $cmd_nr="cmd_".($nr+1); if (ReadingsVal($pn,"waitsame","") eq $cmd_nr) { if ($seconds - time_str2num(ReadingsTimestamp($pn, "waitsame", "1970-01-01 01:00:00")) > $waitsameValue) { readingsSingleUpdate ($hash, "waitsame", $cmd_nr,1); return undef; } } else { readingsSingleUpdate ($hash, "waitsame", $cmd_nr,1); return undef; } } delete ($defs{$hash->{NAME}}{READINGS}{waitsame}); } } if ($hash->{do}{$nr}{$subnr}) { $cmd=$hash->{do}{$nr}{$subnr}; my $eventa=$hash->{helper}{triggerEvents}; my $events=""; if ($eventa) { $events=join(",",@{$eventa}); } $cmd =~ s/\$DEVICE/$hash->{helper}{triggerDev}/g; $cmd =~ s/\$EVENTS/$events/g; $cmd =~ s/\$EVENT/$hash->{helper}{event}/g; #my $idx = 0; #my $evt; #foreach my $part (split(" ", $hash->{helper}{event})) { # $evt='\$EVTPART'.$idx; # $cmd =~ s/$evt/$part/g; # $idx++; #} #readingsSingleUpdate ($hash, "Event",$hash->{helper}{event},0); ($cmd,$err)=ParseCommandsDoIf($hash,$cmd,1); } DOIF_SetState ($hash,$nr,$subnr,$event,$err); if (defined $hash->{do}{$nr}{++$subnr}) { my $last_cond=ReadingsVal($pn,"cmd_nr",0)-1; if (DOIF_SetSleepTimer($hash,$last_cond,$nr,$subnr,$event,-1,undef)) { DOIF_cmd ($hash,$nr,$subnr,$event); } } else { if (($sleeptimer[$nr])) { my $last_cond=ReadingsVal($pn,"cmd_nr",0)-1; if (DOIF_SetSleepTimer($hash,$last_cond,$nr,0,$event,-1,$sleeptimer[$nr])) { DOIF_cmd ($hash,$nr,$subnr,$event); } } } #delete $hash->{helper}{cur_cmd_nr}; return undef; } sub CheckiTimerDoIf($$$) { my ($device,$itimer,$eventa)=@_; my $max = int(@{$eventa}); my $found; return 1 if ($itimer =~ /\[$device(\]|,.+\])/); for (my $j = 0; $j < $max; $j++) { if ($eventa->[$j] =~ "^([^:]+): ") { $found = ($itimer =~ /\[$device:$1(\]|:.+\]|,.+\])/); if ($found) { return 1; } } } return 0; } sub CheckReadingDoIf($$$) { my ($mydevice,$readings,$eventa)=@_; my $max = int(@{$eventa}); my $s; my $found=0; my $device; my $reading; if (!defined $readings) { return 1; } if ($readings !~ / $mydevice:.+ /) { return 1; } foreach my $item (split(/ /,$readings)) { ($device,$reading)=(split(":",$item)); if (defined $reading and $mydevice eq $device) { for (my $j = 0; $j < $max; $j++) { $s = $eventa->[$j]; $s = "" if(!defined($s)); $found = ($s =~ m/^$reading: /); if ($found) { return 1; } } } } return 0; } sub CheckRegexpDoIf { my ($hash,$type,$device,$id,$eventa,$eventas,$reading)=@_; my $nameExp; my $notifyExp; my $event; my @idlist; my @devlist; my @readinglist; return undef if (!defined $hash->{Regex}{$type}); if (!AttrVal($hash->{NAME}, "checkReadingEvent", 1)) { if (defined $hash->{Regex}{$type}{$device}) { return 1; } @devlist=(""); } else { @devlist=("$device",""); } foreach my $dev (@devlist){ if (defined $hash->{Regex}{$type}{$dev}) { @idlist=($id eq "") ? (keys %{$hash->{Regex}{$type}{$dev}}):($id); foreach my $id (@idlist) { @readinglist=(!defined $reading) ? (keys %{$hash->{Regex}{$type}{$dev}{$id}}):($reading); foreach my $i (@readinglist) { $nameExp=""; $notifyExp=""; if ($hash->{Regex}{$type}{$dev}{$id}{$i} =~ /([^\:]*):(.*)/) { $nameExp=$1; $notifyExp=$2; } else { $nameExp=$hash->{Regex}{$type}{$dev}{$id}{$i}; } if ($nameExp eq "" or $device =~ /$nameExp/) { if ($notifyExp eq "") { return $i; } if (defined $eventa and defined $eventas) { my @events_temp; if (substr($i,0,1) eq '"') { @events_temp=@{$eventa}; } else { @events_temp=@{$eventas}; } #my $max=defined @events_temp ? int(@events_temp):0; my $s; my $found; for (my $j = 0; $j < @events_temp; $j++) { $s = $events_temp[$j]; $s = "" if(!defined($s)); $found = ($s =~ m/$notifyExp/); if ($found) { return $i; } } } } } } } } return undef; } sub DOIF_block { my ($hash,$i)= @_; my $ret; my $err; my $blockname; ($ret,$err)=DOIF_CheckCond($hash,$i); if ($hash->{perlblock}{$i} =~ /^block_/) { $blockname=$hash->{perlblock}{$i}; } else { $blockname="block_".$hash->{perlblock}{$i}; } if ($err) { Log3 $hash->{NAME},4,"$hash->{NAME}: $err in perl block: $hash->{perlblock}{$i}" if ($ret != -1); readingsSingleUpdate ($hash, $blockname, $err,1); } else { readingsSingleUpdate ($hash, $blockname, "executed",0); } } sub DOIF_Perl_Trigger { my ($hash,$device)= @_; my $timerNr=-1; my $ret; my $err; my $event="$device"; my $pn=$hash->{NAME}; my $max_cond=keys %{$hash->{condition}}; my $j; my @triggerEvents; for (my $i=0; $i<$max_cond;$i++) { if ($device eq "") {# timer my $found=0; if (defined ($hash->{timers}{$i})) { foreach $j (split(" ",$hash->{timers}{$i})){ if ($hash->{timer}{$j} == 1) { $found=1; $timerNr=$j; last; } } } next if (!$found); $event="timer_".($timerNr+1); @triggerEvents=($event); $hash->{helper}{triggerEvents}=\@triggerEvents; $hash->{helper}{triggerEventsState}=\@triggerEvents; $hash->{helper}{triggerDev}=""; $hash->{helper}{event}=$event; } else { #event next if (!defined (CheckRegexpDoIf($hash,"cond", $device,$i,$hash->{helper}{triggerEvents},$hash->{helper}{triggerEventsState}))); $event="$device"; } DOIF_block($hash,$i); } return undef; } sub DOIF_Trigger { my ($hash,$device,$checkall)= @_; my $timerNr=-1; my $ret; my $err; my $doelse=0; my $event="$device"; my $pn=$hash->{NAME}; my $max_cond=keys %{$hash->{condition}}; my $last_cond=ReadingsVal($pn,"cmd_nr",0)-1; my $j; my @triggerEvents; if (AttrVal($pn, "checkall", 0) =~ "1|all|timer" and $device eq "") { for ($j=0; $j<$hash->{helper}{last_timer};$j++) { if ($hash->{timer}{$j}==1) { $timerNr=$j; #first timer last; } } } for (my $i=0; $i<$max_cond;$i++) { if ($device eq "") {# timer my $found=0; if (defined ($hash->{timers}{$i})) { foreach $j (split(" ",$hash->{timers}{$i})) { if ($hash->{timer}{$j} == 1) { $found=1; $timerNr=$j; last; } } } next if (!$found and AttrVal($pn, "checkall", 0) !~ "1|all|timer"); $event="timer_".($timerNr+1); @triggerEvents=($event); $hash->{helper}{triggerEvents}=\@triggerEvents; $hash->{helper}{triggerEventsState}=\@triggerEvents; $hash->{helper}{triggerDev}=""; $hash->{helper}{event}=$event; } else { #event if (!defined (CheckRegexpDoIf($hash,"cond", $device,$i,$hash->{helper}{triggerEvents},$hash->{helper}{triggerEventsState}))) { if (!defined ($checkall) and AttrVal($pn, "checkall", 0) !~ "1|all|event") { next; } } $event="$device"; } if (($ret,$err)=DOIF_CheckCond($hash,$i)) { if ($err) { Log3 $hash->{NAME},4,"$hash->{NAME}: $err" if ($ret != -1); readingsSingleUpdate ($hash, "error", $err,1); return undef; } if ($ret) { $hash->{helper}{timerevents}=$hash->{helper}{triggerEvents}; $hash->{helper}{timereventsState}=$hash->{helper}{triggerEventsState}; $hash->{helper}{timerevent}=$hash->{helper}{event}; $hash->{helper}{timerdev}=$hash->{helper}{triggerDev}; if (DOIF_SetSleepTimer($hash,$last_cond,$i,0,$device,$timerNr,undef)) { DOIF_cmd ($hash,$i,0,$event); return 1; } else { return undef; } } else { $doelse = 1; } } } if ($doelse) { #DOELSE if (defined ($hash->{do}{$max_cond}{0}) or ($max_cond == 1 and !(AttrVal($pn,"do","") or AttrVal($pn,"repeatsame","")))) { #DOELSE $hash->{helper}{timerevents}=$hash->{helper}{triggerEvents}; $hash->{helper}{timereventsState}=$hash->{helper}{triggerEventsState}; $hash->{helper}{timerevent}=$hash->{helper}{event}; $hash->{helper}{timerdev}=$hash->{helper}{triggerDev}; if (DOIF_SetSleepTimer($hash,$last_cond,$max_cond,0,$device,$timerNr,undef)) { DOIF_cmd ($hash,$max_cond,0,$event) ; return 1; } } } return undef; } sub DOIF_Set_Filter { my ($hash) = @_; $hash->{helper}{NOTIFYDEV}="global"; $hash->{helper}{DEVFILTER}="\^global\$"; foreach my $type (keys %{$hash->{Regex}}) { foreach my $device (keys %{$hash->{Regex}{$type}}) { foreach my $id (keys %{$hash->{Regex}{$type}{$device}}) { foreach my $reading (keys %{$hash->{Regex}{$type}{$device}{$id}}) { my $devreg=$hash->{Regex}{$type}{$device}{$id}{$reading}; my($regdev)=split(/:/,$devreg); my $devfilter=$regdev; if ($regdev eq "") { $regdev='.*'; } else { if ($regdev=~/^\^/) { $regdev=~s/^\^//; } else { $regdev="\.\*".$regdev; } if ($regdev=~/\$$/) { $regdev=~s/\$$//; } else { $regdev.='.*'; } } my $found=0; foreach my $item (split(/\|/,$hash->{helper}{NOTIFYDEV})) { if ($regdev eq $item) { $found=1; last; } } if (!$found) { $hash->{helper}{NOTIFYDEV}.="\|$regdev" ; $hash->{helper}{DEVFILTER}.="\|$devfilter" ; } #$hash->{helper}{NOTIFYDEV}.="\|$regdev" if ($hash->{helper}{NOTIFYDEV}!~/\|$regdev(\||$)/); #$hash->{helper}{DEVFILTER}.="\|$devfilterori" if ($hash->{helper}{DEVFILTER}!~/\|$devfilter(\||$)/); } } } } notifyRegexpChanged($hash,$hash->{helper}{NOTIFYDEV}); if (defined ($hash->{NOTIFYDEV})) { delete ($hash->{DOIFDEV}); } else { $hash->{DOIFDEV}=$hash->{helper}{DEVFILTER}; } } sub DOIF_Notify($$) { my ($hash, $dev) = @_; my $pn = $hash->{NAME}; return "" if($attr{$pn} && $attr{$pn}{disable}); return "" if (!$dev->{NAME}); my $device; my $reading; my $internal; my $ret; my $err; my $eventa; my $eventas; if (!defined($hash->{helper}{DEVFILTER})) { return ""; } elsif ($dev->{NAME} !~ /$hash->{helper}{DEVFILTER}/) { return ""; } $eventa = deviceEvents($dev, AttrVal($pn, "addStateEvent", 0)); $eventas = deviceEvents($dev, 1); delete ($hash->{helper}{DOIF_eventas}); delete ($hash->{helper}{DOIF_eventa}); if ($dev->{NAME} eq "global" and (EventCheckDoif($dev->{NAME},"global",$eventa,'^INITIALIZED$') or EventCheckDoif($dev->{NAME},"global",$eventa,'^REREADCFG$'))) { $hash->{helper}{globalinit}=1; # delete old timer-readings foreach my $key (keys %{$defs{$hash->{NAME}}{READINGS}}) { delete $defs{$hash->{NAME}}{READINGS}{$key} if ($key =~ "^timer_"); } delete ($defs{$hash->{NAME}}{READINGS}{wait_timer}); if ($hash->{helper}{last_timer} > 0){ for (my $j=0; $j<$hash->{helper}{last_timer};$j++) { DOIF_SetTimer ($hash,"DOIF_TimerTrigger",$j); } } if (AttrVal($pn,"initialize",0) and !AttrVal($pn,"disable",0)) { readingsBeginUpdate($hash); readingsBulkUpdate ($hash,"state",AttrVal($pn,"initialize",0)); readingsBulkUpdate ($hash,"cmd_nr","0"); readingsBulkUpdate ($hash,"cmd",0); readingsEndUpdate($hash, 0); } if (defined $hash->{perlblock}{init}) { if (($ret,$err)=DOIF_CheckCond($hash,$hash->{perlblock}{init})) { if ($err) { Log3 $hash->{NAME},4,"$hash->{NAME}: $err in perl block init" if ($ret != -1); readingsSingleUpdate ($hash, "block_init", $err,0); } else { readingsSingleUpdate ($hash, "block_init", "executed",0); } } } my $startup=AttrVal($pn, "startup", 0); if ($startup and !AttrVal($pn,"disable",0)) { $startup =~ s/\$SELF/$pn/g; my ($cmd,$err)=ParseCommandsDoIf($hash,$startup,1); Log3 ($pn,3,"$pn: error in startup: $err") if ($err); } my $uiTable=AttrVal($pn, "uiTable", 0); if ($uiTable){ my $err=DOIF_uiTable_def($hash,$uiTable,"uiTable"); Log3 ($pn,3,"$pn: error in uiTable: $err") if ($err); } my $uiState=AttrVal($pn, "uiState", 0); if ($uiState){ my $err=DOIF_uiTable_def($hash,$uiState,"uiState"); Log3 ($pn,3,"$pn: error in uiState: $err") if ($err); } DOIF_Set_Filter ($hash); } return "" if (!$hash->{helper}{globalinit}); if ($dev->{NAME} eq "global" and (EventCheckDoif($dev->{NAME},"global",$eventa,'^SAVE$'))) { if (defined $hash->{collect}) { DOIF_collect_save_values($hash); } } #return "" if (!$hash->{itimer}{all} and !$hash->{devices}{all} and !keys %{$hash->{Regex}}); #if (($hash->{itimer}{all}) and $hash->{itimer}{all} =~ / $dev->{NAME} /) { if (defined CheckRegexpDoIf($hash,"itimer",$dev->{NAME},"itimer",$eventa,$eventas)) { for (my $j=0; $j<$hash->{helper}{last_timer};$j++) { if (CheckiTimerDoIf ($dev->{NAME},$hash->{time}{$j},$eventas)) { DOIF_SetTimer ($hash,"DOIF_TimerTrigger",$j); if (defined $hash->{intervaltimer}{$j}) { DOIF_SetTimer($hash,"DOIF_TimerTrigger",$hash->{intervaltimer}{$j}); } } } } return "" if (defined $hash->{helper}{cur_cmd_nr} and $hash->{MODEL} ne "Perl"); return "" if (ReadingsVal($pn,"mode","") eq "disabled"); $ret=0; if (defined $hash->{Regex}{"event_Readings"}) { foreach $device ("$dev->{NAME}","") { if (defined $hash->{Regex}{"event_Readings"}{$device}) { #readingsBeginUpdate($hash); foreach my $reading (keys %{$hash->{Regex}{"event_Readings"}{$device}}) { my $readingregex=CheckRegexpDoIf($hash,"event_Readings",$dev->{NAME},$reading,$eventa,$eventas); setDOIF_Reading($hash,$reading,$readingregex,"event_Readings",$eventa, $eventas,$dev->{NAME}) if (defined($readingregex)); } #readingsEndUpdate($hash,1); } } } if (defined $hash->{Regex}{"accu"}{"$dev->{NAME}"}) { my $device=$dev->{NAME}; foreach my $reading (keys %{$hash->{Regex}{"accu"}{$device}{"accu"}}) { my $readingregex=CheckRegexpDoIf($hash,"accu",$dev->{NAME},"accu",$eventa,$eventas,$reading); accu_setValue($hash,$device,$readingregex) if (defined $readingregex); } } if (defined $hash->{Regex}{"collect"}{"$dev->{NAME}"}) { my $device=$dev->{NAME}; foreach my $reading (keys %{$hash->{Regex}{"collect"}{$device}{"collect"}}) { my $readingregex=CheckRegexpDoIf($hash,"collect",$dev->{NAME},"collect",$eventa,$eventas,$reading); if (defined $readingregex) { foreach my $hours (keys %{$hash->{collect}{"$device $readingregex"}}) { collect_setValue($hash,$device,$readingregex,$hours); } } } } if (defined CheckRegexpDoIf($hash,"cond",$dev->{NAME},"",$eventa,$eventas)) { $hash->{helper}{cur_cmd_nr}="Trigger $dev->{NAME}" if (AttrVal($hash->{NAME},"selftrigger","") ne "all"); $hash->{helper}{triggerEvents}=$eventa; $hash->{helper}{triggerEventsState}=$eventas; $hash->{helper}{triggerDev}=$dev->{NAME}; $hash->{helper}{event}=join(",",@{$eventa}); if ($hash->{readings}{all}) { foreach my $item (split(/ /,$hash->{readings}{all})) { ($device,$reading)=(split(":",$item)); if ($item and $device eq $dev->{NAME} and defined ($defs{$device}{READINGS}{$reading})) { if (!AttrVal($pn, "checkReadingEvent", 1) or CheckReadingDoIf ($dev->{NAME}," $item ",$eventas)) { readingsSingleUpdate ($hash, "e_".$dev->{NAME}."_".$reading,$defs{$device}{READINGS}{$reading}{VAL},0); } } } } if ($hash->{internals}{all}) { foreach my $item (split(/ /,$hash->{internals}{all})) { ($device,$internal)=(split(":",$item)); readingsSingleUpdate ($hash, "e_".$dev->{NAME}."_".$internal,$defs{$device}{$internal},0) if ($item and $device eq $dev->{NAME} and defined ($defs{$device}{$internal})); } } if ($hash->{trigger}{all}) { if ($hash->{trigger}{all} =~ / $dev->{NAME} /) { readingsSingleUpdate ($hash, "e_".$dev->{NAME}."_events",join(",",@{$eventa}),0); } } readingsSingleUpdate ($hash, "Device",$dev->{NAME},0) if ($dev->{NAME} ne $hash->{NAME}); $ret=$hash->{MODEL} eq "Perl" ? DOIF_Perl_Trigger($hash,$dev->{NAME}) : DOIF_Trigger($hash,$dev->{NAME}); } if ((defined CheckRegexpDoIf($hash,"STATE",$dev->{NAME},"STATE",$eventa,$eventas)) and !$ret) { $hash->{helper}{triggerEvents}=$eventa; $hash->{helper}{triggerEventsState}=$eventas; $hash->{helper}{triggerDev}=$dev->{NAME}; $hash->{helper}{event}=join(",",@{$eventa}); DOIF_SetState($hash,"",0,"",""); } delete $hash->{helper}{cur_cmd_nr}; if (defined $hash->{Regex}{"DOIF_Readings"}) { foreach $device ("$dev->{NAME}","") { if (defined $hash->{Regex}{"DOIF_Readings"}{$device}) { #readingsBeginUpdate($hash); foreach my $reading (keys %{$hash->{Regex}{"DOIF_Readings"}{$device}}) { my $readingregex=CheckRegexpDoIf($hash,"DOIF_Readings",$dev->{NAME},$reading,$eventa,$eventas); setDOIF_Reading($hash,$reading,$readingregex,"DOIF_Readings",$eventa, $eventas,$dev->{NAME}) if (defined($readingregex)); } #readingsEndUpdate($hash, 1); } } if (defined ($hash->{helper}{DOIF_eventas})) { #$SELF events foreach my $reading (keys %{$hash->{Regex}{"DOIF_Readings"}{$hash->{NAME}}}) { my $readingregex=CheckRegexpDoIf($hash,"DOIF_Readings",$hash->{NAME},$reading,$hash->{helper}{DOIF_eventa},$hash->{helper}{DOIF_eventas}); setDOIF_Reading($hash,$reading,$readingregex,"DOIF_Readings",$eventa, $eventas,$dev->{NAME}) if (defined($readingregex)); } } } foreach my $table ("uiTable","uiState") { if (defined $hash->{Regex}{$table}) { foreach $device ("$dev->{NAME}","") { if (defined $hash->{Regex}{$table}{$device}) { foreach my $doifId (keys %{$hash->{Regex}{$table}{$device}}) { my $readingregex=CheckRegexpDoIf($hash,$table,$dev->{NAME},$doifId,$eventa,$eventas); DOIF_UpdateCell($hash,$doifId,$hash->{NAME},$readingregex) if (defined($readingregex)); } } } if (defined ($hash->{helper}{DOIF_eventas})) { #$SELF events foreach my $doifId (keys %{$hash->{Regex}{$table}{$hash->{NAME}}}) { my $readingregex=CheckRegexpDoIf($hash,$table,$hash->{NAME},$doifId,$hash->{helper}{DOIF_eventa},$hash->{helper}{DOIF_eventas}); DOIF_UpdateCell($hash,$doifId,$hash->{NAME},$readingregex) if (defined($readingregex)); } } } } if (defined $hash->{Regex}{"event_Readings"}) { foreach $device ("$dev->{NAME}","") { if (defined $hash->{Regex}{"event_Readings"}{$device}) { #readingsBeginUpdate($hash); foreach my $reading (keys %{$hash->{Regex}{"event_Readings"}{$device}}) { my $readingregex=CheckRegexpDoIf($hash,"event_Readings",$dev->{NAME},$reading,$eventa,$eventas); setDOIF_Reading($hash,$reading,$readingregex,"event_Readings",$eventa, $eventas,$dev->{NAME}) if (defined($readingregex)); } #readingsEndUpdate($hash,1); } } if (defined ($hash->{helper}{DOIF_eventas})) { #$SELF events foreach my $reading (keys %{$hash->{Regex}{"event_Readings"}{$hash->{NAME}}}) { my $readingregex=CheckRegexpDoIf($hash,"event_Readings",$hash->{NAME},$reading,$hash->{helper}{DOIF_eventa},$hash->{helper}{DOIF_eventas}); setDOIF_Reading($hash,$reading,$readingregex,"event_Readings",$eventa, $eventas,$dev->{NAME}) if (defined($readingregex)); } } } if (defined $hash->{helper}{DOIF_Readings_events}) { if ($dev->{NAME} ne $hash->{NAME}) { @{$hash->{CHANGED}}=@{$hash->{helper}{DOIF_Readings_events}}; @{$hash->{CHANGEDWITHSTATE}}=@{$hash->{helper}{DOIF_Readings_eventsState}}; delete $hash->{helper}{DOIF_Readings_events}; delete $hash->{helper}{DOIF_Readings_eventsState}; DOIF_Notify($hash,$hash); } } return undef; } sub DOIF_TimerTrigger ($) { my ($timer)=@_; my $hash=${$timer}->{hash}; my $pn = $hash->{NAME}; my $localtime=${$timer}->{localtime}; delete $hash->{triggertime}{$localtime}; my $ret; my ($now, $microseconds) = gettimeofday(); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($now); $hash->{helper}{cur_cmd_nr}="timer $localtime" if (AttrVal($hash->{NAME},"selftrigger","") ne "all"); #$hash->{helper}{cur_cmd_nr}="timer $localtime"; for (my $j=0; $j<$hash->{helper}{last_timer};$j++) { if (defined $hash->{localtime}{$j} and $hash->{localtime}{$j} == $localtime) { if (defined ($hash->{interval}{$j})) { if ($hash->{interval}{$j} != -1) { if (defined $hash->{realtime}{$j} eq $hash->{realtime}{$hash->{interval}{$j}}) { $hash->{timer}{$hash->{interval}{$j}}=0; next; } } } $hash->{timer}{$j}=1; if (!DOIF_time_once($hash,$j,$wday,$hash->{days}{$j})) {#check days $hash->{timer}{$j}=0; } } } $ret=($hash->{MODEL} eq "Perl" ? DOIF_Perl_Trigger($hash,"") : DOIF_Trigger($hash,"")) if (ReadingsVal($pn,"mode","") ne "disabled"); for (my $j=0; $j<$hash->{helper}{last_timer};$j++) { $hash->{timer}{$j}=0; if (defined $hash->{localtime}{$j} and $hash->{localtime}{$j} == $localtime) { if (!AttrVal($hash->{NAME},"disable","")) { if (defined ($hash->{interval}{$j})) { if ($hash->{interval}{$j} != -1) { DOIF_SetTimer($hash,"DOIF_TimerTrigger",$hash->{interval}{$j}); DOIF_SetTimer($hash,"DOIF_TimerTrigger",$j,1); #if (defined $hash->{intervaltimer}{$j}) { # DOIF_DelInternalTimer($hash, $hash->{intervaltimer}{$j}); #} } else { if (defined $hash->{intervaltimer}{$j}) { DOIF_SetTimer($hash,"DOIF_TimerTrigger",$hash->{intervaltimer}{$j}); } } } else { DOIF_SetTimer($hash,"DOIF_TimerTrigger",$j,1); } } } } delete ($hash->{helper}{cur_cmd_nr}); return undef; #return($ret); } sub DOIF_DelInternalTimer { my ($hash, $nr) = @_; RemoveInternalTimer(\$hash->{triggertime}{$hash->{localtime}{$nr}}); delete ($hash->{triggertime}{$hash->{localtime}{$nr}}); my $cond=$hash->{timeCond}{$nr}; my $timernr=sprintf("timer_%02d_c%02d",($nr+1),($cond+1)); delete ($defs{$hash->{NAME}}{READINGS}{$timernr}); } sub DOIF_DetTime($$) { my ($hash, $timeStr) = @_; my $rel=0; my $align; my $hr=0; my $err; my $h=0; my $m=0; my $s=0; my $fn; if (substr($timeStr,0,1) eq "+") { $timeStr=substr($timeStr,1); $rel=1; } my ($now, $microseconds) = gettimeofday(); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($now); if($timeStr =~ m/^\[([0-9]+)\]:([0-5][0-9])$/) { $hr=$1; $rel=0; $align=$2; } elsif ($timeStr =~ m/^:([0-5][0-9])$/) { $align=$1; } elsif ($timeStr =~ m/^(\-?([0-9]+))$/) { $s=$1; } else { ($timeStr,$err)=ReplaceAllReadingsDoIf($hash,$timeStr,-3,1); return ($err) if ($err); ($err, $h, $m, $s, $fn) = GetTimeSpec($timeStr); return $err if ($err); } if (defined ($align)) { if ($rel) { if ($align > 0) { $m = (int($min/$align)+1)*$align; if ($m>=60) { $h = $hour+1; $m = 0; } else { $h = $hour; } } $rel=0; } else { $m=$align; if ($hr > 1) { $h = (int($hour/$hr)+1)*$hr; $h = 0 if ($h >=24); } else { if ($m <= $min) { $h = $hour+1; } else { $h = $hour; } } } } my $second = $h*3600+$m*60+$s; if ($second == 0 and $rel) { $err = "null is not allowed on a relative time"; } return ($err, ($rel and !defined ($align)), $second,defined ($align)); } sub DOIF_CalcTime($$) { my ($hash,$block)= @_; my $tailBlock; my $beginning; my $err; my $cmd=""; my $rel=""; my $relGlobal=0; my $reading; my $internal; my $device; my $pos; my $ret; my $align; my $alignInCalc; if ($block=~ m/^\+\[([0-9]+)\]:([0-5][0-9])$/) { ($err,$rel,$block,$align)=DOIF_DetTime($hash,$block); return ($block,$err,$rel,$align); } elsif ($block =~ /^\+\(/ or $block =~ /^\+\[/) { $relGlobal=1; #$pos=pos($block); $block=substr($block,1); } if ($block =~ /^\(/) { ($beginning,$tailBlock,$err,$tailBlock)=GetBlockDoIf($block,'[\(\)]'); return ($tailBlock,$err) if ($err); } else { if ($block =~ /^\[/) { ($beginning,$block,$err,$tailBlock)=GetBlockDoIf($block,'[\[\]]'); return ($block,$err) if ($err); ($block,$err,$device,$reading,$internal)=ReplaceReadingEvalDoIf($hash,$block,1); return ($block,$err) if ($err); } ($err,$rel,$block,$align)=DOIF_DetTime($hash, $block); $rel=1 if ($relGlobal); return ($block,$err,$rel,$align); } $tailBlock=$block; while ($tailBlock ne "") { ($beginning,$block,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\{\}]'); return ($block,$err) if ($err); if ($block ne "") { ($err,$rel,$block)=DOIF_DetTime($hash,"{".$block."}"); return ($block,$err) if ($err); } $cmd.=$beginning.$block; } $tailBlock=$cmd; $cmd=""; while ($tailBlock ne "") { ($beginning,$block,$err,$tailBlock)=GetBlockDoIf($tailBlock,'[\[\]]'); return ($block,$err) if ($err); if ($block ne "") { if ($block =~ /^\??[a-z0-9._]*[a-z._]+[a-z0-9._]*($|:.+$)/i) { ($block,$err,$device,$reading,$internal)=ReplaceReadingEvalDoIf($hash,$block,1); return ($block,$err) if ($err); } ($err,$rel,$block,$alignInCalc)=DOIF_DetTime($hash,$block); $align=$alignInCalc if ($alignInCalc); return ($block,$err) if ($err); } $cmd.=$beginning.$block; } $ret = eval $cmd; return($cmd." ",$@) if ($@); return ($ret,"null is not allowed on a relative time",$relGlobal) if ($ret == 0 and $relGlobal); return ($ret,"",$relGlobal,$align); } sub DOIF_SetTimer { my ($hash, $func, $nr,$next_day) = @_; my $timeStr=$hash->{time}{$nr}; my $cond=$hash->{timeCond}{$nr}; my $next_time; if (defined ($hash->{localtime}{$nr})) { my $old_lt=$hash->{localtime}{$nr}; my $found=0; delete ($hash->{localtime}{$nr}); delete ($hash->{realtime}{$nr}); foreach my $lt (keys %{$hash->{localtime}}) { if ($hash->{localtime}{$lt} == $old_lt) { $found=1; last; } } if (!$found) { RemoveInternalTimer(\$hash->{triggertime}{$old_lt}); delete ($hash->{triggertime}{$old_lt}); } } my ($second,$err, $rel,$align)=DOIF_CalcTime($hash,$timeStr); my $timernr=sprintf("timer_%02d_c%02d",($nr+1),($cond+1)); if ($err) { readingsSingleUpdate ($hash,$timernr,"error: ".$err,AttrVal($hash->{NAME},"timerevent","")?1:0); Log3 $hash->{NAME},4 , "$hash->{NAME} ".$timernr." error: ".$err; #RemoveInternalTimer($timer); #$hash->{realtime}{$nr} = "00:00:00" if (!defined $hash->{realtime}{$nr}); return $err; } if ($second < 0) { if ($rel) { readingsSingleUpdate ($hash,$timernr,"time offset: $second, negativ offset is not allowed",AttrVal($hash->{NAME},"timerevent","")?1:0); return($timernr,"time offset: $second, negativ offset is not allowed"); } else { readingsSingleUpdate ($hash,$timernr,"time in seconds: $second, negative times are not allowed",AttrVal($hash->{NAME},"timerevent","")?1:0); return($timernr,"time in seconds: $second, negative times are not allowed"); } } my ($now, $microseconds) = gettimeofday(); my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($now); my $hms_now = sprintf("%02d:%02d:%02d", $hour, $min, $sec); my $wday_now = $wday; my $isdst_now=$isdst; my $sec_today = $hour*3600+$min*60+$sec; my $midnight = $now-$sec_today; if ($rel) { $next_time =$now+$second; } else { $next_time = $midnight+$second; } if ($second <= $sec_today and !$rel or defined ($next_day) and !$rel and $second < 86400 and !$align) { $next_time+=86400; } ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($next_time); if ($isdst_now != $isdst) { if ($isdst_now == 1) { $next_time+=3600 if ($isdst == 0); } else { $next_time-=3600 if ($second>=3*3600 or $second <= $sec_today and $second<2*3600); } } if (defined ($hash->{intervalfunc}{$nr})) { my $hms = $hms_now; $wday = $wday_now; my $cond=$hash->{timeCond}{$nr}; my $timernr=sprintf("timer_%02d_c%02d",($nr+1),($cond+1)); if (!eval ($hash->{intervalfunc}{$nr})) { delete ($defs{$hash->{NAME}}{READINGS}{$timernr}); return undef; } ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($next_time); $hms = sprintf("%02d:%02d:%02d", $hour, $min, $sec); if (!eval ($hash->{intervalfunc}{$nr})) { delete ($defs{$hash->{NAME}}{READINGS}{$timernr}); return undef; } } my $next_time_str=strftime("%d.%m.%Y %H:%M:%S",localtime($next_time)); $next_time_str.="\|".$hash->{days}{$nr} if (defined ($hash->{days}{$nr})); readingsSingleUpdate ($hash,$timernr,$next_time_str,AttrVal($hash->{NAME},"timerevent","")?1:0); $hash->{realtime}{$nr}=strftime("%H:%M:%S",localtime($next_time)); $hash->{localtime}{$nr}=$next_time; if (!defined ($hash->{triggertime}{$next_time})) { $hash->{triggertime}{$next_time}{hash}=$hash; $hash->{triggertime}{$next_time}{localtime}=$next_time; InternalTimer($next_time, $func, \$hash->{triggertime}{$next_time}, 0); } return undef; } sub DOIF_SetSleepTimer($$$$$$$) { my ($hash,$last_cond,$nr,$subnr,$device,$timerNr,$repeatcmd)=@_; my $pn = $hash->{NAME}; my $sleeptimer=$hash->{helper}{sleeptimer}; my @waitdel; @waitdel=@{$hash->{attr}{waitdel}{$nr}} if (defined $hash->{attr}{waitdel}{$nr}); my $err; if ($sleeptimer != -1 and (($sleeptimer != $nr or AttrVal($pn,"do","") eq "resetwait") or ($sleeptimer == $nr and $waitdel[$subnr]))) { RemoveInternalTimer($hash); #delete ($defs{$hash->{NAME}}{READINGS}{wait_timer}); readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; $subnr=$hash->{helper}{sleepsubtimer} if ($hash->{helper}{sleepsubtimer}!=-1 and $sleeptimer == $nr); return 0 if ($sleeptimer == $nr and $waitdel[$subnr]); } if ($timerNr >= 0 and !AttrVal($pn,"timerWithWait","")) {#Timer if ($last_cond != $nr or AttrVal($pn,"do","") eq "always" or AttrVal($pn,"do","") eq "resetwait" or AttrVal($pn,"repeatsame","")) { return 1; } else { return 0; } } if ($hash->{helper}{sleeptimer} == -1 and ($last_cond != $nr or $subnr > 0 or AttrVal($pn,"do","") eq "always" or AttrVal($pn,"do","") eq "resetwait" or AttrVal($pn,"repeatsame","") or $repeatcmd)) { my $sleeptime=0; if ($repeatcmd) { $sleeptime=$repeatcmd; } else { my @sleeptimer; @sleeptimer=@{$hash->{attr}{wait}{$nr}} if (defined $hash->{attr}{wait}{$nr}); if ($waitdel[$subnr]) { $sleeptime = $waitdel[$subnr]; } else { if ($sleeptimer[$subnr]) { $sleeptime=$sleeptimer[$subnr]; } } } $sleeptime=EvalValueDoIf($hash,"wait",$sleeptime); if ($sleeptime) { my $seconds = gettimeofday(); my $next_time = $seconds+$sleeptime; $hash->{helper}{sleeptimer}=$nr; $hash->{helper}{sleepsubtimer}=$subnr; $device="timer_".($timerNr+1) if ($timerNr >= 0); $hash->{helper}{sleepdevice}=$device; my $cmd_nr=$nr+1; if (defined $hash->{do}{$nr}{1}) { my $cmd_subnr=$subnr+1; readingsSingleUpdate ($hash,"wait_timer",strftime("%d.%m.%Y %H:%M:%S cmd_$cmd_nr"."_$cmd_subnr $device",localtime($next_time)),1); } else { readingsSingleUpdate ($hash,"wait_timer",strftime("%d.%m.%Y %H:%M:%S cmd_$cmd_nr $device",localtime($next_time)),1); } InternalTimer($next_time, "DOIF_SleepTrigger",$hash, 0); return 0; } elsif ($repeatcmd){ return 0; } else { return 1; } } else { return 0; } } sub DOIF_SleepTrigger ($) { my ($hash)=@_; my $sleeptimer=$hash->{helper}{sleeptimer}; my $sleepsubtimer=$hash->{helper}{sleepsubtimer}; my $pn = $hash->{NAME}; $hash->{helper}{cur_cmd_nr}="wait_timer" if (!AttrVal($hash->{NAME},"selftrigger","")); $hash->{helper}{triggerEvents}=$hash->{helper}{timerevents}; $hash->{helper}{triggerEventsState}=$hash->{helper}{timereventsState}; $hash->{helper}{event}=$hash->{helper}{timerevent}; $hash->{helper}{triggerDev}=$hash->{helper}{timerdev}; readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; $hash->{helper}{sleepsubtimer}=-1; if (ReadingsVal($pn,"mode","") ne "disabled") { DOIF_cmd ($hash,$sleeptimer,$sleepsubtimer,$hash->{helper}{sleepdevice}); } delete $hash->{helper}{cur_cmd_nr}; return undef; } sub DOIF_Perlblock { my ($hash,$table,$tail,$subs) =@_; my ($beginning,$perlblock,$err,$i); $i=0; while($tail =~ /(?:^|\n)\s*(\w*)\s*\{/g) { my $blockname=$1; ($beginning,$perlblock,$err,$tail)=GetBlockDoIf($tail,'[\{\}]'); if ($err) { return ("Perlblck: $err",$perlblock); } elsif (defined $subs) { if ($blockname eq "subs") { $perlblock ="no warnings 'redefine';package DOIF;".$perlblock; eval ($perlblock); if ($@) { return ("error in defs block",$@); } return("",""); } } elsif ($blockname ne "subs") { ($perlblock,$err)=ReplaceAllReadingsDoIf($hash,$perlblock,$i,0); return ($perlblock,$err) if ($err); $hash->{condition}{$i}=$perlblock; $hash->{perlblock}{$i}=$blockname ? $blockname:sprintf("block_%02d",($i+1)); if ($blockname eq "init") { $hash->{perlblock}{init}=$i; } $i++; } } return ("",""); } sub CmdDoIfPerl($$) { my ($hash, $tail) = @_; my $perlblock=""; my $beginning; my $ret; my $err=""; my $i=0; my $cur_hs=$hs; $hs=$hash; my $msg; #def modify if ($init_done) { DOIF_delTimer($hash); DOIF_delAll ($hash); readingsBeginUpdate($hash); readingsBulkUpdate ($hash,"mode","enabled"); readingsEndUpdate($hash, 1); readingsSingleUpdate($hash,"state","initialized",0); $hash->{helper}{globalinit}=1; #foreach my $key (keys %{$attr{$hash->{NAME}}}) { # if ($key ne "disable" and AttrVal($hash->{NAME},$key,"")) { # DOIF_Attr ("set",$hash->{NAME},$key,AttrVal($hash->{NAME},$key,"")); # } #} } $hash->{helper}{last_timer}=0; $hash->{helper}{sleeptimer}=-1; if ($tail =~ /^ *$/) { $hs=$cur_hs; return("",""); } $tail =~ s/\$VAR/\$hash->{var}/g; $tail =~ s/\$_(\w+)/\$hash->\{var\}\{$1\}/g; $tail =~ s/\$SELF/$hash->{NAME}/g; ($err,$msg)=DOIF_Perlblock($hash,"defs",$tail,1); return ($msg,$err) if ($err); ($err,$tail)=DOIF_DEF_TPL($hash,"defs",$tail); if ($err) { $hs=$cur_hs; return ($tail,$err); } ($err,$tail)=DOIF_FOR($hash,"defs",$tail); if ($err) { $hs=$cur_hs; return ($tail,$err); } ($err,$tail)=DOIF_TPL($hash,"defs",$tail); if ($err) { $hs=$cur_hs; return ($tail,$err); } ($err,$msg)=DOIF_Perlblock($hash,"defs",$tail); if ($err) { $hs=$cur_hs; return ($tail,$err); } # while ($tail ne "") { # ($beginning,$perlblock,$err,$tail)=GetBlockDoIf($tail,'[\{\}]'); # return ($perlblock,$err) if ($err); # next if (!$perlblock); # if ($beginning =~ /(\w*)[\s]*$/) { # my $blockname=$1; # if ($blockname eq "subs") { # $perlblock =~ s/\$SELF/$hash->{NAME}/g; # $perlblock ="no warnings 'redefine';package DOIF;".$perlblock; # eval ($perlblock); # if ($@) { # return ("error in defs block",$@); # } # next; # } # ($perlblock,$err)=ReplaceAllReadingsDoIf($hash,$perlblock,$i,0); # return ($perlblock,$err) if ($err); # $hash->{condition}{$i}=$perlblock; # $hash->{perlblock}{$i}=$blockname ? $blockname:sprintf("block_%02d",($i+1)); # if ($blockname eq "init") { # $hash->{perlblock}{init}=$i; # } # } # $i++; # } if (defined $hash->{perlblock}{init}) { if ($init_done) { if (($ret,$err)=DOIF_CheckCond($hash,$hash->{perlblock}{init})) { if ($err) { Log3 $hash->{NAME},4,"$hash->{NAME}: $err in perl block init" if ($ret != -1); readingsSingleUpdate ($hash, "block_init", $err,0); } else { readingsSingleUpdate ($hash, "block_init", "executed",0); } } } } if ($init_done) { foreach my $key (keys %{$attr{$hash->{NAME}}}) { if ($key ne "disable" and AttrVal($hash->{NAME},$key,"")) { DOIF_Attr ("set",$hash->{NAME},$key,AttrVal($hash->{NAME},$key,"")); } } } $hs=$cur_hs; return("","") } ############################# sub CmdDoIf($$) { my ($hash, $tail) = @_; my $cond=""; my $err=""; my $if_cmd=""; my $if_cmd_ori=""; my $else_cmd=""; my $else_cmd_ori=""; my $tailBlock; my $eval=""; my $beginning; my $i=0; my $j=0; my $last_do; #def modify if ($init_done) { DOIF_delTimer($hash); DOIF_delAll ($hash); readingsBeginUpdate($hash); readingsBulkUpdate($hash,"cmd",0); readingsBulkUpdate($hash,"state","initialized"); readingsBulkUpdate ($hash,"mode","enabled"); readingsEndUpdate($hash, 1); $hash->{helper}{globalinit}=1; #foreach my $key (keys %{$attr{$hash->{NAME}}}) { # if ($key ne "disable" and AttrVal($hash->{NAME},$key,"")) { # DOIF_Attr ("set",$hash->{NAME},$key,AttrVal($hash->{NAME},$key,"")); # } #} } $hash->{helper}{last_timer}=0; $hash->{helper}{sleeptimer}=-1; return("","") if ($tail =~ /^ *$/); $tail =~ s/\n/ /g; while ($tail ne "") { return($tail, "no left bracket of condition") if ($tail !~ /^ *\(/); #condition ($beginning,$cond,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); return ($cond,$err) if ($err); ($cond,$err)=ReplaceAllReadingsDoIf($hash,$cond,$i,0); return ($cond,$err) if ($err); return ($tail,"no condition") if ($cond eq ""); $hash->{condition}{$i}=$cond; #DOIF $if_cmd_ori=""; $j=0; while ($tail =~ /^\s*(\(|\{)/) { if ($tail =~ /^\s*\(/) { ($beginning,$if_cmd_ori,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); return ($if_cmd_ori,$err) if ($err); } elsif ($tail =~ /^\s*\{/) { ($beginning,$if_cmd_ori,$err,$tail)=GetBlockDoIf($tail,'[\{\}]'); return ($if_cmd_ori,$err) if ($err); $if_cmd_ori="{".$if_cmd_ori."}"; } ($if_cmd,$err)=ParseCommandsDoIf($hash,$if_cmd_ori,0); return ($if_cmd,$err) if ($err); #return ($tail,"no commands") if ($if_cmd eq ""); $hash->{do}{$i}{$j++}=$if_cmd_ori; } $hash->{do}{$i}{0}=$if_cmd_ori if ($j==0); #do without brackets $last_do=$i; $tail =~ s/^\s*$//g; if (length($tail)) { $tail =~ /^\s*DOELSEIF/g; if (pos($tail)) { $tail=substr($tail,pos($tail)); if (!length($tail)) { return ($tail,"no DOELSEIF block"); } } else { last if ($tail =~ /^\s*DOELSE/); return ($tail,"expected DOELSEIF or DOELSE"); } } $i++; } #DOELSE if (length($tail)) { $tail =~ /^\s*DOELSE/g; if (pos($tail)) { $tail=substr($tail,pos($tail)); } else { return ($tail,"expected DOELSE"); } $j=0; while ($tail =~ /^\s*(\(|\{)/) { if ($tail =~ /^\s*\(/) { ($beginning,$else_cmd_ori,$err,$tail)=GetBlockDoIf($tail,'[\(\)]'); return ($else_cmd_ori,$err) if ($err); } elsif ($tail =~ /^\s*\{/) { ($beginning,$else_cmd_ori,$err,$tail)=GetBlockDoIf($tail,'[\{\}]'); return ($else_cmd_ori,$err) if ($err); $else_cmd_ori="{".$else_cmd_ori."}"; } ($else_cmd,$err)=ParseCommandsDoIf($hash,$else_cmd_ori,0); return ($else_cmd,$err) if ($err); $hash->{do}{$last_do+1}{$j++}=$else_cmd_ori; } $hash->{do}{$last_do+1}{0}=$else_cmd_ori if ($j==0); #doelse without brackets } if ($init_done) { foreach my $key (keys %{$attr{$hash->{NAME}}}) { if ($key ne "disable" and AttrVal($hash->{NAME},$key,"")) { DOIF_Attr ("set",$hash->{NAME},$key,AttrVal($hash->{NAME},$key,"")); } } } return("","") } sub DOIF_Define($$$) { my ($hash, $def) = @_; my ($name, $type, $cmd) = split(/[\s]+/, $def, 3); return undef if (AttrVal($hash->{NAME},"disable","")); my $err; my $msg; my $cur_hs=$hs; $hs=$hash; if (AnalyzeCommandChain(undef,"version 98_DOIF.pm noheader") =~ "^98_DOIF.pm (.*)Z") { $hash->{VERSION}=$1; } if (!$cmd) { $cmd=""; $defs{$hash->{NAME}}{DEF}="##"; } else { $cmd =~ s/(##.*\n)|(##.*$)/ /g; $cmd =~ s/\$SELF/$hash->{NAME}/g; } if ($cmd =~ /^\s*(\(|$)/) { $hash->{MODEL}="FHEM"; ($msg,$err)=CmdDoIf($hash,$cmd); #delete $defs{$hash->{NAME}}{".AttrList"}; setDevAttrList($hash->{NAME}); } else { $hash->{MODEL}="Perl"; #$defs{$hash->{NAME}}{".AttrList"} = "disable:0,1 loglevel:0,1,2,3,4,5,6 startup state initialize notexist checkReadingEvent:1,0 addStateEvent:1,0 weekdays setList:textField-long readingList DOIF_Readings:textField-long uiTable:textField-long ".$readingFnAttributes; setDevAttrList($hash->{NAME},"disable:0,1 loglevel:0,1,2,3,4,5,6 notexist checkReadingEvent:0,1 addStateEvent:1,0 weekdays setList:textField-long readingList DOIF_Readings:textField-long event_Readings:textField-long uiState:textField-long uiTable:textField-long ".$readingFnAttributes); ($msg,$err)=CmdDoIfPerl($hash,$cmd); } if ($err ne "") { $msg=$cmd if (!$msg); my $errmsg="$name $type: $err: $msg"; $hs=$cur_hs; return $errmsg; } else { DOIF_Set_Filter ($hash); $hs=$cur_hs; return undef; } } ################################# sub DOIF_Attr(@) { my @a = @_; my $hash = $defs{$a[1]}; my $pn=$hash->{NAME}; my $ret=""; my $cur_hs=$hs; $hs=$hash; if (($a[0] eq "set" and $a[2] eq "disable" and ($a[3] eq "0")) or (($a[0] eq "del" and $a[2] eq "disable"))) { my $cmd = $defs{$hash->{NAME}}{DEF}; my $msg; my $err; if (!$cmd) { $cmd=""; $defs{$hash->{NAME}}{DEF}="##"; } else { $cmd =~ s/(##.*\n)|(##.*$)/ /g; $cmd =~ s/\$SELF/$hash->{NAME}/g; } if ($cmd =~ /^\s*(\(|$)/) { $hash->{MODEL}="FHEM"; ($msg,$err)=CmdDoIf($hash,$cmd); } else { $hash->{MODEL}="Perl"; ($msg,$err)=CmdDoIfPerl($hash,$cmd); } if ($err ne "") { $msg=$cmd if (!$msg); $hs=$cur_hs; return ("$err: $msg"); } } elsif($a[0] eq "set" and $a[2] eq "disable" and $a[3] eq "1") { DOIF_delTimer($hash); DOIF_delAll ($hash); readingsBeginUpdate($hash); #if ($hash->{MODEL} ne "Perl") { # readingsBulkUpdate ($hash, "state", "deactivated"); #} readingsBulkUpdate ($hash, "state", "deactivated"); readingsBulkUpdate ($hash, "mode", "deactivated"); readingsEndUpdate ($hash, 1); } elsif($a[0] eq "set" && $a[2] eq "state") { delete $hash->{Regex}{"STATE"}; my ($block,$err)=ReplaceAllReadingsDoIf($hash,$a[3],-2,0); $hs=$cur_hs; return $err if ($err); } elsif($a[0] eq "del" && $a[2] eq "state") { delete $hash->{Regex}{"STATE"}; } elsif($a[0] =~ "set|del" && $a[2] eq "wait") { if ($a[0] eq "del") { RemoveInternalTimer($hash); readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; } delete $hash->{attr}{wait}; my @wait=SplitDoIf(':',$a[3]); for (my $i=0;$i<@wait;$i++){ @{$hash->{attr}{wait}{$i}}=SplitDoIf(',',$wait[$i]); } } elsif($a[0] =~ "set|del" && $a[2] eq "waitdel") { if ($a[0] eq "del") { RemoveInternalTimer($hash); readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; } delete $hash->{attr}{waitdel}; my @waitdel=SplitDoIf(':',$a[3]); for (my $i=0;$i<@waitdel;$i++){ @{$hash->{attr}{waitdel}{$i}}=SplitDoIf(',',$waitdel[$i]); } } elsif($a[0] =~ "set|del" && $a[2] eq "repeatsame") { delete ($defs{$hash->{NAME}}{READINGS}{cmd_count}); @{$hash->{attr}{repeatsame}}=SplitDoIf(':',$a[3]); } elsif($a[0] =~ "set|del" && $a[2] eq "repeatcmd") { @{$hash->{attr}{repeatcmd}}=SplitDoIf(':',$a[3]); } elsif($a[0] =~ "set|del" && $a[2] eq "cmdpause") { @{$hash->{attr}{cmdpause}}=SplitDoIf(':',$a[3]); } elsif($a[0] =~ "set|del" && $a[2] eq "cmdState") { delete $hash->{attr}{cmdState}; my @cmdState=SplitDoIf('|',$a[3]); for (my $i=0;$i<@cmdState;$i++){ @{$hash->{attr}{cmdState}{$i}}=SplitDoIf(',',$cmdState[$i]); } } elsif($a[0] =~ "set|del" && $a[2] eq "waitsame") { delete ($defs{$hash->{NAME}}{READINGS}{waitsame}); @{$hash->{attr}{waitsame}}=SplitDoIf(':',$a[3]); } elsif($a[0] eq "set" && ($a[2] eq "DOIF_Readings" or $a[2] eq "event_Readings")) { my ($def,$err)=addDOIF_Readings($hash,$a[3],$a[2]); if ($err) { $hs=$cur_hs; return ("error in $a[2] $def, $err"); } else { if ($init_done) { foreach my $reading (keys %{$hash->{$a[2]}}) { setDOIF_Reading ($hash,$reading,"",$a[2],"","",""); } } } } elsif($a[0] eq "del" && ($a[2] eq "DOIF_Readings" or $a[2] eq "event_Readings")) { delete ($hash->{$a[2]}); delete $hash->{Regex}{$a[2]}; } elsif($a[0] eq "set" && ($a[2] eq "uiTable" || $a[2] eq "uiState")) { if ($init_done) { my $err=DOIF_uiTable_def($hash,$a[3],$a[2]); $hs=$cur_hs; return $err if ($err); DOIF_reloadFW; } } elsif($a[0] eq "del" && ($a[2] eq "uiTable" || $a[2] eq "uiState")) { delete ($hash->{Regex}{$a[2]}); delete ($hash->{$a[2]}); } elsif($a[0] eq "set" && $a[2] eq "startup") { my ($cmd,$err)=ParseCommandsDoIf($hash,$a[3],0); if ($err) { $hs=$cur_hs; return ("error in startup $a[3], $err"); } } DOIF_Set_Filter($hash); $hs=$cur_hs; return undef; } sub DOIF_Undef { my ($hash, $name) = @_; $hash->{DELETED} = 1; DOIF_delTimer($hash); DOIF_killBlocking($hash); return undef; } sub DOIF_Shutdown { my ($hash) = @_; DOIF_killBlocking($hash); if (defined $hash->{collect}) { DOIF_collect_save_values($hash); } return undef; } sub DOIF_Set($@) { my ($hash, @a) = @_; my $pn = $hash->{NAME}; my $arg = $a[1]; my $value = (defined $a[2]) ? $a[2] : ""; my $ret=""; my $cur_hs=$hs; $hs=$hash; if ($arg eq "disable" or $arg eq "initialize" or $arg eq "enable") { if (AttrVal($hash->{NAME},"disable","")) { $hs=$cur_hs; return ("modul ist deactivated by disable attribut, delete disable attribut first"); } } if ($arg eq "disable") { readingsBeginUpdate ($hash); if ($hash->{MODEL} ne "Perl") { readingsBulkUpdate($hash,"last_cmd",ReadingsVal($pn,"state","")); readingsBulkUpdate($hash, "state", "disabled"); } readingsBulkUpdate($hash, "mode", "disabled"); readingsEndUpdate ($hash, 1); } elsif ($arg eq "initialize" ) { readingsSingleUpdate ($hash,"mode","enabled",1); if ($hash->{MODEL} ne "Perl") { delete ($defs{$hash->{NAME}}{READINGS}{cmd_nr}); delete ($defs{$hash->{NAME}}{READINGS}{cmd}); delete ($defs{$hash->{NAME}}{READINGS}{cmd_seqnr}); delete ($defs{$hash->{NAME}}{READINGS}{cmd_event}); readingsSingleUpdate($hash, "state","initialize",1); } } elsif ($arg eq "enable" ) { #delete ($defs{$hash->{NAME}}{READINGS}{mode}); if ($hash->{MODEL} ne "Perl") { readingsSingleUpdate ($hash,"state",ReadingsVal($pn,"last_cmd",""),0) if (ReadingsVal($pn,"last_cmd","") ne ""); delete ($defs{$hash->{NAME}}{READINGS}{last_cmd}); } readingsSingleUpdate ($hash,"mode","enabled",1) } elsif ($arg eq "checkall" ) { $hash->{helper}{triggerDev}=""; delete $hash->{helper}{triggerEvents}; delete $hash->{helper}{triggerEventsState}; DOIF_Trigger ($hash,$pn,1); } elsif ($arg =~ /^cmd_(.*)/ ) { if (ReadingsVal($pn,"mode","") ne "disabled") { if ($hash->{helper}{sleeptimer} != -1) { RemoveInternalTimer($hash); readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; } DOIF_cmd ($hash,$1-1,0,"set_cmd_".$1); } } elsif ($arg eq "?") { my $setList = AttrVal($pn, "setList", " "); $setList =~ s/\n/ /g; my $cmdList=""; my $checkall=""; my $initialize=""; my $max_cond=keys %{$hash->{condition}}; if ($hash->{MODEL} ne "Perl") { $checkall="checkall:noArg"; $initialize="initialize:noArg"; $max_cond++ if (defined ($hash->{do}{$max_cond}{0}) or ($max_cond == 1 and !(AttrVal($pn,"do","") or AttrVal($pn,"repeatsame","")))); for (my $i=0; $i <$max_cond;$i++) { $cmdList.="cmd_".($i+1).":noArg "; } } else { for (my $i=0; $i <$max_cond;$i++) { $cmdList.=$hash->{perlblock}{$i}.":noArg "; } } $hs=$cur_hs; return "unknown argument ? for $pn, choose one of disable:noArg enable:noArg $initialize $checkall $cmdList $setList"; } else { my @rl = split(" ", AttrVal($pn, "readingList", "")); my $doRet; eval { if(@rl && grep /\b$arg\b/, @rl) { my $v = shift @a; $v = shift @a; readingsSingleUpdate($hash, $v, join(" ",@a), 1); $doRet = 1; } }; if($doRet) { $hs=$cur_hs; return; } if (ReadingsVal($pn,"mode","") ne "disabled") { if ($hash->{MODEL} ne "Perl") { foreach my $i (keys %{$hash->{attr}{cmdState}}) { if ($arg eq EvalCmdStateDoIf($hash,$hash->{attr}{cmdState}{$i}[0])) { if ($hash->{helper}{sleeptimer} != -1) { RemoveInternalTimer($hash); readingsSingleUpdate ($hash, "wait_timer", "no timer",1); $hash->{helper}{sleeptimer}=-1; } DOIF_cmd ($hash,$i,0,"set_".$arg."_cmd_".($i+1)); last; } } } else { for (my $i=0; $i < keys %{$hash->{condition}};$i++) { if ($arg eq $hash->{perlblock}{$i}) { DOIF_block ($hash,$i); last; } } } #return "unknown argument $arg for $pn, choose one of disable:noArg initialize:noArg enable:noArg cmd $setList"; } } $hs=$cur_hs; return $ret; } sub DOIF_Get($@) { my ($hash, @a) = @_; my $pn = $a[0]; return "$pn: get needs at least one parameter" if(@a < 2); my $arg= $a[1]; if( $arg eq "html" ) { return DOIF_RegisterEvalAll($hash,$pn,"uiTable"); } return undef; } package DOIF; #use Date::Parse qw(str2time); use Time::HiRes qw(gettimeofday); sub DOIF_ExecTimer { my ($timer)=@_; my $hash=${$timer}->{hash}; my $timername=${$timer}->{name}; my $name=$hash->{NAME}; my $subname=${$timer}->{subname}; my $count=${$timer}->{count}; my $condition=${$timer}->{cond}; my $param=${$timer}->{param} if (defined ${$timer}->{param}); my $cur_hs=$hs; $hs=$hash; delete ($::defs{$name}{READINGS}{"timer_$timername"}); if (defined ($condition) and !eval ($condition)) { $hs=$cur_hs; return (0); } if (!defined ($param)) { eval ("package DOIF;$subname"); } else { eval('package DOIF;no strict "refs";&{$subname}($param);use strict "refs"'); } if ($@) { ::Log3 ($hash->{NAME},1 , "$name error in $subname: $@"); ::readingsSingleUpdate ($hash, "error", "in $subname: $@",1); } if (defined ($condition)) { $count=++${$timer}->{count}; if (!eval ($condition)) { $hs=$cur_hs; return (0); } } else { $hs=$cur_hs; return (0); } my $current = ::gettimeofday(); my $seconds=eval (${$timer}->{sec}); my $next_time = $current+$seconds; ${$timer}->{time}=$next_time; if ($seconds > 0) { if (defined ($condition)) { ::readingsSingleUpdate ($hs,"timer_$timername",::strftime("%d.%m.%Y %H:%M:%S",localtime($next_time))." $count",0); } else { ::readingsSingleUpdate ($hs,"timer_$timername",::strftime("%d.%m.%Y %H:%M:%S",localtime($next_time)),0); } } ::InternalTimer($next_time, "DOIF::DOIF_ExecTimer",$timer, 0); $hs=$cur_hs; return(0); } sub set_Exec { my ($timername,$sec,$subname,$param4,$param5)=@_; my $count=0; my $hash=$hs; if (defined $param5) { $hs->{ptimer}{$timername}{cond}=$param5; $hs->{ptimer}{$timername}{param}=$param4; } elsif (defined $param4) { if (!ref($param4)) { $hs->{ptimer}{$timername}{cond}=$param4; } else { $hs->{ptimer}{$timername}{param}=$param4; } } $hs->{ptimer}{$timername}{sec}=$sec; $hs->{ptimer}{$timername}{name}=$timername; $hs->{ptimer}{$timername}{subname}=$subname; $hs->{ptimer}{$timername}{count}=$count; $hs->{ptimer}{$timername}{hash}=$hs; ::RemoveInternalTimer(\$hs->{ptimer}{$timername}); if (defined ($hs->{ptimer}{$timername}{cond})) { my $cond=eval ($hs->{ptimer}{$timername}{cond}); if ($@) { ::Log3 ($hs->{NAME},1,"$hs->{NAME} error eval condition: $@"); ::readingsSingleUpdate ($hs, "error", "eval condition: $@",1); return (1); } if (!$cond) { return (0); } } my $seconds=eval($sec); if ($@) { ::Log3 ($hs->{NAME},1,"$hs->{NAME} error eval seconds: $@"); ::readingsSingleUpdate ($hs, "error", "eval seconds : $@",1); return(1); } my $current = ::gettimeofday(); my $next_time = $current+$seconds; $hs->{ptimer}{$timername}{time}=$next_time; if ($seconds > 0) { if (defined ($hs->{ptimer}{$timername}{cond})) { ::readingsSingleUpdate ($hs,"timer_$timername",::strftime("%d.%m.%Y %H:%M:%S",localtime($next_time))." $count",0); } else { ::readingsSingleUpdate ($hs,"timer_$timername",::strftime("%d.%m.%Y %H:%M:%S",localtime($next_time)),0); } } ::InternalTimer($next_time, "DOIF::DOIF_ExecTimer",\$hs->{ptimer}{$timername}, 0); } sub get_Exec { my ($timername)=@_; my $current = ::gettimeofday(); if (defined $hs->{ptimer}{$timername}{time}) { my $sec=$hs->{ptimer}{$timername}{time}-$current; if ($sec > 0) { return ($sec); } else { delete ($hs->{ptimer}{$timername}{time}); return (0); } } else { return (0); } } sub del_Exec { my ($timername)=@_; ::RemoveInternalTimer(\$hs->{ptimer}{$timername}); delete $hs->{ptimer}{$timername}; delete ($::defs{$hs->{NAME}}{READINGS}{"timer_$timername"}); } sub set_Event { my ($event)=@_; ::DoTrigger($hs->{NAME}, $event); } sub set_State { my ($content,$trigger)=@_; if (defined $trigger) { return(::readingsSingleUpdate($hs,"state",$content,$trigger)); } else { return(::readingsSingleUpdate($hs,"state",$content,1)); } } sub set_Reading { my ($reading,$content,$trigger)=@_; if (defined $trigger) { return(::readingsSingleUpdate($hs,$reading,$content,$trigger)); } else { return(::readingsSingleUpdate($hs,$reading,$content,0)); } } sub set_Reading_Begin { return(::readingsBeginUpdate ($hs)); } sub set_Reading_Update ($$@) { my ($reading,$value,$changed)= @_; return(::readingsBulkUpdate($hs, $reading, $value,$changed)); } sub set_Reading_End { my ($trigger)=@_; return(::readingsEndUpdate($hs,$trigger)); } sub get_State { my ($default)=@_; if (defined $default) { return(::ReadingsVal($hs->{NAME},"state",$default)); } else { return(::ReadingsVal($hs->{NAME},"state","")); } } sub get_Reading { my ($reading,$default)=@_; if (defined $default) { return(::ReadingsVal($hs->{NAME},$reading,$default)); } else { return(::ReadingsVal($hs->{NAME},$reading,"")); } } sub fhem_set { my ($content)=@_; return(::CommandSet(undef,$content)); } sub fhem ($@){ my ($param, $silent) = @_; return(::fhem($param, $silent)); } sub Log { my ($loglevel, $text) = @_; return(::Log3(undef, $loglevel, $text)); } sub Log3 { my ($dev, $loglevel, $text) = @_; return(::Log3($dev, $loglevel, $text)); } sub InternalVal { my ($d,$n,$default) = @_; return(::InternalVal($d,$n,$default)); } sub InternalNum { my ($d,$n,$default,$round) = @_; return(::InternalNum($d,$n,$default,$round)); } sub OldReadingsVal { my ($d,$n,$default) = @_; return(::OldReadingsVal($d,$n,$default)); } sub OldReadingsNum { my ($d,$n,$default,$round) = @_; return(::OldReadingsNum($d,$n,$default,$round)); } sub OldReadingsTimestamp { my ($d,$n,$default) = @_; return(::OldReadingsTimestamp($d,$n,$default)); } sub ReadingsVal { my ($device,$reading,$default)=@_; return(::ReadingsVal($device,$reading,$default)); } sub ReadingsNum { my ($d,$n,$default,$round) = @_; return(::ReadingsNum($d,$n,$default,$round)); } sub ReadingsTimestamp { my ($d,$n,$default) = @_; return(::ReadingsTimestamp($d,$n,$default)); } sub ReadingsAge { my ($device,$reading,$default) = @_; return(::ReadingsAge($device,$reading,$default)); } sub Value($) { my ($d) = @_; return(::Value($d)); } sub OldValue { my ($d) = @_; return(::OldValue($d)); } sub OldTimestamp { my ($d) = @_; return(::OldTimestamp($d)); } sub AttrVal { my ($d,$n,$default) = @_; return(::AttrVal($d,$n,$default)); } sub AttrNum { my ($d,$n,$default,$round) = @_; return (::AttrNum($d,$n,$default,$round)); } package ui_Table; sub FW_makeImage { my ($image) = @_; return (::FW_makeImage($image)); } #Styles sub temp { my ($temp,$size,$icon)=@_; return((defined($icon) ? ::FW_makeImage($icon):"").$temp." °C","font-weight:bold;".(defined ($size) ? "font-size:".$size."pt;":"").ui_Table::temp_style($temp)); } sub temp_style { my ($temp)=@_; if ($temp >=30) { return ("color:".::DOIF_hsv ($temp,30,50,20,0,90,95)); } elsif ($temp >= 10) { return ("color:".::DOIF_hsv ($temp,10,30,73,20,80,95)); } elsif ($temp >= 0) { return ("color:".::DOIF_hsv ($temp,0,10,211,73,60,95)); } elsif ($temp >= -20) { return ("color:".::DOIF_hsv ($temp,-20,0,277,211,50,95)); } } sub hum { my ($hum,$size,$icon)=@_; return ((defined($icon) ? ::FW_makeImage($icon):"").$hum." %","font-weight:bold;".(defined ($size) ? "font-size:".$size."pt;":"")."color:".::DOIF_hsv ($hum,30,100,30,260,60,90)); } sub style { my ($text,$color,$font_size,$font_weight)=@_; my $style=""; $style.="color:$color;" if (defined ($color)); $style.="font-size:$font_size"."pt;" if (defined ($font_size)); $style.="font-weight:$font_weight;" if (defined ($font_weight)); return ('
'.$text.'
'); #return ($text,$style); } # Widgets sub widget { my ($value,$widget,$set)=@_; $set="" if (!defined $set); return ($value,"",$widget,$set) } sub temp_knob { my ($value,$color,$set)=@_; $color="DarkOrange" if (!defined $color); $set="set" if (!defined $set); return ($value,"","knob,min:15,max:27,width:40,height:35,step:0.5,fgColor:$color,bgcolor:grey,anglearc:270,angleOffset:225,cursor:15,thickness:.3",$set) } sub shutter { my ($value,$color,$type,$coloroff)=@_; $color="\@darkorange" if (!defined ($color) or $color eq ""); $coloroff="" if (!defined ($coloroff)); if (!defined ($type) or $type == 3) { return ($value,"","iconRadio,$color,100,fts_shutter_10$coloroff,30,fts_shutter_70$coloroff,0,fts_shutter_100$coloroff","set"); } elsif ($type == 4) { return ($value,"","iconRadio,$color,100,fts_shutter_10$coloroff,50,fts_shutter_50$coloroff,30,fts_shutter_70$coloroff,0,fts_shutter_100$coloroff","set"); } elsif ($type == 5) { return ($value,"","iconRadio,$color,100,fts_shutter_10$coloroff,70,fts_shutter_30$coloroff,50,fts_shutter_50$coloroff,30,fts_shutter_70,0,fts_shutter_100$coloroff","set"); } elsif ($type >= 6) { return ($value,"","iconRadio,$color,100,fts_shutter_10$coloroff,70,fts_shutter_30$coloroff,50,fts_shutter_50$coloroff,30,fts_shutter_70$coloroff,20,fts_shutter_80$coloroff,0,fts_shutter_100$coloroff","set"); } elsif ($type == 2) { return ($value,"","iconRadio,$color,100,fts_shutter_10$coloroff,0,fts_shutter_100$coloroff","set"); } } sub dimmer { my ($value,$color,$type)=@_; $color="\@darkorange" if (!defined ($color) or $color eq ""); if (!defined ($type) or $type == 3) { return ($value,"","iconRadio,$color,0,light_light_dim_00,50,light_light_dim_50,100,light_light_dim_100","set"); } elsif ($type == 4) { return ($value,"","iconRadio,$color,0,light_light_dim_00,50,light_light_dim_50,70,light_light_dim_70,100,light_light_dim_100","set"); } elsif ($type == 5) { return ($value,"","iconRadio,$color,0,light_light_dim_00,30,light_light_dim_30,50,light_light_dim_50,70,light_light_dim_70,100,light_light_dim_100","set"); } elsif ($type == 6) { return ($value,"","iconRadio,$color,0,light_light_dim_00,30,light_light_dim_30,50,light_light_dim_50,70,light_light_dim_70,80,light_light_dim_80,100,light_light_dim_100","set"); } elsif ($type >= 7) { return ($value,"","iconRadio,$color,0,light_light_dim_00,20,light_light_dim_20,30,light_light_dim_30,50,light_light_dim_50,70,light_light_dim_70,80,light_light_dim_80,100,light_light_dim_100","set"); } elsif ($type == 2) { return ($value,"","iconRadio,$color,0,light_light_dim_00,100,light_light_dim_100","set"); } } sub switch { my ($value,$icon_off,$icon_on,$state_off,$state_on)=@_; $state_on=(defined ($state_on) and $state_on ne "") ? $state_on : "on"; $state_off=(defined ($state_off) and $state_off ne "") ? $state_off : "off"; my $i_off=(defined ($icon_off) and $icon_off ne "") ? $icon_off : "off"; $icon_on=((defined ($icon_on) and $icon_on ne "") ? $icon_on :(defined ($icon_off) and $icon_off ne "") ? "$icon_off\@DarkOrange" : "on"); return($value,"",("iconSwitch,".$state_on.",".$i_off.",".$state_off.",".$icon_on)); } sub ICON { my ($icon)=@_; ::FW_makeImage($icon); } sub icon { my ($value,$icon_off,$icon_on,$state_off,$state_on)=@_; $state_on=(defined ($state_on) and $state_on ne "") ? $state_on : "on"; $state_off=(defined ($state_off) and $state_off ne "") ? $state_off : "off"; my $i_off=(defined ($icon_off) and $icon_off ne "") ? $icon_off : "off"; $icon_on=((defined ($icon_on) and $icon_on ne "") ? $icon_on :(defined ($icon_off) and $icon_off ne "") ? "$icon_off\@DarkOrange" : "on"); return($value,"",("iconLabel,".$state_on.",".$icon_on.",".$state_off.",".$i_off)); } sub icon_label { my ($icon,$text,$color,$color_bg,$pos_left,$pos_top) = @_; $color = "" if (!defined ($color)); $color_bg = "" if (!defined ($color_bg)); $pos_left = -3 if (!defined ($pos_left)); $pos_top = -8 if (!defined ($pos_top)); my $pad = (length($text) > 1) ? 2 : 5; return '
'.::FW_makeImage($icon).'
'.$text.'
' } sub hsv { return(::DOIF_hsv(@_)); } sub temp_hue { #temp->hue #-20->270 #-10->240 #0 ->180 #10 ->120 #20 ->60 #40 ->0 #70 ->340 my($temp)=@_; my $hue; if ($temp < -10) { $hue=-3*$temp+210; } elsif ($temp < 20) { $hue=-6*$temp+180; } elsif ($temp < 40) { $hue=-3*$temp+120; } else { $hue = -2/3*$temp+386; } return (int($hue)); } sub m_n { my ($x1,$y1,$x2,$y2) =@_; my $m=($y2-$y1)/($x2-$x1); my $y=$y1-$m*$x1; return($m,$y); } sub hum_hue { my($hum)=@_; my $hue; my $m; my $n; if ($hum > 60) { ($m,$n)=m_n(60,180,100,260); } elsif ($hum > 40) { ($m,$n)=m_n(40,60,60,180); } else { ($m,$n)=m_n(0,40,40,60); } $hue = $m*$hum+$n; return (int($hue)); } sub format_value { my ($val,$min,$dec)=@_; my $format; my $value=$val; if ($val eq "") { $val="N/A"; $format='%s'; $value=$min; } elsif ($val =~ /(-?\d+(\.\d+)?)/) { $format='%1.'.$dec.'f'; $value=$1; $val=$value; } else { $format='%s'; $value=$min; } return($format,$value,$val); } sub get_color { my ($value,$min,$max,$minColor,$maxColor,$func)=@_; my $color; if (!defined $value or $value eq "N/A" or $value < $min ) { $value = $min; } elsif ($value > $max) { $value = $max; } if (ref($func) eq "CODE") { $minColor=&{$func}($min); $maxColor=&{$func}($max); $color=&{$func}($value); } elsif (ref($func) eq "ARRAY") { $minColor=${$func}[1]; $maxColor=${$func}[-1]; for (my $i=0;$i<@{$func};$i+=2) { if ($value <= ${$func}[$i]) { $color=${$func}[$i+1]; last; } } } else { $minColor=120 if (!defined $minColor); $maxColor=0 if (!defined $maxColor); my $prop=0; $prop=($value-$min)/($max-$min) if ($max-$min); if ($minColor < $maxColor) { $color=$prop*($maxColor-$minColor)+$minColor; } else { $color=(1-$prop)*($minColor-$maxColor)+$maxColor; } } return(int($color),$minColor,$maxColor); } sub card { my ($collect,$header,$icon,$min,$max,$minColor,$maxColor,$unit,$func,$decfont,$prop,$model,$lightness) = @_; if (!defined ${$collect}{hours}) { return(""); } my $val=${$collect}{value}; my $a=@{$collect}{values}; my $maxVal = ${$collect}{max_value}; my $maxValTime = ${$collect}{max_value_time}; my $maxValSlot = ${$collect}{max_value_slot}; my $last_value=${$collect}{last_value}; my $minVal = ${$collect}{min_value}; my $minValTime = ${$collect}{min_value_time}; my $minValSlot = ${$collect}{min_value_slot}; my $hours = ${$collect}{hours}; my $time = ${$collect}{time}; my $bwidth=160; my $bheight=88; my $htrans=0; my $dim=${$collect}{dim}; my $out; my ($ic,$iscale,$ix,$iy,$rotate); my ($size,$plot,$steps,$noFooter,$noColor); ($size,$plot,$steps,$noFooter,$noColor)=split (/,/,$prop) if (defined $prop); $plot = "" if (!defined $plot); $steps = "" if (!defined $steps); $noFooter = "" if (!defined $noFooter); $noColor = "" if (!defined $noColor); my ($dec,$fontformat,$unitformat); ($dec,$fontformat,$unitformat)=split (/,/,$decfont) if (defined $decfont); $fontformat="" if (!defined $fontformat); $unitformat="" if (!defined $unitformat); my ($header_txt,$header_style); ($header_txt,$header_style)=split (/,/,$header) if (defined $header); $header_style="" if (!defined $header_style); my ($format,$value); my ($lr,$lir,$lmm,$lu,$ln,$li); ($lr,$lir,$lmm,$lu,$ln,$li)=split (/,/,$lightness) if (defined $lightness); $unit="" if (!defined $unit); if (defined $header) { $htrans = 24; $bheight += 24; } if ($noFooter) { $bheight-=15; } $min=0 if (!defined $min); $max=100 if (!defined $max); $dec=1 if (!defined $dec); ($format,$value,$val)=format_value($val,$min,$dec); $minVal=$value if (!defined $minVal); $maxVal=$value if (!defined $maxVal); ##if (defined $last_value) { ## if ($last_value> $maxVal) { ## $maxVal=$last_value; ## } elsif ($last_value < $minVal) { ## $minVal=$last_value; ## } ##} ##$value=$max if($value>$max); ##$value=$min if ($value<$min); $size=130 if (!defined $size or $size eq ""); my ($maxValColor)=get_color($maxVal,$min,$max,$minColor,$maxColor,$func); my ($minValColor)=get_color($minVal,$min,$max,$minColor,$maxColor,$func); if (defined ($icon)) { ($ic,$iscale,$ix,$iy,$rotate)=split(",",$icon); $rotate=0 if (!defined $rotate); $iscale=1 if (!defined $iscale); $ic="" if (!defined($ic)); } my $svg_width=int($size/100*$bwidth); my $svg_height=int($size/100*$bheight); my $xpos; my $nullColor; my $nullProp; my $topVal; my $topOpacity; my $bottomVal; my $bottomOpacity; my $nullOpacity; my $minPlot; my $maxPlot; my $scaling=0; if ($plot ne "1" and $minVal ne $maxVal) { $scaling=1; $minPlot=($value < $minVal ? $value : $minVal); $maxPlot=($value > $maxVal ? $value : $maxVal); } else { my $minimum=(($value<$min and $value<$minVal) ? $value:($min<$minVal) ? $min:$minVal); my $maximum=(($value>$max and $value>$maxVal) ? $value:($max>$maxVal) ? $max:$maxVal); $minPlot=(($min < 0 and $minVal > 0) ? 0 : $minimum); $maxPlot=(($max > 0 and $maxVal < 0) ? 0 : $maximum); } my ($m,$n)=m_n($minPlot,0,$maxPlot,50); my $currColor; ($currColor,$minColor,$maxColor)=get_color($value,$min,$max,$minColor,$maxColor,$func); if ($minPlot < 0 and $maxPlot > 0) { $xpos=50-int($n*10)/10; $topVal=($maxVal > 0 ? $maxVal : 0); $bottomVal=($minVal < 0 ? $minVal : 0); ($nullColor)=get_color(0,$min,$max,$minColor,$maxColor,$func); $nullProp=int ($topVal/($topVal-$bottomVal)*100)/100 if ($bottomVal<0 and $topVal>0); $topOpacity=($topVal==0 ? 0 : 0.25); $bottomOpacity=($bottomVal==0 ? 0: 0.25); $nullOpacity=0.0; } elsif ($maxPlot <= 0) { $xpos=0; $topVal=$maxPlot; $topOpacity=0.0; $bottomOpacity=0.25; $bottomVal=$minVal; } else { $xpos=50; $topVal=$maxVal; $topOpacity=0.25; $bottomOpacity=0.0; $bottomVal=$minPlot; } $ic="$ic\@".color($currColor,$ln) if (defined($icon) and $icon !~ /@/); my ($topValColor)=get_color($topVal,$min,$max,$minColor,$maxColor,$func); my ($bottomValColor)=get_color($bottomVal,$min,$max,$minColor,$maxColor,$func); $out.= sprintf ('',$bwidth,$bheight,$svg_width,$svg_height,$svg_width,$svg_height); $out.= ''; $out.= ''; $out.= sprintf('',$topValColor,$bottomValColor,(defined $lr ? $lr:0)); for (my $i=0; $i<=1;$i+=0.10) { my ($color)=get_color(($topVal-$bottomVal)*(1-$i)+$bottomVal,$min,$max,$minColor,$maxColor,$func); $out.= sprintf('',$i,color($color,$lr)); } $out.= ''; $out.= sprintf('',$topValColor,$bottomValColor,(defined $lr ? $lr:0)); $out.= sprintf('',color($topValColor,$lr),$topOpacity); $out.= sprintf('',$nullProp,color($nullColor,$lr),$nullOpacity) if (defined $nullProp); $out.= sprintf('',color($bottomValColor,$lr),$bottomOpacity); $out.= ''; $out.= sprintf('',$bwidth-2,$bheight); if (defined $header) { $out.= sprintf('%s',$header_style,$header_txt); if (defined $icon and $icon ne "" and $icon ne " ") { my $svg_icon=::FW_makeImage($ic); if(!($svg_icon =~ s/\sheight="[^"]*"/ height="18"/)) { $svg_icon =~ s/svg/svg height="18"/ } if(!($svg_icon =~ s/\swidth="[^"]*"/ width="18"/)) { $svg_icon =~ s/svg/svg width="18"/ } $out.=''; $out.= $svg_icon; $out.=''; } $out.=''; } $out.= sprintf('',$htrans); $out.='' if (!$noFooter); $out.= sprintf('',$dim+44); $out.= ''; my $points=""; my $v; my $last; $out.= ''; for (my $i=1;$i<4;$i++) { my $y=$i*12.5; $out.=sprintf('',$y,$dim,$y); } for (my $i=0;$i<=4;$i++) { my $v=($maxPlot-$minPlot)*(1-$i*0.25)+$minPlot; my ($color)= get_color($v,$min,$max,$minColor,$maxColor,$func); $out.= sprintf('%s',$i*12.5+2,$noColor ? "#CCCCCC":color($color,$lmm),"",sprintf($format,$v)); } my $timebeginn=$time-$hours*3600; my $scale; my $strokes; my $div = $hours > 168 ? ($hours % 168 == 0 ? 168 : ($hours % 24 == 0 ? 24 : 1)):1; if ($div==168 and $hours/$div/2 == 1) { #2w $scale=$hours/7; $strokes=7; } elsif ($hours <= 168*7) { for (my $i=7;$i>=3;$i--) { if ($hours/$div % $i == 0) { $scale=$hours/$i; $strokes=$i; last; } } } if (defined $scale) { my ($sec,$minutes,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($timebeginn); my $beginhour=int($hour/$scale)*$scale; my $diffminutes=($hour-$beginhour)*60+$minutes; my $pos=int ($diffminutes/($scale*60)*1000)/100; ## $out.=sprintf('%02d',$beginhour) if ($pos == 0); for (my $i=0;$i<$strokes;$i++) { my $h=$beginhour+($i+1)*$scale; $hour=($h >= 24 ? $h % 24:$h); my $x=int(($i*($dim/$strokes)-$pos+9)*10)/10; $out.=sprintf('',$x,0,$x,50) if ($x >= 0); if ($hour == 0) { if ($hours <= 168) { $out.=sprintf('%s',$x,substr(::strftime("%a",localtime($timebeginn+$h*3600)),0,2)); } else { $out.=sprintf('%s',$x,::strftime("%d.",localtime($timebeginn+$h*3600))); } } else { $out.=sprintf('%02d:',$x,$hour); } } } else { for (my $i=0;$i<2;$i++) { my $x=int((($i+1)*($dim/3)-1)*10)/10; $out.=sprintf('',$x,0,$x,50); } for (my $i=0;$i<=3;$i++) { my $x=int(($i*($dim/3)-1)*10)/10; if ($hours <=168) { $out.=sprintf('%s',$x,::strftime("%H:%M",localtime($time-$hours*3600*(1-$i/3)))); } elsif ($hours <=168*7 and $hours % 24 == 0) { $out.=sprintf('%s',$x,::strftime("%d.%H:",localtime($time-$hours*3600*(1-$i/3)))); } else { $out.=sprintf('%s',$x,::strftime("%d.%m",localtime($time-$hours*3600*(1-$i/3)))); } } } my $j=0; if (@{$a} > 0) { if (!defined ${$a}[0]) { if (defined $last_value) { $v=$last_value; } else { for ($j=0;$j<@{$a};$j++) { if (defined ${$a}[$j]) { $v=${$a}[$j]; last; } } } } else { $v=${$a}[0]; } $points.="$j,$xpos "; $last=(50-int(($v*$m+$n)*10)/10); $points.="$j,".$last." "; $j++; for (my $i=$j;$i<@{$a};$i++) { if (defined ${$a}[$i]) { $points.="$i,".$last." " if (!defined ${$a}[$i-1] or $steps eq "1"); $last=(50-int((${$a}[$i]*$m+$n)*10)/10); $points.="$i,".$last." "; } } $points.=$dim.",".$last." " if ($steps eq "1"); $points.=$dim.",".(50-int(($val*$m+$n)*10)/10)." "; $out.=sprintf('',$topValColor,$bottomValColor,(defined $lr ? $lr:0),$topValColor,$bottomValColor,(defined $lr ? $lr:0)); } $out.=sprintf('',$xpos,$dim,$xpos); $out.=sprintf('',$maxValSlot,(50-int((${$a}[$maxValSlot]*$m+$n)*10)/10),color($maxValColor,$ln)) if (defined $maxValSlot); $out.=sprintf(',',$minValSlot,(50-int((${$a}[$minValSlot]*$m+$n)*10)/10),color($minValColor,$ln)) if (defined $minValSlot); $out.=sprintf(' ',$dim,(50-int(($value*$m+$n)*10)/10),color($currColor,$ln)); $out.= ''; $out.= ''; $out.=sprintf('',$dim+39); $out.= ui_Table::ring($val,$min,$max,$minColor,$maxColor,$unit,92,$func,$decfont,$model,$lightness,undef,(defined $header or !defined $icon) ? undef: $icon); $out.=''; $out.=sprintf('%s',::strftime("%H:%M:%S",localtime($time))); if ($noFooter ne "1") { if (defined $maxValTime) { if ($hours > 168) { $out.= sprintf('▲%s',::strftime("%d.%m %H:%M",localtime($maxValTime))); } else { $out.= sprintf('▲%s',::strftime("%a %H:%M",localtime($maxValTime))); } $out.= sprintf('%s',color($maxValColor,$lmm),"",sprintf($format,${$collect}{max_value})); } if (defined $minValTime) { if ($hours > 168) { $out.= sprintf('•▼%s',::strftime("%d.%m %H:%M",localtime($minValTime))); } else { $out.= sprintf('•▼%s',::strftime("%a %H:%M",localtime($minValTime))); } $out.= sprintf('%s',color($minValColor,$lmm),"",sprintf($format,${$collect}{min_value})); } } $out.=''; $out.= ''; return ($out); } sub bar { my ($val,$min,$max,$header,$minColor,$maxColor,$unit,$bwidth,$bheight,$size,$func,$decfont,$model,$lr,$ln,$icon) = @_; my $out; my $trans=0; my ($format,$value); my ($ic,$iscale,$ix,$iy,$rotate); my $minCol=$minColor; my $ypos; my ($dec,$fontformat,$unitformat); ($dec,$fontformat,$unitformat)=split (/,/,$decfont) if (defined $decfont); $fontformat="" if (!defined $fontformat); $unitformat="" if (!defined $unitformat); if (defined $lr) { if (!defined $ln) { $ln=$lr; } } $unit="" if (!defined $unit); if (!defined $bheight) { if (defined ($icon)) { $bheight=75; } else { $bheight=60; } } my $height=$bheight-10; if (!defined $header or $header eq "") { $trans = -1; } else { $bwidth= 63 if (!defined $bwidth); $trans = 14; $bheight += 14; } $bwidth=63 if (!defined $bwidth); $min=0 if (!defined $min); $max=100 if (!defined $max); $dec=1 if (!defined $dec); $ypos= (defined ($icon) and $bheight >= 75) ? int($height/2-3):int($height/2+3); ($format,$value,$val)=format_value($val,$min,$dec); if (defined $func) { $minColor=&{$func}($min); $maxColor=&{$func}($max); } else { $minColor=120 if (!defined $minColor); $maxColor=0 if (!defined $maxColor); } $minCol=$minColor; $value=$max if($value>$max); $value=$min if ($value<$min); $size=100 if (!defined $size); my $prop=($value-$min)/($max-$min); my $val1=int($prop*$height+0.5); my $y=$height+6-$val1; my $currColor; if (defined $func) { if (defined($model)) { $minColor=&{$func}($value); } $currColor=&{$func}($value); } else { if ($minColor < $maxColor) { $currColor=$prop*($maxColor-$minColor)+$minColor; } else { $currColor=(1-$prop)*($minColor-$maxColor)+$maxColor; } if (defined($model)) { $minColor=$currColor; } } if (defined ($icon)) { ($ic,$iscale,$ix,$iy,$rotate)=split(",",$icon); if (defined ($ix)) { $ix+=$bwidth/2+3; } else { $ix=$bwidth/2+3; }; if (defined ($iy)) { $iy+=($ypos-14); } else { $iy=($ypos-14); }; $rotate=0 if (!defined $rotate); $iscale=1 if (!defined $iscale); $ic="" if (!defined($ic)); } my $svg_width=int($size/100*$bwidth); my $svg_height=int($size/100*$bheight); $out.= sprintf ('',$bwidth,$bheight,$svg_width,$svg_height,$svg_width,$svg_height); $out.= ''; $out.= ''; $out.= ''; $out.= ''; $out.= sprintf('',$currColor,$minColor,(defined $lr ? $lr:-1),color($currColor,$lr),color($minColor,$lr)); $out.= ''; $out.= sprintf('',$bwidth-3,$bheight); $out.= sprintf('%s',$bwidth/2+10,$header) if (defined $header and $header ne ""); $out.= sprintf('',$trans); my $nullColor; my $null; if ($min < 0 and $max > 0) { $null=$max/($max-$min)*$height+7 if ($min <0); if (defined $func) { $nullColor=&{$func}(0); } else { if ($minColor < $maxColor) { $nullColor=-$min/($max-$min)*($maxColor-$minColor); } else { $nullColor=(1+$min/($max-$min))*($minColor-$maxColor); } } } $ic="$ic\@".color($currColor,$ln) if (defined($icon) and $icon !~ /@/); $out.= sprintf('%s',color($maxColor,$ln),sprintf($format,$max)); $out.= sprintf('%s',$height+9,color($minCol,$ln),sprintf($format,$min)); $out.= sprintf('',$y,$val1,$currColor,$minColor,(defined $lr ? $lr:-1)); $out.= sprintf('',$height); $out.= sprintf('',$null,$null) if ($min < 0 and $max > 0);; if (defined $icon and $icon ne "" and $icon ne " ") { my $svg_icon=::FW_makeImage($ic); if(!($svg_icon =~ s/\sheight="[^"]*"/ height="22"/)) { $svg_icon =~ s/svg/svg height="22"/ } if(!($svg_icon =~ s/\swidth="[^"]*"/ width="22"/)) { $svg_icon =~ s/svg/svg width="22"/ } $out.=''; $out.= $svg_icon; $out.=''; } my ($valInt,$valDec)=split(/\./,sprintf($format,$val)); if ($bheight>=75 or !defined ($icon) and $bheight >= 50) { if (defined $valDec) { $out.= sprintf('%s.%s', $bwidth/2+15,(defined ($icon) ? $ypos+24:$ypos+5),color($currColor,$ln),$fontformat,$valInt,$valDec); $out.= sprintf('%s', $bwidth/2+15,(defined ($icon) ? $ypos+35:$ypos+16),color($currColor,$ln),$unitformat,$unit); } else { $out.= sprintf('%s', $bwidth/2+15,(defined ($icon) ? $ypos+24:$ypos+5),color($currColor,$ln),$fontformat,$valInt); $out.= sprintf('%s', $bwidth/2+15,(defined ($icon) ? $ypos+35:$ypos+16),color($currColor,$ln),$unitformat,$unit); } } else { if (defined $valDec) { $out.= sprintf('%s.%s%s', $bwidth/2+15,(defined ($icon) ? $height/2+25:$height/2+12),color($currColor,$ln),$fontformat,$valInt,$valDec,$unitformat,$unit); } else { $out.= sprintf('%s%s', $bwidth/2+15,(defined ($icon) ? $height/2+25:$height/2+12),color($currColor,$ln),$fontformat,$valInt,$unitformat,$unit); } } $out.= ''; $out.= ''; return ($out); } sub temp_bar { my ($value,$min,$max,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $min=-20 if (!defined $min or $min eq ""); $max=60 if (!defined $max or $max eq ""); $decfont=1 if (!defined $decfont); return(bar($value,$min,$max,$header,undef,undef,"°C",$width,$height,$size,\&temp_hue,$decfont,undef,$lightbar,$lightnumber)); } sub temp_mbar { my ($value,$min,$max,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $min=-20 if (!defined $min or $min eq ""); $max=60 if (!defined $max or $max eq ""); $decfont=1 if (!defined $decfont); return(bar($value,$min,$max,$header,undef,undef,"°C",$width,$height,$size,\&temp_hue,$decfont,1,$lightbar,$lightnumber)); } sub icon_temp_bar { my ($icon,$value,$min,$max,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $min=-20 if (!defined $min or $min eq ""); $max=60 if (!defined $max or $max eq ""); $decfont=1 if (!defined $decfont); return(bar($value,$min,$max,$header,undef,undef,"°C",$width,$height,$size,\&temp_hue,$decfont,undef,$lightbar,$lightnumber,$icon)); } sub icon_temp_mbar { my ($icon,$value,$min,$max,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $min=-20 if (!defined $min or $min eq ""); $max=60 if (!defined $max or $max eq ""); $decfont=1 if (!defined $decfont); return(bar($value,$min,$max,$header,undef,undef,"°C",$width,$height,$size,\&temp_hue,$decfont,1,$lightbar,$lightnumber,$icon)); } sub hum_bar { my ($value,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $decfont=0 if (!defined $decfont); return(bar($value,0,100,$header,undef,undef,"%",$width,$height,$size,\&hum_hue,$decfont,undef,$lightbar,$lightnumber)); } sub hum_mbar { my ($value,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $decfont=0 if (!defined $decfont); return(bar($value,0,100,$header,undef,undef,"%",$width,$height,$size,\&hum_hue,$decfont,1,$lightbar,$lightnumber)); } sub icon_hum_bar { my ($icon,$value,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $decfont=0 if (!defined $decfont); return(bar($value,0,100,$header,undef,undef,"%",$width,$height,$size,\&hum_hue,$decfont,undef,$lightbar,$lightnumber,$icon)); } sub icon_hum_mbar { my ($icon,$value,$header,$width,$height,$size,$lightbar,$lightnumber,$decfont) = @_; $decfont=0 if (!defined $decfont); return(bar($value,0,100,$header,undef,undef,"%",$width,$height,$size,\&hum_hue,$decfont,1,$lightbar,$lightnumber,$icon)); } sub icon_bar { my ($icon,$val,$min,$max,$minColor,$maxColor,$unit,$dec,$header,$bwidth,$bheight,$size,$func,$lr,$ln) = @_; return (bar($val,$min,$max,$header,$minColor,$maxColor,$unit,$bwidth,$bheight,$size,$func,$dec,undef,$lr,$ln,$icon)); } sub icon_mbar { my ($icon,$val,$min,$max,$minColor,$maxColor,$unit,$dec,$header,$bwidth,$bheight,$size,$func,$lr,$ln) = @_; return (bar($val,$min,$max,$header,$minColor,$maxColor,$unit,$bwidth,$bheight,$size,$func,$dec,1,$lr,$ln,$icon)); } sub polarToCartesian { my ($centerX,$centerY,$radius,$angleInDegrees)=@_; my $angleInRadians = ($angleInDegrees-230) * ::pi() / 180.0; my $x= sprintf('%1.2f',$centerX + ($radius * cos($angleInRadians))); my $y= sprintf('%1.2f',$centerY + ($radius * sin($angleInRadians))); return($x,$y); } sub describeArc { my ($x, $y, $radius, $startAngle, $endAngle)=@_; my ($start_x,$start_y) = polarToCartesian($x, $y, $radius, $endAngle); my ($end_x,$end_y) = polarToCartesian($x, $y, $radius, $startAngle); my $largeArcFlag = $endAngle - $startAngle <= 180 ? "0" : "1"; return (''); } sub color { my ($hue,$lightness)=@_; if (substr($hue,0,1) eq "#") { return ($hue); } my $l; my $diff; if (defined $lightness and $lightness ne "") { $diff=$lightness-50; } else { $diff=0; } if ($hue>180 and $hue<290) { $l=70+$diff; } else { $l=50+$diff; } return ("hsl($hue,100%,".$l."%)"); } sub temp_uring { my ($value,$min,$max,$size,$type,$lightring,$lightnumber,$icon,$decfont) = @_; $min=-20 if (!defined $min); $max=60 if (!defined $max); $size=85 if (!defined $size); $decfont=1 if (!defined $decfont); return(ring($value,$min,$max,undef,undef,"°C",$size,\&temp_hue,$decfont,$type,$lightring,$lightnumber,$icon)); } sub temp_ring{ my ($value,$min,$max,$size,$lightring,$lightnumber,$decfont) = @_; return(temp_uring($value,$min,$max,$size,undef,$lightring,$lightnumber,undef,$decfont)); } sub temp_mring{ my ($value,$min,$max,$size,$lightring,$lightnumber,$decfont) = @_; return(temp_uring($value,$min,$max,$size,1,$lightring,$lightnumber,undef,$decfont)); } sub icon_temp_ring{ my ($icon,$value,$min,$max,$size,$lightring,$lightnumber,$decfont) = @_; $size=100 if (!defined $size); return(temp_uring($value,$min,$max,$size,undef,$lightring,$lightnumber,$icon,$decfont)); } sub icon_temp_mring{ my ($icon,$value,$min,$max,$size,$lightring,$lightnumber,$decfont) = @_; $size=100 if (!defined $size); return(temp_uring($value,$min,$max,$size,1,$lightring,$lightnumber,$icon,$decfont)); } sub hum_uring { my ($value,$size,$type,$lightring,$lightnumber,$icon,$decfont) = @_; $size=85 if (!defined $size); $decfont=0 if (!defined $decfont); return(ring($value,0,100,undef,undef,"%",$size,\&hum_hue,$decfont,$type,$lightring,$lightnumber,$icon)); } sub hum_ring{ my ($value,$size,$lightring,$lightnumber,$decfont) = @_; return(hum_uring($value,$size,undef,$lightring,$lightnumber,undef,$decfont)); } sub hum_mring{ my ($value,$size,$lightring,$lightnumber,$decfont) = @_; return(hum_uring($value,$size,1,$lightring,$lightnumber,undef,$decfont)); } sub icon_hum_ring{ my ($icon,$value,$size,$lightring,$lightnumber,$decfont) = @_; $size=100 if (!defined $size); return(hum_uring($value,$size,undef,$lightring,$lightnumber,$icon,$decfont)); } sub icon_hum_mring{ my ($icon,$value,$size,$lightring,$lightnumber,$decfont) = @_; $size=100 if (!defined $size); return(hum_uring($value,$size,1,$lightring,$lightnumber,$icon,$decfont)); } sub temp_hum_ring { my ($value,$value2,$min,$max,$size,$lightring,$lightnumber,$decfont1,$decfont2) = @_; $min=-20 if (!defined $min); $max=60 if (!defined $max); $size=90 if (!defined $size); $decfont1=1 if (!defined $decfont1); $decfont2=0 if (!defined $decfont2); return(ring2($value,$min,$max,undef,undef,"°C",$size,\&temp_hue,$decfont1,$value2,0,100,0,0,"%",\&hum_hue,$decfont2,$lightring,$lightnumber)); } sub temp_temp_ring { my ($value,$value2,$min,$max,$size,$lightring,$lightnumber,$decfont1,$decfont2) = @_; $min=-20 if (!defined $min); $max=60 if (!defined $max); $size=90 if (!defined $size); $decfont1=1 if (!defined $decfont1); $decfont2=1 if (!defined $decfont2); return(ring2($value,$min,$max,undef,undef,"°C",$size,\&temp_hue,$decfont1,$value2,$min,$max,undef,undef,"°C",\&temp_hue,$decfont2,$lightring,$lightnumber)); } sub icon_ring { my ($icon,$val,$min,$max,$minColor,$maxColor,$unit,$decfont,$size,$func,$lr,$ln,$mode) = @_; return(ring ($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$mode,$lr,$ln,$icon)); } sub icon_mring { my ($icon,$val,$min,$max,$minColor,$maxColor,$unit,$decfont,$size,$func,$lr,$ln) = @_; return(ring ($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,1,$lr,$ln,$icon,$icon)); } sub icon_uring { my ($mode,$icon,$val,$min,$max,$minColor,$maxColor,$unit,$decfont,$size,$func,$lr,$ln) = @_; return(ring ($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$mode,$lr,$ln,$icon)); } sub mring { my ($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$lr,$ln) = @_; return(ring($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,1,$lr,$ln)); } sub uring { my ($mode,$val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$lr,$ln) = @_; return(ring($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$mode,$lr,$ln)); } sub icon_ring2 { my ($icon,$val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$dec,$val2,$min2,$max2,$minColor2,$maxColor2,$unit2,$func2,$dec2,$lr,$ln) = @_; return (ring2($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$dec,$val2,$min2,$max2,$minColor2,$maxColor2,$unit2,$func2,$dec2,$lr,$ln,$icon)); } sub icon_temp_hum_ring { my ($icon,$value,$value2,$min,$max,$size,$lightring,$lightnumber,$decfont1,$decfont2) = @_; $min=-20 if (!defined $min); $max=60 if (!defined $max); $size=100 if (!defined $size); $decfont1=1 if (!defined $decfont1); $decfont2=0 if (!defined $decfont2); return(ring2($value,$min,$max,undef,undef,"°C",$size,\&temp_hue,$decfont1,$value2,0,100,0,0,"%",\&hum_hue,$decfont2,$lightring,$lightnumber,$icon)); } sub icon_temp_temp_ring { my ($icon,$value,$value2,$min,$max,$size,$lightring,$lightnumber,$decfont1,$decfont2) = @_; $min=-20 if (!defined $min); $max=60 if (!defined $max); $size=100 if (!defined $size); $decfont1=1 if (!defined $decfont1); $decfont2=1 if (!defined $decfont2); return(ring2($value,$min,$max,undef,undef,"°C",$size,\&temp_hue,$decfont1,$value2,$min,$max,undef,undef,"°C",\&temp_hue,$decfont2,$lightring,$lightnumber,$icon)); } sub ring { my ($val,$min,$max,$minColor,$maxColor,$unit,$sizeHalf,$func,$decfont,$mode,$lightness,$lnum,$icon) = @_; my $out; my ($size,$half); ($size,$half)=split (/,/,$sizeHalf) if (defined $sizeHalf); $size=100 if (!defined $size or $size eq ""); $half="" if (!defined $half); my ($monochrom,$minMax,$innerRing,$pointer); ($monochrom,$minMax,$innerRing,$pointer)=split (/,/,$mode) if (defined $mode); my ($dec,$fontformat,$unitformat); ($dec,$fontformat,$unitformat)=split (/,/,$decfont) if (defined $decfont); $fontformat="" if (!defined $fontformat); $unitformat="" if (!defined $unitformat); my ($ic,$iscale,$ix,$iy,$rotate)=(); if (defined ($icon)) { ($ic,$iscale,$ix,$iy,$rotate)=split(/,/,$icon); if (defined ($ix)) { $ix+=32; } else { $ix=32; }; if (defined ($iy)) { $iy+=8.5; } else { $iy=8.5; }; $rotate=0 if (!defined $rotate); $iscale=1 if (!defined $iscale); $ic="" if (!defined($ic)); } my ($format,$value); my ($lr,$lir,$lmm,$lu,$ln,$li); ($lr,$lir,$lmm,$lu,$ln,$li)=split (/,/,$lightness) if (defined $lightness); $lr=50 if (!defined $lr or $lr eq ""); $lir=40 if (!defined $lir or $lir eq ""); $lmm=40 if (!defined $lmm or $lmm eq ""); $lu=40 if (!defined $lu or $lu eq ""); $ln=50 if (!defined $ln or $ln eq ""); $li=40 if (!defined $li or $li eq ""); $ln=$lnum if (defined $lnum); $min=0 if (!defined $min); $max=100 if (!defined $max); $dec=1 if (!defined $dec); ($format,$value,$val)=format_value($val,$min,$dec); $value=$max if ($value>$max); $value=$min if ($value<$min); my $prop=0; $prop=($value-$min)/($max-$min) if ($max-$min); my ($x1,$y1,$x2,$y2); ($x1,$y1,$x2,$y2)=(int($prop*100),0,0,int((1-$prop)*100)); my $currColor; if (ref($func) eq "CODE") { $minColor=&{$func}($min); $maxColor=&{$func}($max); $currColor=&{$func}($value); } elsif (ref($func) eq "ARRAY") { $minColor=${$func}[1]; $maxColor=${$func}[-1]; for (my $i=0;$i<@{$func};$i+=2) { if ($value <= ${$func}[$i]) { $currColor=${$func}[$i+1]; last; } } } else { $minColor=120 if (!defined $minColor); $maxColor=0 if (!defined $maxColor); if ($minColor < $maxColor) { $currColor=$prop*($maxColor-$minColor)+$minColor; } else { $currColor=(1-$prop)*($minColor-$maxColor)+$maxColor; } } my $minCol=$minColor; if (defined $monochrom and $monochrom==1) { $minColor=$currColor; } if (defined $icon and $icon ne "") { $ic="$ic\@".color($currColor,$li) if ($ic !~ /@/); } my ($div,$maxArc,$minArc,$yNum,$yUnit,$high); if ($half eq "1") { $div=2; $maxArc=230; $minArc=50; $yNum=27; $yUnit=14; $high=29; } else { $div=1; $maxArc=280; $minArc=0; $yNum=34; $yUnit=47; $high=58; } my $width=int($size/100*63); my $height=int($size/100*58); $out.= sprintf('',$high,$width,$height/$div,$width,$height/$div); $out.= ''; $out.= ''; if (!defined $pointer) { $out.= sprintf('\ ',$currColor,$minColor,(defined $lr ? $lr:0),$x1,$y1,$x2,$y2,color($currColor,$lr),color($minColor,$lr)); } if (defined $innerRing and $innerRing and ref($func) ne "ARRAY") { $out.= sprintf('\ ',$minCol,$maxColor,(defined $lir ? $lir:0),100,0,0,0,color($maxColor,$lir),color($minCol,$lir)); } $out.= '\ '; $out.=''; $out.=''; $out.=''; $out.=describeArc(41, 30, 28, $minArc, $maxArc); $out.=''; if (defined $pointer) { $out.=''; $out.=describeArc(41, 30, 28, int(($prop*($maxArc-$minArc)+$minArc-$pointer/2)*10)/10, int(($prop*($maxArc-$minArc)+$minArc+$pointer/2)*10)/10); } else { $out.=sprintf('',$currColor,$minColor,(defined $lr ? $lr:0)); $out.=describeArc(41, 30, 28, $minArc, int(($prop*($maxArc-$minArc)+$minArc)*10)/10); } $out.=''; if (defined $innerRing and $innerRing) { if (ref($func) eq "ARRAY"){ my $from=$minArc; my $diff=$max-$min; for (my $i=0;$i<@{$func};$i+=2) { my $curr=${$func}[$i]; my $color=${$func}[$i+1]; my $to=int((($curr-$min)/$diff*($maxArc-$minArc)+$minArc)*10)/10; $out.=sprintf('',color($color,$lir),($innerRing eq "1" ? "":$innerRing)); $out.=describeArc(41, 30, 25.5, $from, $to); $out.=''; $from=$to+2; } } else { $out.=''; $out.=sprintf('',$minCol,$maxColor,(defined $lir ? $lir:0),($innerRing eq "1" ? "":$innerRing)); $out.=describeArc(41, 30, 25.5, $minArc, $maxArc); $out.=''; } } if (defined $icon and $icon ne "" and $icon ne " ") { my $svg_icon=::FW_makeImage($ic); if(!($svg_icon =~ s/\sheight="[^"]*"/ height="18"/)) { $svg_icon =~ s/svg/svg height="18"/ } if(!($svg_icon =~ s/\swidth="[^"]*"/ width="18"/)) { $svg_icon =~ s/svg/svg width="18"/ } $out.=''; $out.= $svg_icon; $out.=''; } my $icflag = (defined ($icon) and $icon ne "") ? 1:0; my ($valInt,$valDec)=split(/\./,sprintf($format,$val)); if (defined $valDec) { $out.= sprintf('%s.%s', ($icflag ? 41:$yNum),color($currColor,$ln),(defined $icon or $half eq "1") ? 15:18,$fontformat,$valInt,$valDec); } else { $out.= sprintf('%s', ($icflag ? 41:$yNum),color($currColor,$ln),(defined $icon or $half eq "1") ? 15:18,$fontformat,$valInt); } $out.= sprintf('%s', ($icflag ? 50.5:$yUnit),color($currColor,$lu),($icflag or $half eq "1") ? 8:10,$unitformat,$unit) if (defined $unit); if (defined $minMax and $minMax) { $out.= sprintf('%s',color($minCol,$lmm),($minMax eq "1" ? "":$minMax),$min); $out.= sprintf('%s',color($maxColor,$lmm),($minMax eq "1" ? "":$minMax),$max); } $out.= ''; return ($out); } sub ring2 { ## my ($mode,$icon,$size,$valA,$minMaxA,$minMaxColorA,$unitA,$decfontA,$lightness) = @_; my ($val,$min,$max,$minColor,$maxColor,$unit,$size,$func,$decfont,$val2,$min2,$max2,$minColor2,$maxColor2,$unit2,$func2,$decfont2,$lightness,$lnum,$icon) = @_; my $out; my ($format,$value); my ($format2,$value2); my ($dec,$fontformat,$unitformat); ($dec,$fontformat,$unitformat)=split (/,/,$decfont) if (defined $decfont); $fontformat="" if (!defined $fontformat); $unitformat="" if (!defined $unitformat); my ($dec2,$fontformat2,$unitformat2); ($dec2,$fontformat2,$unitformat2)=split (/,/,$decfont2) if (defined $decfont2); $fontformat2="" if (!defined $fontformat2); $unitformat2="" if (!defined $unitformat2); my ($ic,$iscale,$ix,$iy,$rotate)=(); if (defined ($icon)) { ($ic,$iscale,$ix,$iy,$rotate)=split(",",$icon); if (defined ($ix)) { $ix+=20; } else { $ix=20; }; if (defined ($iy)) { $iy+=23; } else { $iy=23; }; $rotate=0 if (!defined $rotate); $iscale=1 if (!defined $iscale); $ic="" if (!defined($ic)); } my ($lr,$lir,$lmm,$lu,$ln,$li); ($lr,$lu,$ln,$li)=split (/,/,$lightness) if (defined $lightness); $lr=50 if (!defined $lr or $lr eq ""); $lu=40 if (!defined $lu or $lu eq ""); $ln=50 if (!defined $ln or $ln eq ""); $li=40 if (!defined $li or $li eq ""); $ln=$lnum if (defined $lnum); $min=0 if (!defined $min); $max=100 if (!defined $max); $dec=1 if (!defined $dec); ($format,$value,$val)=format_value($val,$min,$dec); if (defined $func) { $minColor=&{$func}($min); $maxColor=&{$func}($max); } else { $minColor=120 if (!defined $minColor); $maxColor=0 if (!defined $maxColor); } $value=$max if($value>$max); $value=$min if ($value<$min); $size=100 if (!defined $size); my $prop=0; $prop=($value-$min)/($max-$min) if ($max-$min); my ($x1,$y1,$x2,$y2)=($prop*100,0,0,(1-$prop)*100); my $currColor; if (defined $func) { $currColor=&{$func}($value); } else { if ($minColor < $maxColor) { $currColor=$prop*($maxColor-$minColor)+$minColor; } else { $currColor=(1-$prop)*($minColor-$maxColor)+$maxColor; } } $min2=0 if (!defined $min2); $max2=100 if (!defined $max2); $dec2=1 if (!defined $dec2); ($format2,$value2,$val2)=format_value($val2,$min2,$dec2); if (defined $func2) { $minColor2=&{$func2}($min2); $maxColor2=&{$func2}($max2); } else { $minColor2=120 if (!defined $minColor2); $maxColor2=0 if (!defined $maxColor2); } $value2=$max2 if($value2>$max2); $value2=$min2 if ($value2<$min2); my $prop2=0; $prop2=($value2-$min2)/($max2-$min2) if ($max2-$min2); my ($x12,$y12,$x22,$y22); ($x12,$y12,$x22,$y22)=($prop2*100,0,0,(1-$prop2)*100); my $currColor2; if (defined $func2) { $currColor2=&{$func2}($value2); } else { if ($minColor2 < $maxColor2) { $currColor2=$prop2*($maxColor2-$minColor2)+$minColor2; } else { $currColor2=(1-$prop2)*($minColor2-$maxColor2)+$maxColor2; } } if (defined $icon and $icon ne "") { if ($ic !~ /@/) { $ic="$ic\@".color($currColor,$li); } elsif ($ic =~ /^(.*\@)colorVal1/) { $ic="$1".color($currColor,$li); } elsif ($ic =~ /^(.*\@)colorVal2/) { $ic="$1".color($currColor2,$li); } } my $width=int($size/100*63); my $height=int($size/100*58); $out.= sprintf('',$width,$height,$width,$height); $out.= ''; $out.= ''; $out.= sprintf('\ ',$currColor,$minColor,(defined $lr ? $lr:0),$x1,$y1,$x2,$y2,color($currColor,$lr),color($currColor,$lr)); $out.= sprintf('\ ',$currColor2,$minColor2,(defined $lr ? $lr:0),$x12,$y12,$x22,$y22,color($currColor2,$lr),color($currColor2,$lr)); $out.= '\ '; $out.=''; $out.=''; $out.=''; $out.=describeArc(41, 30, 28, 0, 280); $out.=''; $out.=sprintf('',$currColor,$minColor,(defined $lr ? $lr:0)); $out.=describeArc(41, 30, 28.2, 0, int($prop*280)); $out.=''; if (defined $icon and $icon ne "" and $icon ne " ") { my $svg_icon=::FW_makeImage($ic); if(!($svg_icon =~ s/\sheight="[^"]*"/ height="15"/)) { $svg_icon =~ s/svg/svg height="15"/ } if(!($svg_icon =~ s/\swidth="[^"]*"/ width="15"/)) { $svg_icon =~ s/svg/svg width="15"/ } $out.=''; $out.= $svg_icon; $out.=''; } $out.=sprintf('',$currColor2,$minColor2,(defined $lr ? $lr:0)); $out.=describeArc(41, 30, 25.5, 0, int($prop2*280)); $out.=''; my ($valInt,$valDec)=split(/\./,sprintf($format,$val)); my $icflag = (defined ($icon) and $icon ne "") ? 1:0; if (defined $valDec) { $out.= sprintf('%s.%s', ($icflag ? 50:41),color($currColor,$ln),(defined ($icon) ? 13:14),$fontformat,$valInt,$valDec); } else { $out.= sprintf('%s', ($icflag ? 50:41),color($currColor,$ln),(defined ($icon) ? 13:14),$fontformat,$valInt); } $out.= sprintf('%s',color($currColor,$lu),$unitformat,$unit) if (defined $unit); my ($valInt2,$valDec2)=split(/\./,sprintf($format2,$val2)); if (defined $valDec2) { $out.= sprintf('%s.%s', ($icflag ? 50:41),($icflag ? 41:42.5),color($currColor2,$ln),(defined ($icon) ? 12:13),$fontformat2,$valInt2,$valDec2); } else { $out.= sprintf('%s', ($icflag ? 50:41),($icflag ? 41:42.5),color($currColor2,$ln),(defined ($icon) ? 12:13),$fontformat2,$valInt2); } $out.= sprintf('%s',($icflag ? 50:52),color($currColor2,$lu),$unitformat2,$unit2) if (defined $unit2); $out.= ''; return ($out); } sub dec { my ($format,$value)=@_; return(split(/\./,sprintf($format,$value))); } sub y_h { my ($value,$min,$max,$height,$mode) = @_; my $offset=4.5; $offset=0 if (defined $mode); if ($value > $max) { $value=$max; } elsif ($value < $min) { $value=$min; } if ($min > 0 and $max > 0) { $max-=$min; $value-=$min; $min=0; } elsif ($min < 0 and $max < 0) { $min-=$max; $value-=$max; $max=0; } my $prop=$value/($max-$min); my $h=int(abs($prop*($height))+$offset); my $y; my $null; $null=$max/($max-$min)*$height; if ($value <= 0) { $y=$null; } else { $y=int($null+$offset-$h); } $null=undef if ($max == 0 or $min == 0); return ($y,$h,$null); } sub hsl_color { my ($color,$corr_light)=@_; my ($hue,$sat,$light)=split(/\./,$color); $sat=100 if (!defined $sat); $light=50 if (!defined $light); $light+=$corr_light if (defined $corr_light); $light=0 if ($light < 0); $light=100 if ($light > 100); return("hsl($hue,$sat%,$light%)"); } sub cylinder_bars { my ($header,$min,$max,$unit,$bwidth,$height,$size,$dec,@values) = @_; return(cylinder_mode ($header,$min,$max,$unit,$bwidth,$height,$size,$dec,1,@values)); } sub cylinder { my ($header,$min,$max,$unit,$bwidth,$height,$size,$dec,@values) = @_; return(cylinder_mode ($header,$min,$max,$unit,$bwidth,$height,$size,$dec,undef,@values)); } sub cylinder_mode { my ($header,$min,$max,$unit,$bwidth,$height,$size,$dec,$mode,@values) = @_; my $out; my $ybegin; my $bheight; my $trans=0; my $heightval=10; $size=100 if (!defined $size or $size eq ""); $dec=1 if (!defined $dec); my $format='%1.'.$dec.'f'; my $heightcal=10+@values*10; if (!defined $height or $height eq "") { if (@values/3 > 4) { $heightval=5; $height=10+@values*5; } else { $height=$heightcal; } } else { if ($height < $heightcal) { $heightval=5; } } if (!defined $header or $header eq "") { $trans=5; $bheight=$height-26; } else { $trans=22; $bheight=$height-10; } my $width=30; my $heightoffset=4; if (defined $mode) { $width=7; } if (!defined $bwidth or $bwidth eq "") { my $lenmax=0; for (my $i=0;$i<@values;$i+=3){ $values[$i+2]="" if (!defined $values[$i+2]); $lenmax=length($values[$i+2]) if (length($values[$i+2]) > $lenmax); } if (defined $mode) { $bwidth=@values/3*($width+2)+60+$lenmax*4.3; } else { $bwidth=90+$lenmax*4.3; } if ($heightval==5) { $bwidth=$bwidth*1.3; } } my ($y,$val1,$null); my $svg_width=int($size/100*$bwidth); my $svg_height=int($size/100*($bheight+40)); $out.= sprintf ('',$bwidth,$bheight+40,$svg_width,$svg_height,$svg_width,$svg_height); $out.= ''; $out.= ''; $out.= ''; for (my $i=0;$i<@values;$i+=3){ my $color=$values[$i+1]; $out.= sprintf('',$color,hsl_color($color),hsl_color($color)); } $out.= ''; $out.= ''; $out.= ''; $out.= sprintf('',$bwidth-2, $bheight+40); $out.= sprintf('%s',$bwidth/2+11,$header) if ($header ne ""); $out.= sprintf('',$trans); if (defined $mode) { $out.= sprintf('',!defined $mode ? $width:@values/3*($width+2)+2,$height+$heightoffset+2); } else { $out.= sprintf('',!defined $mode ? $width:@values/3*($width+2)+2,$height+$heightoffset); $out.= sprintf('',$height,$width); $out.= sprintf('',$width); } ($y,$val1,$null)=y_h(0,$min,$max,$height); my $xLeft=15; my $xBegin=$xLeft+33; $xBegin=@values/3*($width+2)+20 if(defined $mode); $out.= sprintf('%s',$xBegin,$height+$heightoffset+1,$min); $out.= sprintf('%s',$xBegin,$null+$heightoffset+2,0) if (defined $null); $out.= sprintf('%s',$xBegin,+$heightoffset,$max); my $yBegin=13+($height-@values*$heightval)/2; my $xValue=$xLeft; for (my $i=0;$i<@values;$i+=3){ my $yValue=$yBegin+$heightval-1; my $value=$values[$i]; my $val=$value; if (defined $mode) { $xValue=$xLeft+$i/3*($width+2)+2 if (defined $mode); } if (!defined $value or $value eq "") { $val="N/A"; $value=0; } my $color=$values[$i+1]; my $text=$values[$i+2]; ($y,$val1,$null)=y_h($value,$min,$max,$height,$mode); if (!defined $mode) { $out.= sprintf('',$xValue,$y,$width,$val1,$color); $out.= sprintf('',$xValue,$y,$width,$color);#,hsl_color($color,0)); ## $out.= sprintf('',$xValue,$y,$width,$val1,$color); } else { $out.= sprintf('',$xValue,$y+2,$width,$val1+2,$color); } if (defined $text and $text ne "") { $out.= sprintf('%s',$xBegin+10,$yBegin+$i*$heightval,hsl_color($color),$text.":"); if ($heightval == 10) { $yValue+=7; } else { $yValue-=4; } } $out.= sprintf('%s%s',$bwidth+5, $yValue+$i*$heightval,hsl_color ($color),($val eq "N/A" ? $val:sprintf($format,$val)),$unit); } $out.= ''; $out.= ''; return ($out); } 1; =pod =item helper =item summary universal module, it works event- and time-controlled =item summary_DE universelles Modul, welches ereignis- und zeitgesteuert Anweisungen ausführt =begin html

DOIF

=end html =begin html_DE

DOIF

=end html_DE =cut