# # # 02_RSS.pm # written by Dr. Boris Neubert 2012-03-24 # e-mail: omega at online dot de # ############################################## # $Id$ package main; use strict; use warnings; use GD; use Image::LibRSVG; use feature qw/switch/; use vars qw(%data); use HttpUtils; #require "98_SVG.pm"; # enable use of plotAsPng() sub plotAsPng(@); # forward declaration will be enough # to ensure correct function # and will avoid reloading 98_SVG.pm # during fhem startup/rereadcfg my @cmd_halign = qw(halign thalign ihalign); my @cmd_valign = qw(valign tvalign ivalign); my @valid_valign = qw(top center base bottom); my @valid_halign = qw(left center right justified); # we can # use vars qw(%FW_types); # device types, # use vars qw($FW_RET); # Returned data (html) # use vars qw($FW_wname); # Web instance # use vars qw($FW_subdir); # Sub-path in URL for extensions, e.g. 95_FLOORPLAN # use vars qw(%FW_pos); # scroll position # use vars qw($FW_cname); # Current connection name # http://blogs.perl.org/users/mike_b/2013/06/a-little-nicer-way-to-use-smartmatch-on-perl-518.html #no if $] >= 5.017011, warnings => 'experimental::smartmatch'; no if $] >= 5.017011, warnings => 'experimental'; ######################### sub RSS_addExtension($$$) { my ( $func, $link, $friendlyname ) = @_; my $url = "/" . $link; $data{FWEXT}{$url}{FUNC} = $func; $data{FWEXT}{$url}{LINK} = "+$link"; $data{FWEXT}{$url}{NAME} = $friendlyname; $data{FWEXT}{$url}{SCRIPT} = "RSS.js"; $data{FWEXT}{$url}{FORKABLE} = 0; } ################## sub RSS_Initialize($) { my ($hash) = @_; $hash->{DefFn} = "RSS_Define"; $hash->{UndefFn} = "RSS_Undefine"; #$hash->{AttrFn} = "RSS_Attr"; $hash->{AttrList} = "size itemtitle bg bgcolor tmin refresh areas autoreread:1,0 viewport noscroll urlOverride"; $hash->{SetFn} = "RSS_Set"; $hash->{NotifyFn} = "RSS_Notify"; return undef; } ################## sub RSS_readLayout($) { my ($hash) = @_; my $filename = $hash->{fhem}{filename}; my $name = $hash->{NAME}; my ( $err, @layoutfile ) = FileRead($filename); if ($err) { Log 1, "RSS $name: $err"; $hash->{fhem}{layout} = ("text 0.1 0.1 'Error: $err'"); } else { $hash->{fhem}{layout} = join( "\n", @layoutfile ); $hash->{fhem}{layout} =~ s/\n\n/\n/g; } return; } ################## sub RSS_Define($$) { my ( $hash, $def ) = @_; my @a = split( "[ \t]+", $def ); return "Usage: define RSS jpg|png hostname filename" if ( int(@a) != 5 ); my $name = $a[0]; my $style = $a[2]; my $hostname = $a[3]; my $filename = $a[4]; $hash->{fhem}{style} = $style; $hash->{fhem}{hostname} = $hostname; $hash->{fhem}{filename} = $filename; $hash->{LAYOUTFILE} = $filename; $hash->{NOTIFYDEV} = 'global'; RSS_addExtension( "RSS_CGI", "rss", "RSS" ); eval "use GD::Text::Align"; $hash->{fhem}{useTextAlign} = ( $@ ? 0 : 1 ); if ( !( $hash->{fhem}{useTextAlign} ) ) { Log3 $hash, 2, "$name: Cannot use text alignment: $@"; } eval "use GD::Text::Wrap"; $hash->{fhem}{useTextWrap} = ( $@ ? 0 : 1 ); if ( !( $hash->{fhem}{useTextWrap} ) ) { Log3 $hash, 2, "$name: Cannot use text wrapping: $@"; } RSS_readLayout($hash); $hash->{STATE} = 'defined'; #$name; return undef; } sub RSS_Undefine($$) { my ( $hash, $arg ) = @_; # check if last device my $url = '/rss'; $data{FWEXT}{$url} = undef if int( devspec2array('TYPE=RSS') ) == 1; return undef; } sub RSS_Notify { my ( $hash, $dev ) = @_; my $name = $hash->{NAME}; return unless AttrVal( $name, 'autoreread', 1 ); return if ( $dev->{NAME} ne "global" ); return if ( !grep( m/^FILEWRITE $hash->{LAYOUTFILE}$/, @{ $dev->{CHANGED} } ) ); Log3( undef, 4, "RSS: $name reread layout after edit." ); RSS_readLayout($hash); return undef; } ################## sub RSS_Set() { my ( $hash, @a ) = @_; my $name = $a[0]; # usage check my $usage = "Unknown argument, choose one of rereadcfg:noArg"; if ( ( @a == 2 ) && ( $a[1] eq "rereadcfg" ) ) { RSS_readLayout($hash); return undef; } else { return $usage; } } #################### # sub RSS_getURL($) { my ($name) = @_; my $url = AttrVal( $name, 'urlOverride', '' ); return $url if ( $url ne "" ); my $hostname = $defs{$name}{fhem}{hostname}; # http://hostname:8083/fhem my $proto = ( AttrVal( $FW_wname, 'HTTPS', 0 ) == 1 ) ? 'https' : 'http'; return $proto . "://$hostname:" . $defs{$FW_wname}{PORT} . $FW_ME; } # ################## # sub # RSS_Attr(@) # { # my @a = @_; # my $attr= $a[2]; # # if($a[0] eq "set") { # set attribute # if($attr eq "bgdir") { # } # } # elsif($a[0] eq "del") { # delete attribute # if($attr eq "bgdir") { # } # } # # return undef; # # } ################## # list all RSS devices sub RSS_Overview { my ( $name, $url ); my $html = RSS_HTMLHead( "RSS Overview", undef ) . "\n"; foreach my $def ( sort keys %defs ) { if ( $defs{$def}{TYPE} eq "RSS" ) { $name = $defs{$def}{NAME}; $url = RSS_getURL($name); $html .= "$name
\n\n

\n"; } } $html .= "\n" . RSS_HTMLTail(); return ( "text/html; charset=utf-8", $html ); } ################## sub RSS_splitRequest($) { # http://hostname:8083/fhem/rss # http://hostname:8083/fhem/rss/myDeviceName.rss # http://hostname:8083/fhem/rss/myDeviceName.jpg?t=47110.815 # |--------- url ----------| |---name --| ext |--query--| my ($request) = @_; # http://hostname:8083/fhem/rss/myDeviceName.rss # http://hostname:8083/fhem/rss/myDeviceName.jpg # http://hostname:8083/fhem/rss/myDeviceName.png # http://hostname:8083/fhem/rss/myDeviceName.html use constant REGEXP => '^.*\/rss\/([^\/]*)\.(jpg|png|rss|html)(\?(.*))?$'; if ( $request =~ REGEXP ) { return ( $1, $2, $4 ); } else { #main::Debug "not matched"; return ( undef, undef, undef ); } } ################## sub RSS_returnRSS($) { my ($name) = @_; my $url = RSS_getURL($name); my $type = $defs{$name}{fhem}{style}; my $mime = ( $type eq 'png' ) ? 'image/png' : 'image/jpeg'; my $now = time(); my $itemTitle = AttrVal( $name, "itemtitle", "" ); my $titleTag = ( $itemTitle ne '' ) ? '' . $itemTitle . '' : ''; my $code = "$name1$titleTagitem_$now"; return ( "application/xml; charset=utf-8", $code ); } ################## sub RSS_getScript() { my $jsTemplate = ''; my $scripts = ""; if ( defined( $data{FWEXT} ) ) { foreach my $k ( sort keys %{ $data{FWEXT} } ) { my $h = $data{FWEXT}{$k}; next if ( $h !~ m/HASH/ || !$h->{SCRIPT} ); my $script = $h->{SCRIPT}; $script = ( $script =~ m,^/, ) ? "$FW_ME$script" : "$FW_ME/pgm2/$script"; $scripts .= sprintf( $jsTemplate, $script ) . "\n"; } } return $scripts; } sub RSS_HTMLHead($$) { my ( $name, $refresh ) = @_; my ( $width, $height ) = split( /x/, AttrVal( $name, "size", "800x600" ) ); my $viewportContent = AttrVal( $name, "viewport", "" ); my $doctype = ''; my $xmlns = 'xmlns="http://www.w3.org/1999/xhtml"'; my $scripts = RSS_getScript(); my $viewport = $viewportContent eq "" ? "" : "\n"; my $code = "$doctype\n\n\n$name\n$viewport$scripts\n"; } sub RSS_HTMLTail() { return ""; } sub RSS_returnHTML($) { my ($name) = @_; my $url = RSS_getURL($name); my $type = $defs{$name}{fhem}{style}; my $img = "$url/rss/$name.$type"; my $refresh = AttrVal( $name, 'refresh', 60 ); my $noscroll = AttrVal( $name, 'noscroll', 0 ); my $overflow = $noscroll ? " style=\"overflow:hidden\"" : ""; my $areas = AttrVal( $name, 'areas', "" ); my $embed = $defs{$name}{".embed"}; my $r = ""; if ( defined($refresh) && ( $refresh > 0 ) ) { my $handler = "\"setTimeout(function(){reloadImage(\'img0\')},$refresh*1000);\""; $r = " onload=$handler onerror=$handler"; } my $code = RSS_HTMLHead( $name, $refresh ) . "\n" . "

\n" . "\n" . "\n$areas\n\n" . "
\n" . "$embed\n" . "\n" . RSS_HTMLTail(); return ( "text/html; charset=utf-8", $code ); } ################## # Library ################## sub RSS_xy { my ( $S, $x, $y, %params ) = @_; $x = $params{x} if ( $x eq 'x' ); $y = $params{y} if ( $y eq 'y' ); if ( ( -1 < $x ) && ( $x < 1 ) ) { $x *= $S->width; } if ( ( -1 < $y ) && ( $y < 1 ) ) { $y *= $S->height; } return ( $x, $y ); } sub RSS_color { my ( $S, $rgb ) = @_; my $alpha = 0; my @d = split( "", $rgb ); if ( length($rgb) == 8 ) { $alpha = hex("$d[6]$d[7]"); $alpha = ( $alpha < 127 ) ? $alpha : 127; } return $S->colorAllocateAlpha( hex("$d[0]$d[1]"), hex("$d[2]$d[3]"), hex("$d[4]$d[5]"), $alpha ); } sub RSS_itemText { my ( $S, $x, $y, $text, %params ) = @_; return unless ( defined($text) ); if ( $params{useTextAlign} ) { my $align = GD::Text::Align->new( $S, color => RSS_color( $S, $params{rgb} ), valign => $params{tvalign}, halign => $params{thalign}, ); $align->set_font( $params{font}, $params{pt} ); $align->set_text($text); $align->draw( $x, $y, 0 ); } else { $S->stringFT( RSS_color( $S, $params{rgb} ), $params{font}, $params{pt}, 0, $x, $y, $text ); } } sub RSS_itemTextBox { my ( $S, $x, $y, $boxwidth, $bgcolor, $text, %params ) = @_; return unless ( defined($text) ); if ( $params{useTextWrap} ) { if ( ( 0 < $boxwidth ) && ( $boxwidth < 1 ) ) { $boxwidth *= $S->width; } my $wrapbox = GD::Text::Wrap->new( $S, color => RSS_color( $S, $params{rgb} ), line_space => $params{linespace}, text => $text, ); $wrapbox->set_font( $params{font}, $params{pt} ); $wrapbox->set( align => $params{thalign}, width => $boxwidth ); my ( $left, $top, $right, $bottom ); ( $left, $top, $right, $bottom ) = $wrapbox->get_bounds( $x, $y ); $S->filledRectangle( $left, $top, $right, $bottom, RSS_color( $S, $bgcolor ) ) if ( defined($bgcolor) ); ( $left, $top, $right, $bottom ) = $wrapbox->draw( $x, $y ); return $bottom; } else { RSS_itemText( $S, $x, $y, $text, %params ); return $y; } } sub RSS_itemTime { my ( $S, $x, $y, %params ) = @_; my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time); RSS_itemText( $S, $x, $y, sprintf( "%02d:%02d", $hour, $min ), %params ); } sub RSS_itemSeconds { my ( $S, $x, $y, $format, %params ) = @_; my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time); if ( $format eq "colon" ) { RSS_itemText( $S, $x, $y, sprintf( ":%02d", $sec ), %params ); } else { RSS_itemText( $S, $x, $y, sprintf( "%02d", $sec ), %params ); } } sub RSS_itemDate { my ( $S, $x, $y, %params ) = @_; my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time); RSS_itemText( $S, $x, $y, sprintf( "%02d.%02d.%04d", $mday, $mon + 1, $year + 1900 ), %params ); } sub RSS_itemImg { my ( $S, $x, $y, $scale, $imgtype, $srctype, $arg, %params ) = @_; return unless ( defined($arg) ); return if ( $arg eq "" ); my $I; if ( $srctype eq "file" ) { if ( $imgtype eq "gif" ) { $I = GD::Image->newFromGif($arg); } elsif ( $imgtype eq "png" ) { $I = GD::Image->newFromPng($arg); } elsif ( $imgtype eq "jpeg" ) { $I = GD::Image->newFromJpeg($arg); } elsif ( $imgtype eq "svg" ) { # SVG: replace $arg with PNG data and act as if "png data" were given. my $rsvg = new Image::LibRSVG(); $rsvg->loadImage($arg); $arg = $rsvg->getImageBitmap(); $imgtype = "png"; $srctype = "data"; } else { return; } } elsif ( $srctype eq "url" || $srctype eq "urlq" ) { # URL: replace $arg with data and act as if "data" were given if ( $srctype eq "url" ) { $arg = GetFileFromURL( $arg, 3, undef, 1 ); } else { $arg = GetFileFromURLQuiet( $arg, 3, undef, 1 ); } $srctype = "data"; } if ( $srctype eq "data" ) { # No elsif here, run this also if we saved data in $arg above. if ( $imgtype eq "gif" ) { $I = GD::Image->newFromGifData($arg); } elsif ( $imgtype eq "png" ) { $I = GD::Image->newFromPngData($arg); } elsif ( $imgtype eq "jpeg" ) { $I = GD::Image->newFromJpegData($arg); } elsif ( $imgtype eq "svg" ) { my $rsvg = new Image::LibRSVG(); $rsvg->loadImageFromString($arg); $I = GD::Image->newFromPngData($rsvg->getImageBitmap()); } else { return; } } # If any of the cases above was true, we should have an image now. Otherwise return. return if(!defined($I)); eval { my ( $width, $height ) = $I->getBounds(); if ( $scale =~ s/([wh])([\d]*)/$2/ ) { # get the digit from width/hight to pixel entry #Debug "RSS scale $scale (1: $1 / 2: $2)contais px after Digit - width: $width / height: $height"; if ( $1 eq "w" ) { $scale = $scale / $width; } else { $scale = $scale / $height; } } my ( $swidth, $sheight ) = ( int( $scale * $width ), int( $scale * $height ) ); given ( $params{ihalign} ) { when ('center') { $x -= $swidth / 2; } when ('right') { $x -= $swidth; } default { } # nothing to do } given ( $params{ivalign} ) { when ('center') { $y -= $sheight / 2; } when ('base') { $y -= $sheight; } when ('bottom') { $y -= $sheight; } default { } # nothing to do } #Debug "RSS placing $arg ($swidth x $sheight) at ($x,$y)"; $S->copyResampled( $I, $x, $y, 0, 0, $swidth, $sheight, $width, $height ); }; if ($@) { Log3 undef, 2, "RSS: cannot create image $srctype $imgtype '$arg': $@"; } } sub RSS_itemLine { my ( $S, $x1, $y1, $x2, $y2, $th, %params ) = @_; $S->setThickness($th); $S->line( $x1, $y1, $x2, $y2, RSS_color( $S, $params{rgb} ) ); } sub RSS_itemRect { my ( $S, $x1, $y1, $x2, $y2, $filled, %params ) = @_; $x2 = $x1 + $x2 if ( $x2 =~ /^\+/ ); $y2 = $y1 + $y2 if ( $y2 =~ /^\+/ ); if ($filled) { $S->filledRectangle( $x1, $y1, $x2, $y2, RSS_color( $S, $params{rgb} ) ); } else { $S->rectangle( $x1, $y1, $x2, $y2, RSS_color( $S, $params{rgb} ) ); } } ################## sub RSS_cleanLayout($) { my ($input) = @_; my @output; my $cont = ""; foreach my $line ( split( "\n", $input ) ) { # kill trailing newline chomp $line; # kill comments and blank lines $line =~ s/\#.*$//; $line =~ s/\s+$//; $line = $cont . $line; if ( $line =~ s/\\$// ) { $cont = $line; undef $line; } next unless ($line); $cont = ""; push @output, $line; } return @output; } sub RSS_analyzePerl($) { my ($expr) = @_; return AnalyzePerlCommand( "", $expr, 1 ); # specials have been previously stored } sub RSS_evalLayout($$@) { my ( $S, $name, $layout ) = @_; my @layout = RSS_cleanLayout($layout); my $lineNr; my %labels; my %count; # first pass # collect labels for ( $lineNr = 0 ; $lineNr <= $#layout ; $lineNr++ ) { if ( $layout[$lineNr] =~ /^label\s+(.+)$/ ) { my $label = $1; if ( exists( $labels{$label} ) ) { Log3 $name, 2, "$name: label $label redefined."; } else { $labels{$label} = $lineNr; $count{ '$' . $label } = 0; #Debug "defined label $label"; } } } EvalSpecials( "", %count ); # second pass # create actual layout my %pstack; my $pstackcount = 0; my %params; $params{font} = "Arial"; $params{pt} = 12; $params{rgb} = "ffffff"; $params{halign} = 'left'; $params{valign} = 'base'; $params{condition} = 1; # we need two pairs of align parameters # due to different default values for text and img $params{useTextAlign} = $defs{$name}{fhem}{useTextAlign}; $params{useTextWrap} = $defs{$name}{fhem}{useTextWrap}; $params{ihalign} = 'left'; $params{ivalign} = 'top'; $params{thalign} = 'left'; $params{tvalign} = 'base'; $params{linespace} = 0; $params{x} = 0; $params{y} = 0; $defs{$name}{".embed"} = ""; my ( $x, $y, $z, $x1, $y1, $x2, $y2, $scale, $bgcolor, $boxwidth, $text, $imgtype, $srctype, $arg, $format ); for ( $lineNr = 0 ; $lineNr <= $#layout ; $lineNr++ ) { my $line = $layout[$lineNr]; #Debug "Line $lineNr: $line"; #Debug "$name: evaluating >$line<"; # split line into command and definition my ( $cmd, $def ) = split( "[ \t]+", $line, 2 ); #Debug "CMD= \"$cmd\", DEF= \"$def\""; # separate condition handling if ( $cmd eq 'condition' ) { $params{condition} = RSS_analyzePerl($def); #Debug "condition $def evaluated to " . $params{condition}; next; } next unless ( $params{condition} ); #Debug "before command $line: x= " . $params{x} . ", y= " . $params{y}; eval { if ( $cmd eq "rgb" ) { $def = "\"$def\"" if ( length($def) == 6 && $def =~ /[[:xdigit:]]{6}/ ); $params{rgb} = RSS_analyzePerl($def); } elsif ( $cmd eq "font" ) { $params{font} = $def; } elsif ( $cmd eq "pt" ) { $def = RSS_analyzePerl($def); if ( $def =~ m/^[+-]/ ) { $params{pt} += $def; } else { $params{pt} = $def; } $params{pt} = 6 if ( $params{pt} < 0 ); } elsif ( $cmd eq "moveto" ) { my ( $tox, $toy ) = split( '[ \t]+', $def, 2 ); my ( $x, $y ) = RSS_xy( $S, $tox, $toy, %params ); $params{x} = $x; $params{y} = $y; } elsif ( $cmd eq "moveby" ) { my ( $byx, $byy ) = split( '[ \t]+', $def, 2 ); my ( $x, $y ) = RSS_xy( $S, $byx, $byy, %params ); $params{x} += $x; $params{y} += $y; } elsif ( $cmd ~~ @cmd_halign ) { my $d = RSS_analyzePerl($def); if ( $d ~~ @valid_halign ) { $params{ihalign} = $d unless ( $cmd eq "thalign" ); $params{thalign} = $d unless ( $cmd eq "ihalign" ); } else { Log3 $name, 2, "$name: Illegal horizontal alignment $d"; } } elsif ( $cmd ~~ @cmd_valign ) { my $d = RSS_analyzePerl($def); if ( $d ~~ @valid_valign ) { $params{ivalign} = $d unless ( $cmd eq "tvalign" ); $params{tvalign} = $d unless ( $cmd eq "ivalign" ); } else { Log3 $name, 2, "$name: Illegal vertical alignment $d"; } } elsif ( $cmd eq "linespace" ) { $params{linespace} = $def; } elsif ( $cmd eq "text" ) { ( $x, $y, $text ) = split( "[ \t]+", $def, 3 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $params{x} = $x; $params{y} = $y; my $txt = RSS_analyzePerl($text); #Debug "$name: ($x,$y) $txt"; RSS_itemText( $S, $x, $y, $txt, %params ); } elsif ( $cmd eq "textbox" ) { ( $x, $y, $boxwidth, $text ) = split( "[ \t]+", $def, 4 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); my $txt = RSS_analyzePerl($text); $y = RSS_itemTextBox( $S, $x, $y, $boxwidth, undef, $txt, %params ); $params{x} = $x; $params{y} = $y; } elsif ( $cmd eq "textboxf" ) { ( $x, $y, $boxwidth, $bgcolor, $text ) = split( "[ \t]+", $def, 5 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $bgcolor = ( $bgcolor ne "" ) ? RSS_analyzePerl($bgcolor) : undef; my $txt = RSS_analyzePerl($text); $y = RSS_itemTextBox( $S, $x, $y, $boxwidth, $bgcolor, $txt, %params ); $params{x} = $x; $params{y} = $y; } elsif ( $cmd eq "line" ) { ( $x1, $y1, $x2, $y2, $format ) = split( "[ \t]+", $def, 5 ); ( $x1, $y1 ) = RSS_xy( $S, $x1, $y1, %params ); ( $x2, $y2 ) = RSS_xy( $S, $x2, $y2, %params ); $format //= 1; # set format to 1 as default thickness for the line RSS_itemLine( $S, $x1, $y1, $x2, $y2, $format, %params ); } elsif ( $cmd eq "rect" ) { ( $x1, $y1, $x2, $y2, $format ) = split( "[ \t]+", $def, 5 ); ( $x1, $y1 ) = RSS_xy( $S, $x1, $y1, %params ); ( $x2, $y2 ) = RSS_xy( $S, $x2, $y2, %params ); $format //= 0; # set format to 0 as default (not filled) RSS_itemRect( $S, $x1, $y1, $x2, $y2, $format, %params ); } elsif ( $cmd eq "time" ) { ( $x, $y ) = split( "[ \t]+", $def, 2 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $params{x} = $x; $params{y} = $y; RSS_itemTime( $S, $x, $y, %params ); } elsif ( $cmd eq "seconds" ) { ( $x, $y, $format ) = split( "[ \+]", $def, 3 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $params{x} = $x; $params{y} = $y; RSS_itemSeconds( $S, $x, $y, $format, %params ); } elsif ( $cmd eq "date" ) { ( $x, $y ) = split( "[ \t]+", $def, 2 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $params{x} = $x; $params{y} = $y; RSS_itemDate( $S, $x, $y, %params ); } elsif ( $cmd eq "img" ) { ( $x, $y, $scale, $imgtype, $srctype, $arg ) = split( "[ \t]+", $def, 6 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); $params{x} = $x; $params{y} = $y; my $arg = RSS_analyzePerl($arg); RSS_itemImg( $S, $x, $y, $scale, $imgtype, $srctype, $arg, %params ); } elsif ( $cmd eq "push" ) { $pstackcount++; while ( my ( $key, $value ) = each(%params) ) { $pstack{$pstackcount}{$key} = $value; } } elsif ( $cmd eq "pop" ) { return unless $pstackcount; while ( my ( $key, $value ) = each( %{ $pstack{$pstackcount} } ) ) { $params{$key} = $value; } delete $pstack{$pstackcount}; $pstackcount--; } elsif ( $cmd eq "embed" ) { ( $x, $y, $z, $format, $text, $arg ) = split( "[ \t]+", $def, 6 ); ( $x, $y ) = RSS_xy( $S, $x, $y, %params ); my $arg = RSS_analyzePerl($arg); $defs{$name}{".embed"} .= "
\n"; $defs{$name}{".embed"} .= $arg . "\n"; $defs{$name}{".embed"} .= "
\n"; #main::Debug "SET EMBED=" . $defs{$name}{".embed"}; } elsif ( $cmd eq "label" ) { #Debug "encountered label $def"; $count{ '$' . $def }++; if ( $count{ '$' . $def } > 99 ) { Log3 $name, 2, "$name: exceeded hit count for label $def"; last; } #Debug "label $def hit count " . $count{ '$' . $def }; EvalSpecials("", %count); } elsif ( $cmd eq "goto" ) { my ( $label, $if, $condition ) = split( "[ \t]+", $def, 3 ); if ( defined($if) and ( ( $if ne "if" ) or ( !defined($condition) ) ) ) { Log3 $name, 2, "$name: syntax error in goto command \"$line\"."; next; } if ( exists $labels{$label} ) { if ( !defined($if) or RSS_analyzePerl($condition) ) { $lineNr = $labels{$label} - 1; } } else { Log3 $name, 2, "$name: Undefined label $label in goto command."; } } else { Log3 $name, 2, "$name: Illegal command $cmd in layout definition."; } #Debug "after command $line: x= " . $params{x} . ", y= " . $params{y}; }; if ($@) { my $msg = "$name: Error from line \'$line\' in layout definition: $@"; chomp $msg; Log3 $name, 2, $msg; } } } ################## sub RSS_returnIMG($$) { my ( $name, $type ) = @_; my ( $width, $height ) = split( /x/, AttrVal( $name, "size", "800x600" ) ); # # increase counter # if ( defined( $defs{$name}{fhem} ) && defined( $defs{$name}{fhem}{counter} ) ) { $defs{$name}{fhem}{counter}++; } else { $defs{$name}{fhem}{counter} = 1; } # true color GD::Image->trueColor(1); # # create the image # our $S; # let's create a blank image, we will need it in most cases. $S = GD::Image->newTrueColor( $width, $height ); my $bgcolor = AttrVal( $name, 'bgcolor', '000000' ); #default bg color = black $bgcolor = RSS_color( $S, $bgcolor ); # $S->colorAllocate(0,0,0); # other colors seem not to work (issue with GD) $S->fill( 0, 0, $bgcolor ); # wrap to make problems with GD non-lethal eval { # # set the background # # check if background directory is set my $reason = "?"; # remember reason for undefined image my $bgdir = AttrVal( $name, "bg", "undef" ); if ( defined($bgdir) ) { my $bgnr; # item number if ( defined( $defs{$name}{fhem} ) && defined( $defs{$name}{fhem}{bgnr} ) ) { $bgnr = $defs{$name}{fhem}{bgnr}; } else { $bgnr = 0; } # check if at least tmin seconds have passed my $t0 = 0; my $tmin = AttrVal( $name, "tmin", 0 ); if ( defined( $defs{$name}{fhem} ) && defined( $defs{$name}{fhem}{t} ) ) { $t0 = $defs{$name}{fhem}{t}; } my $t1 = time(); if ( $t1 - $t0 >= $tmin ) { $defs{$name}{fhem}{t} = $t1; $bgnr++; } # detect pictures if ( opendir( BGDIR, $bgdir ) ) { my @bgfiles = grep { $_ !~ /^\./ } readdir(BGDIR); #foreach my $f (@bgfiles) { # Debug sprintf("File \"%s\"\n", $f); #} closedir(BGDIR); # get item number if ( $#bgfiles >= 0 ) { if ( $bgnr > $#bgfiles ) { $bgnr = 0; } $defs{$name}{fhem}{bgnr} = $bgnr; my $bgfile = $bgdir . "/" . $bgfiles[$bgnr]; my $filetype = ( split( /\./, $bgfile ) )[-1]; readingsSingleUpdate($defs{$name}, "bgFilename", $bgfile, 1); readingsSingleUpdate($defs{$name}, "bgFiletype", $filetype, 1); my $bg; $bg = newFromGif GD::Image($bgfile) if $filetype =~ m/^gif$/i; $bg = newFromJpeg GD::Image($bgfile) if $filetype =~ m/^jpe?g$/i; $bg = newFromPng GD::Image($bgfile) if $filetype =~ m/^png$/i; if ( defined($bg) ) { my ( $bgwidth, $bgheight ) = $bg->getBounds(); if ( $bgwidth != $width or $bgheight != $height ) { # we need to resize my ( $w, $h ); my ( $u, $v ) = ( $bgwidth / $width, $bgheight / $height ); if ( $u > $v ) { $w = $width; $h = $bgheight / $u; } else { $h = $height; $w = $bgwidth / $v; } $S->copyResized( $bg, ( $width - $w ) / 2, ( $height - $h ) / 2, 0, 0, $w, $h, $bgwidth, $bgheight ); } else { # size is as required # kill the predefined image and take the original undef $S; $S = $bg; } } else { undef $S; $reason = "Something was wrong with background image \"$bgfile\"."; } } } } # # evaluate layout # if ( defined($S) ) { RSS_evalLayout( $S, $name, $defs{$name}{fhem}{layout} ); } else { Log3 $name, 2, "$name: Could not create image. $reason"; $S = GD::Image->newTrueColor( $width, $height ); # return empty image } $defs{$name}{STATE} = localtime(); }; #warn $@ if $@; if ($@) { my $msg = $@; chomp $msg; Log3 $name, 2, $msg; } # # return image # return ( "image/jpeg; charset=utf-8", $S->jpeg ) if ( $type eq 'jpg' ); return ( "image/png; charset=utf-8", $S->png ) if ( $type eq 'png' ); } ################## # # here we answer any request to http://host:port/fhem/rss and below sub RSS_CGI() { my ($request) = @_; # /rss or /rss/name.rss or /rss/name.jpg or /rss/name.png my ( $name, $ext, $query ) = RSS_splitRequest($request); # name, ext (rss, jpg, png, html), query # query is unused #main::Debug "Request: $request"; #main::Debug " Name : $name"; #main::Debug " Ext : $ext"; #main::Debug " Query : $query"; if ( defined($name) ) { if ( $ext eq "" ) { return ( "text/plain; charset=utf-8", "Illegal extension." ); } if ( !defined( $defs{$name} ) ) { return ( "text/plain; charset=utf-8", "Unknown RSS device: $name" ); } if ( $ext eq "jpg" ) { return RSS_returnIMG( $name, 'jpg' ); } elsif ( $ext eq "png" ) { return RSS_returnIMG( $name, 'png' ); } elsif ( $ext eq "rss" ) { return RSS_returnRSS($name); } elsif ( $ext eq "html" ) { return RSS_returnHTML($name); } } else { return RSS_Overview(); } } sub plotFromUrl(@) { my (@plotName) = @_; my @webs; @webs = devspec2array("TYPE=FHEMWEB"); foreach (@webs) { if ( !InternalVal( $_, 'TEMPORARY', undef ) ) { $FW_wname = InternalVal( $_, 'NAME', '' ); last; } } my ( $w, $h ) = split( ",", AttrVal( $plotName[0], "plotsize", "800,160" ) ); my $url; $url = ""; return $url; } # 1; =pod =item helper =item summary Provides a freely configurable RSS feed and HTML page. =item summary_DE Stellt frei konfigurierbaren RSS-Feed und HTML-Seite bereit. =begin html

RSS

=end html =cut