#!/usr/bin/perl ################################################################################# # Copyright notice # # (c) 2008-2012 # Copyright: Dr. Olaf Droegehorn # All rights reserved # # This script 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. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # A copy is found in the textfile GPL.txt and important notices to the license # from the author is found in LICENSE.txt distributed with these scripts. # # This script 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. # # This copyright notice MUST APPEAR in all copies of the script! ################################################################################# #Note: use warnings/-w is deadly on some linux devices (e.g.WL500GX) use strict; use warnings; use POSIX; use Time::HiRes qw(gettimeofday); use CGI; use IO::Socket; ################### # Config my $addr = "localhost:7072"; # FHZ server my $absicondir = "/home/httpd/icons"; # Copy your icons here my $relicondir = "/icons"; my $gnuplotdir = "/usr/local/FHEM"; # the .gplot filees live here (should be the FHEM dir, as FHEMRENDERER needs them there) my $fhemwebdir = "/home/httpd/cgi-bin"; # the fhemweb.pl & style.css files live here my $faq = "/home/httpd/cgi-bin/faq.html"; my $howto = "/home/httpd/cgi-bin/HOWTO.html"; my $doc = "/home/httpd/cgi-bin/commandref.html"; my $tmpfile = "/tmp/pgm5-"; # the Images will be rendered there with beginning of name my $configfile = "/etc/fhem.conf"; # the fhem.conf file is that my $plotmode = "gnuplot"; # Current plotmode my $plotsize = "800,200"; # Size for a plot my $renderer = "pgm5_renderer"; # Name of suitable renderer my $rendrefresh= "00:15:00"; # Refresh Interval for the Renderer my $render_before = 1; # Render graphics before drawing my $render_after = 0; # Render graphics after drawing # Nothing to config below ######################### ######################### # Forward declaration sub checkDirs(); sub digestCgi(); sub doDetail($); sub fhemcmd($); sub fileList($); sub makeTable($$$$$$$$); sub parseXmlList($); sub showRoom(); sub showArchive($); sub showLog($); sub showLogWrapper($); sub roomOverview($); sub style($$); sub fatal($); sub zoomLink($$$$); sub calcWeblink($$); sub makeEdit($$$$); ######################### # Global variables; my $me = $ENV{SCRIPT_NAME}; my %icons; # List of icons my $iconsread; # Timestamp of last icondir check my %rooms; # hash of all rooms my %devs; # hash of all devices ant their attributes my %types; # device types, for sorting my $room; # currently selected room my $detail; # durrently selected device for detail view my $title; # Page title my $cmdret; # Returned data by the fhem call my $scrolledweblinkcount; # Number of scrolled weblinks my %pos; # scroll position my $RET; # Returned data (html) my $RETTYPE; # image/png or the like my $SF; # Short for submit form my $ti; # Tabindex for all input fields my @zoom; # "qday", "day","week","month","year" my %zoom; # the same as @zoom my $wname; # Web instance name my $data; # Filecontent from browser when editing a file my $lastxmllist; # last time xmllist was parsed my $renderer_status; # Status of the Renderer my ($lt, $ltstr); ############### # Initialize internal structures my $n = 0; @zoom = ("qday", "day","week","month","year"); %zoom = map { $_, $n++ } @zoom; open(FH, "$fhemwebdir/style.css") || fatal("$fhemwebdir/style.css: $!"); # Read in the template Stylesheet file my $css = join("", ); close(FH); $me = "" if(!$me); my $q = new CGI; $ti = 1; ################## # Lets go: my ($cmd,$debug) = digestCgi(); my $docmd = 0; $docmd = 1 if($cmd && $cmd !~ /^showlog/ && $cmd !~ /^toweblink/ && $cmd !~ /^showarchive/ && $cmd !~ /^style / && $cmd !~ /^edit/); $cmdret = fhemcmd($cmd) if($docmd); parseXmlList($docmd); if($cmd =~ m/^showlog /) { showLog($cmd); exit (0); } if($cmd =~ m/^toweblink (.*)$/) { my @aa = split(":", $1); my $max = 0; for my $d (keys %devs) { $max = ($1+1) if($d =~ m/^wl_(\d+)$/ && $1 >= $max); } $devs{$aa[0]}{INT}{currentlogfile}{VAL} =~ m,([^/]*)$,; $aa[2] = "CURRENT" if($1 eq $aa[2]); $cmdret = fhemcmd("define wl_$max weblink fileplot $aa[0]:$aa[1]:$aa[2]"); if(!$cmdret) { $detail = "wl_$max"; parseXmlList($docmd); } } print $q->header; print $q->start_html(-name=>$title, -title=>$title, -style=>{ -code=>$css }); if($cmdret) { $detail = ""; $room = ""; $cmdret =~ s//>/g; print "
\n"; print "
$cmdret
\n"; print "
\n"; } roomOverview($cmd); style($cmd,undef) if($cmd =~ m/^style /); doDetail($detail) if($detail); showRoom() if($room && !$detail); showLogWrapper($cmd) if($cmd =~ /^showlogwrapper/); showArchive($cmd) if($cmd =~ m/^showarchive/); print $q->end_html; exit(0); ################### sub fhemcmd($) { my $p = shift; my $server = IO::Socket::INET->new(PeerAddr => $addr); if(!$server) { print $q->h3("Can't connect to the server on $addr"); print $q->end_html; return 0; } syswrite($server, "$p; quit\n"); my ($lst, $buf) = ("", ""); while(sysread($server, $buf, 2048) > 0) { $lst .= $buf; } close($server); return $lst; } ########################### # Digest CGI parameters sub digestCgi() { my (%arg, %val, %dev); my ($cmd, $debug, $c) = ("","",""); foreach my $p ($q->param) { my $v = $q->param($p); $debug .= "$p : $v
\n"; if($p eq "detail") { $detail = $v; } if($p eq "room") { $room = $v; } if($p eq "cmd") { $cmd = $v; delete($q->{$p}); } if($p =~ m/^arg\.(.*)$/) { $arg{$1} = $v; } if($p =~ m/^val\.(.*)$/) { $val{$1} = $v; } if($p =~ m/^dev\.(.*)$/) { $dev{$1} = $v; } if($p =~ m/^cmd\.(.*)$/) { $cmd = $v; $c= $1; delete($q->{$p}); } if($p eq "pos") { %pos = split(/[=]/, $v); } if($p eq "data") { $data = $v; } } $cmd.=" $dev{$c}" if($dev{$c}); $cmd.=" $arg{$c}" if($arg{$c}); $cmd.=" $val{$c}" if($val{$c}); return ($cmd, $debug); } ##################### # Get the data and parse it. We are parsing XML in a non-scientific way :-) sub parseXmlList($) { my $docmd = shift; my $name; if(!$docmd && $lastxmllist && (time() - $lastxmllist) < 2) { $room = $devs{$detail}{ATTR}{room}{VAL} if($detail); return; } $lastxmllist = time(); %rooms = (); %devs = (); %types = (); $title = ""; foreach my $l (split("\n", fhemcmd("xmllist"))) { ####### Device if($l =~ m/^\t\t<(.*) name="(.*)" state="(.*)" sets="(.*)" attrs="(.*)">/){ $name = $2; $devs{$name}{type} = ($1 eq "HMS" ? "KS300" : $1); $devs{$name}{state} = $3; $devs{$name}{sets} = $4; $devs{$name}{attrs} = $5; next; } ####### INT, ATTR & STATE if($l =~ m,^\t\t\t<(.*) key="(.*)" value="([^"]*)"(.*)/>,) { my ($t, $n, $v, $m) = ($1, $2, $3, $4); #### NEW ###### $v =~ s,<br>,
,g; $devs{$name}{$t}{$n}{VAL} = $v; if($m) { $m =~ m/measured="(.*)"/; $devs{$name}{$t}{$n}{TIM} = $1; } if($t eq "ATTR" && $n eq "room") { $rooms{$v}{$name} = 1; if($name eq "global") { $rooms{$v}{LogFile} = 1; $devs{LogFile}{ATTR}{room}{VAL} = $v; } } if($name eq "global" && $n eq "logfile") { my $ln = "LogFile"; $devs{$ln}{type} = "FileLog"; $devs{$ln}{INT}{logfile}{VAL} = $v; $devs{$ln}{state} = "active"; } } } if(defined($devs{global}{ATTR}{archivedir})) { $devs{LogFile}{ATTR}{archivedir}{VAL} = $devs{global}{ATTR}{archivedir}{VAL}; } ################# #Tag the gadgets without room with "Unsorted" if(%rooms) { foreach my $name (keys %devs ) { if(!$devs{$name}{ATTR}{room}) { $devs{$name}{ATTR}{room}{VAL} = "Unsorted"; $rooms{Unsorted}{$name} = 1; } } } ############### # Needed for type sorting foreach my $d (sort keys %devs ) { $types{$devs{$d}{type}} = 1; } $title = $devs{global}{ATTR}{title}{VAL} ? $devs{global}{ATTR}{title}{VAL} : "HOME Management"; $room = $devs{$detail}{ATTR}{room}{VAL} if($detail); } ############################## sub makeTable($$$$$$$$) { my($d,$t,$header,$hash,$clist,$ccmd,$makelink,$cmd) = (@_); return if(!$hash && !$clist); $t = "EM" if($t =~ m/^EM.*$/); # EMWZ,EMEM,etc. print " \n"; # Header print " "; foreach my $h (split(",", $header)) { print ""; } print "\n"; if($clist) { print "\n"; my @al = map { s/[:;].*//;$_ } split(" ", $clist); print ""; print ""; print ""; print $q->hidden("dev.$ccmd$d", $d); print "", $row?"odd":"even"); $row = ($row+1)%2; if($makelink && $doc) { print ""; } else { print ""; } if($v eq "DEF") { makeEdit($d, $t, "modify", $hash->{$v}{VAL}); } else { print ""; } print "" if($hash->{$v}{TIM}); print "" if($cmd); print "\n"; } print "
$h
" . $q->popup_menu(-name=>"arg.$ccmd$d", -value=>\@al) . "" . $q->textfield(-name=>"val.$ccmd$d", -size=>6) . "" . $q->submit(-name=>"cmd.$ccmd$d", -value=>$ccmd) . "
\n"; } my $row = 1; foreach my $v (sort keys %{$hash}) { printf("
$v$v$hash->{$v}{VAL}$hash->{$v}{TIM}$cmd
\n"; print "
\n"; } ############################## sub showArchive($) { my ($arg) = @_; my (undef, $d) = split(" ", $arg); my $fn = $devs{$d}{INT}{logfile}{VAL}; if($fn =~ m,^(.+)/([^/]+)$,) { $fn = $2; } $fn = $devs{$d}{ATTR}{archivedir}{VAL} . "/" . $fn; my $t = $devs{$d}{type}; print "
\n"; print "
\n"; print "", $row?"odd":"even"); $row = ($row+1)%2; if(!defined($l)) { print(""); } else { foreach my $ln (split(",", $l->{VAL})) { my ($lt, $name) = split(":", $ln); $name = $lt if(!$name); print(""); } } print ""; } print "
\n"; my $row = 0; my $l = $devs{$d}{ATTR}{logtype}; foreach my $f (fileList($fn)) { printf("
$ftext$name
\n"; print "
\n"; print "
\n"; } ############################## sub doDetail($) { my ($d) = @_; print $q->start_form; print $q->hidden("detail", $d); $room = $devs{$d}{ATTR}{room}{VAL} if($devs{$d}{ATTR}{room}); my $t = $devs{$d}{type}; print "
\n"; print "
\n"; print "Delete $d\n"; my $pgm = "Javascript:" . "s=document.getElementById('edit').style;". "if(s.display=='none') s.display='block'; else s.display='none';". "s=document.getElementById('disp').style;". "if(s.display=='none') s.display='block'; else s.display='none';"; print "Modify $d"; print "
\n"; makeTable($d, $t, "State,Value,Measured", $devs{$d}{STATE}, $devs{$d}{sets}, "set", 0, undef); makeTable($d, $t, "Internal,Value", $devs{$d}{INT}, "", undef, 0, undef); makeTable($d, $t, "Attribute,Value,Action", $devs{$d}{ATTR}, $devs{$d}{attrs}, "attr", 1, $d eq "global" ? "" : "deleteattr"); print "
\n"; print "
\n"; print $q->end_form; } ############## # Room overview sub roomOverview($) { my ($cmd) = @_; print $q->start_form; print "
\n"; print "
"; print "Cmd: "; print $q->textfield(-name=>"cmd", -size=>30); $scrolledweblinkcount = 0; if($room) { print $q->hidden(-name=>"room", -value=>"$room"); if(!$detail) { # Global navigation buttons for weblink >= 2 calcWeblink(undef,undef); if($scrolledweblinkcount) { print ""; print "  "; zoomLink("zoom=-1", "Zoom-in.png", "zoom in", 0); zoomLink("zoom=1", "Zoom-out.png","zoom out", 0); zoomLink("off=-1", "Prev.png", "prev", 0); zoomLink("off=1", "Next.png", "next", 0); } } } print "
"; print "
\n"; print "
\n"; print " \n"; print " \n"; print "
\n"; # Need for "right" compatibility print " \n"; $room = "" if(!$room); foreach my $r (sort keys %rooms) { next if($r eq "hidden"); printf(" ", $r eq $room ? " class=\"sel\"" : ""); print "\n"; } printf(" ", "all" eq $room ? " class=\"sel\"" : ""); print ""; print " \n"; print "
$r"; print "
All together
\n"; print "
\n"; print " \n"; print " \n"; print " \n"; print " \n"; my $sel = ($cmd =~ m/examples/) ? " class=\"sel\"" : ""; print " \n"; $sel = ($cmd =~ m/list/) ? " class=\"sel\"" : ""; print " \n"; print "
Howto
FAQ
Details
Examples
Edit files
\n"; print "
\n"; print "
\n"; print $q->end_form; } ################# # Read in the icons sub checkDirs() { return if($iconsread && (time() - $iconsread) < 5); %icons = (); if(opendir(DH, $absicondir)) { while(my $l = readdir(DH)) { next if($l =~ m/^\./); my $x = $l; $x =~ s/\.[^.]+$//; # Cut .gif/.jpg $icons{$x} = $l; } closedir(DH); } $iconsread = time(); } ######################## # Generate the html output: i.e present the data sub showRoom() { checkDirs(); my $havelookedforrenderer; print $q->start_form; print "
\n"; print " \n
\n"; # Need for equal width of subtables foreach my $type (sort keys %types) { ################# # Filter the devices in the room if($room && $room ne "all") { my $havedev; foreach my $d (sort keys %devs ) { next if($devs{$d}{type} ne $type); next if(!$rooms{$room}{$d}); $havedev = 1; last; } next if(!$havedev); } my $rf = ($room ? "&room=$room" : ""); ############################ # Print the table headers my $t = $type; $t = "EM" if($t =~ m/^EM.*$/); if (!(($t eq "FS20") || ($t eq "IT") || ($t eq "FHT") || ($t eq "FileLog") || ($t eq "at") || ($t eq "notify") || ($t eq "KS300") || ($t eq "FHZ") || ($t eq "FHEMWEB") || ($t eq "EM") || ($t eq "FHEMRENDERER") || ($t eq "weblink"))) { $t = "_internal_"; } print " \n"; if($type eq "FS20") { print " "; print ""; print "\n"; } if($type eq "IT") { print " "; print ""; print "\n"; } if($type eq "FHT") { print " "; print ""; print "\n"; } my $hstart = " \n"; print $hstart . "Logs" . $hend if($type eq "FileLog"); print $hstart . "HMS/KS300", $row?"odd":"even"); $row = ($row+1)%2; ##################### # Check if the icon exists my $v = $devs{$d}{state}; if(($type eq "FS20") || ($type eq "IT")) { my $v = $devs{$d}{state}; my $iv = $v; my $iname = ""; if(defined($devs{$d}) && defined($devs{$d}{ATTR}{showtime})) { $v = $devs{$d}{STATE}{state}{TIM}; } elsif($iv) { $iv =~ s/ .*//; # Want to be able to have icons for "on-for-timer xxx" $iname = $icons{"$type"} if($icons{"$type"}); $iname = $icons{"$type.$iv"} if($icons{"$type.$iv"}); $iname = $icons{"$d"} if($icons{"$d"}); $iname = $icons{"$d.$iv"} if($icons{"$d.$iv"}); } $v = "" if(!defined($v)); print ""; if($iname) { print ""; } else { print ""; } if($devs{$d}{sets}) { print ""; print ""; } } elsif($type eq "FHT") { $v = $devs{$d}{STATE}{"measured-temp"}{VAL}; $v = "" if(!defined($v)); $v =~ s/ .*//; print ""; print ""; $v = sprintf("%2.1f", int(2*$v)/2) if($v =~ m/[0-9.-]/); my @tv = map { ($_.".0", $_+0.5) } (16..26); $v = int($v*20)/$v if($v =~ m/^[0-9].$/); print $q->hidden("arg.$d", "desired-temp"); print $q->hidden("dev.$d", $d); print ""; } elsif($type eq "FileLog") { print "\n"; if($devs{$d}{ATTR}{archivedir}) { print(""); } my $l = $devs{$d}{ATTR}{logtype}; if(!defined($l)) { my %h = ("VAL" => "text"); $l = \%h; } foreach my $f (fileList($devs{$d}{INT}{logfile}{VAL})) { printf(" ", $row?"odd":"even"); $row = ($row+1)%2; foreach my $ln (split(",", $l->{VAL})) { my ($lt, $name) = split(":", $ln); $name = $lt if(!$name); print(""); } print ""; } } elsif($type eq "weblink" && $room ne "all") { $v = $devs{$d}{INT}{LINK}{VAL}; $t = $devs{$d}{INT}{WLTYPE}{VAL}; if($t eq "link") { print "\n"; } elsif($t eq "fileplot") { my @va = split(":", $v, 3); if(@va != 3 || !$devs{$va[0]}{INT}{currentlogfile}) { print(""); } else { if($va[2] eq "CURRENT") { $devs{$va[0]}{INT}{currentlogfile}{VAL} =~ m,([^/]*)$,; $va[2] = $1; } ################### # Search for fitting renderer if (!$havelookedforrenderer) { my $haverend; foreach my $rend (sort keys %devs ) { next if($rend ne $renderer); $haverend = 1; last; } $havelookedforrenderer = 1; if (!$haverend) { fhemcmd ("define $renderer FHEMRENDERER"); fhemcmd ("attr $renderer plotmode $plotmode"); fhemcmd ("attr $renderer plotsize $plotsize"); fhemcmd ("attr $renderer refresh $rendrefresh"); fhemcmd ("attr $renderer tmpfile $tmpfile"); fhemcmd ("get $renderer"); } else { $renderer_status = fhemcmd ("{\$attr{" . $renderer . "}{status} }"); if (($renderer_status =~ m/off/) && ($render_before)) { fhemcmd ("get $renderer"); } } } print ""; print ""; } } } else { print "\n"; } } if (($havelookedforrenderer) && ($renderer_status =~ m/off/) && ($render_after)) { fhemcmd ("define render_after at +00:01:30 get $renderer"); } print "
FS20 dev.StateSet to
IT dev.StateSet to
FHT dev.MeasuredSet to
"; my $hend = "
Readings" . $hend if($type eq "KS300"); print $hstart . "Scheduled commands (at)" . $hend if($type eq "at"); print $hstart . "Triggers (notify)" . $hend if($type eq "notify"); print $hstart . "Global variables" . $hend if($type eq "_internal_"); my $row=1; foreach my $d (sort keys %devs ) { next if($devs{$d}{type} ne $type); next if($room && $room ne "all" && !$rooms{$room}{$d}); printf("
$d$vonoff$d$v°" . $q->popup_menu(-name=>"val.$d", -values=>\@tv, -default=>$v) . $q->submit(-name=>"cmd.$d", -value=>"set") . "$d$varchive
$f$name
$dBroken definition: $v"; my $wl = "&pos=" . join("=", map {"$_=$pos{$_}"} keys %pos); my $arg="$me?cmd=showlog $d $va[0] $va[1] $va[2]$wl"; if($plotmode eq "SVG") { my ($w, $h) = split(",", $plotsize); print "\n"; } else { print "\n"; } print ""; print "$d
$d$v
\n"; print "
\n"; # Empty line } print "
\n"; print "
\n"; print $q->end_form; } ################# sub fileList($) { my ($fname) = @_; $fname =~ m,^(.*)/([^/]*)$,; # Split into dir and file my ($dir,$re) = ($1, $2); return if(!$re); $re =~ s/%./\.*/g; my @ret; return @ret if(!opendir(DH, $dir)); while(my $f = readdir(DH)) { next if($f !~ m,^$re$,); push(@ret, $f); } closedir(DH); return sort @ret; } ###################### sub showLogWrapper($) { my ($cmd) = @_; my (undef, $d, $type, $file) = split(" ", $cmd, 4); my $havelookedforrenderer; if($type eq "text") { $devs{$d}{INT}{logfile}{VAL} =~ m,^(.*)/([^/]*)$,; # Split into dir and file my $path = "$1/$file"; $path = $devs{$d}{ATTR}{archivedir}{VAL} . "/$file" if(!-f $path); open(FH, $path) || fatal("$path: $!"); my $cnt = join("", ); close(FH); $cnt =~ s//>/g; print "
\n"; print "
$cnt
\n"; print "
\n"; } else { ################### # Search for fitting renderer if (!$havelookedforrenderer) { my $havedev; foreach my $d (sort keys %devs ) { next if($d ne $renderer); $havedev = 1; last; } $havelookedforrenderer = 1; if (!$havedev) { fhemcmd ("define $renderer FHEMRENDERER"); fhemcmd ("attr $renderer plotmode $plotmode"); fhemcmd ("attr $renderer plotsize $plotsize"); fhemcmd ("attr $renderer refresh $rendrefresh"); fhemcmd ("attr $renderer tmpfile $tmpfile"); fhemcmd ("get $renderer"); } else { $renderer_status = fhemcmd ("{\$attr{" . $renderer . "}{status} }"); } } print "
\n"; print "\n"; print "
\n"; print ""; print "
"; my $arg = "$me?cmd=showlog undef $d $type $file"; if($plotmode eq "SVG") { my ($w, $h) = split(",", $plotsize); print "\n"; } else { print "\n"; } print "
Convert to weblink
\n"; print "\n"; print "
\n"; } } ###################### sub showLog($) { my ($cmd) = @_; my (undef, $wl, $d, $type, $file) = split(" ", $cmd, 5); my $arguments = "pos=" . join("&", map {"$_=$pos{$_}"} keys %pos); if (($wl eq "undef") || ($pos{off}) || ($pos{zoom})) { if ($wl eq "undef") { fhemcmd ("get $renderer $d $type $file $arguments"); } else { if (!$arguments) { fhemcmd ("get $renderer $wl $d $type $file"); } else { fhemcmd ("get $renderer $wl $d $type $file $arguments"); } } } print $q->header(-type=>"image/png"); if ($wl eq "undef") { open (FH, "$tmpfile$file.png"); # read in the result and send it print join("", ); close(FH); unlink ("$tmpfile$file.png"); } else { open(FH, "$tmpfile$wl.png"); # read in the result and send it print join("", ); close(FH); } exit(0); } ################## sub fatal($) { my ($msg) = @_; print $q->header; print $q->start_html(); print($msg); print $q->end_html; exit(0); } ################## # Multiline (for some types of widgets) editor with submit sub makeEdit($$$$) { my ($name, $type, $cmd, $val) = @_; print ""; print "
"; my $eval = $val; $eval =~ s,
,\n,g; if($type eq "at" || $type eq "notify") { print ""; } else { print ""; } $ti++; print "
" . $q->submit(-name=>"cmd.${cmd}$name", -value=>"$cmd $name"); print "
"; $eval = "
$eval
" if($eval =~ m/\n/); print "
$eval
"; print ""; } ################## # Generate the zoom and scroll images with links if appropriate sub zoomLink($$$$) { my ($cmd, $img, $alt, $br) = @_; my ($d,$off) = split("=", $cmd, 2); return if($plotmode eq "gnuplot"); # No scrolling return if($devs{$d} && $devs{$d}{ATTR}{fixedrange}); return if($devs{$d} && $devs{$d}{ATTR}{noscroll}); my $val = $pos{$d}; $cmd = "room=$room&pos="; if($d eq "zoom") { $val = "day" if(!$val); $val = $zoom{$val}; return if(!defined($val) || $val+$off < 0 || $val+$off >= int(@zoom) ); $val = $zoom[$val+$off]; return if(!$val); # Approximation of the next offset. my $w_off = $pos{off}; $w_off = 0 if(!$w_off); if($val eq "qday") { $w_off = $w_off*4; } elsif($val eq "day") { $w_off = ($off < 0) ? $w_off*7 : int($w_off/4); } elsif($val eq "week") { $w_off = ($off < 0) ? $w_off*4 : int($w_off/7); } elsif($val eq "month") { $w_off = ($off < 0) ? $w_off*12: int($w_off/4); } elsif($val eq "year") { $w_off = int($w_off/12); } $cmd .= "zoom=$val=off=$w_off"; } else { return if((!$val && $off > 0) || ($val && $val+$off > 0)); # no future $off=($val ? $val+$off : $off); my $zoom=$pos{zoom}; $zoom = 0 if(!$zoom); $cmd .= "zoom=$zoom=off=$off"; } print ""; print "\"$alt\""; print "
" if($br); } ################## # Calculate either the number of scrollable weblinks (for $d = undef) or # for the device the valid from and to dates for the given zoom and offset sub calcWeblink($$) { my ($d,$wl) = @_; return if($plotmode eq "gnuplot"); my $now = time(); my $zoom = $pos{zoom}; $zoom = "day" if(!$zoom); if(!$d) { foreach my $d (sort keys %devs ) { next if($devs{$d}{type} ne "weblink"); next if(!$room || ($room ne "all" && !$rooms{$room}{$d})); next if($devs{$d}{ATTR} && $devs{$d}{ATTR}{noscroll}); next if($devs{$d}{ATTR} && $devs{$d}{ATTR}{fixedrange}); $scrolledweblinkcount++; } return; } return if(!$devs{$wl}); return if($devs{$wl} && $devs{$wl}{ATTR}{noscroll}); if($devs{$wl} && $devs{$wl}{ATTR}{fixedrange}) { my @range = split(" ", $devs{$wl}{ATTR}{fixedrange}{VAL}); $devs{$d}{from} = $range[0]; $devs{$d}{to} = $range[1]; return; } my $off = $pos{$d}; $off = 0 if(!$off); $off += $pos{off} if($pos{off}); if($zoom eq "qday") { my $t = $now + $off*21600; my @l = localtime($t); $l[2] = int($l[2]/6)*6; $devs{$d}{from} = sprintf("%04d-%02d-%02d_%02d",$l[5]+1900,$l[4]+1,$l[3],$l[2]); $devs{$d}{to} = sprintf("%04d-%02d-%02d_%02d",$l[5]+1900,$l[4]+1,$l[3],$l[2]+6); } elsif($zoom eq "day") { my $t = $now + $off*86400; my @l = localtime($t); $devs{$d}{from} = sprintf("%04d-%02d-%02d",$l[5]+1900,$l[4]+1,$l[3]); $devs{$d}{to} = sprintf("%04d-%02d-%02d",$l[5]+1900,$l[4]+1,$l[3]+1); } elsif($zoom eq "week") { my @l = localtime($now); my $t = $now - ($l[6]*86400) + ($off*86400)*7; @l = localtime($t); $devs{$d}{from} = sprintf("%04d-%02d-%02d",$l[5]+1900,$l[4]+1,$l[3]); @l = localtime($t+7*86400); $devs{$d}{to} = sprintf("%04d-%02d-%02d",$l[5]+1900,$l[4]+1,$l[3]); } elsif($zoom eq "month") { my @l = localtime($now); while($off < -12) { $off += 12; $l[5]--; } $l[4] += $off; $l[4] += 12, $l[5]-- if($l[4] < 0); $devs{$d}{from} = sprintf("%04d-%02d", $l[5]+1900, $l[4]+1); $l[4]++; $l[4] = 0, $l[5]++ if($l[4] == 12); $devs{$d}{to} = sprintf("%04d-%02d", $l[5]+1900, $l[4]+1); } elsif($zoom eq "year") { my @l = localtime($now); $l[5] += $off; $devs{$d}{from} = sprintf("%04d", $l[5]+1900); $devs{$d}{to} = sprintf("%04d", $l[5]+1901); } } ################## # List/Edit/Save css and gnuplot files sub style($$) { my ($cmd, $msg) = @_; my @a = split(" ", $cmd); if($a[1] eq "list") { my @fl; push(@fl, "fhem.cfg"); push(@fl, "
"); push(@fl, fileList("$fhemwebdir/.*.css")); push(@fl, "
"); push(@fl, fileList("$gnuplotdir/.*.gplot")); push(@fl, "
"); push(@fl, fileList("$fhemwebdir/.*html")); print "
\n"; print "
\n"; print " $msg

\n" if($msg); print " \n"; my $row = 0; foreach my $file (@fl) { print ""; print ""; $row = ($row+1)%2; } print "
$file
\n"; print "
\n"; print "
\n"; } elsif($a[1] eq "examples") { my @fl = fileList("$fhemwebdir/example.*"); print "
\n"; print "
\n"; print " $msg

\n" if($msg); print " \n"; my $row = 0; foreach my $file (@fl) { print ""; print ""; $row = ($row+1)%2; } print "
$file
\n"; print "
\n"; print "
\n"; } elsif($a[1] eq "edit") { $a[2] =~ s,/,,g; # little bit of security my $f = ($a[2] eq "fhem.cfg" ? $configfile : "$fhemwebdir/$a[2]"); if(!open(FH, $f)) { print "$f: $!"; return; } my $data = join("", ); close(FH); print "
\n"; print "
"; print $q->submit(-name=>"save", -value=>"Save $f") . "

"; print $q->hidden("cmd", "style save $a[2]"); print ""; print "
"; print "
\n"; } elsif($a[1] eq "save") { $a[2] =~ s,/,,g; # little bit of security my $f = ($a[2] eq "fhem.cfg" ? $configfile : "$fhemwebdir/$a[2]"); if(!open(FH, ">$f")) { print "$f: $!"; return; } print FH $data; close(FH); style("style list", "Saved file $f"); $f = ($a[2] eq "fhem.cfg" ? $configfile : $a[2]); fhemcmd("rereadcfg") if($a[2] eq "fhem.cfg"); } } 1;