# # # 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 feature qw/switch/; use vars qw(%data); use HttpUtils; require "98_SVG.pm"; # enable use of plotAsPng() 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 ######################### 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; } ################## sub RSS_Initialize($) { my ($hash) = @_; $hash->{DefFn} = "RSS_Define"; #$hash->{AttrFn} = "RSS_Attr"; $hash->{AttrList}= "size bg tmin"; $hash->{SetFn} = "RSS_Set"; RSS_addExtension("RSS_CGI","rss","RSS"); return undef; } ################## sub RSS_readLayout($) { my ($hash)= @_; my $filename= $hash->{fhem}{filename}; my $name= $hash->{NAME}; if(open(LAYOUT, $filename)) { my @layout= ; $hash->{fhem}{layout}= join("", @layout); close(LAYOUT); } else { $hash->{fhem}{layout}= (); Log 1, "RSS $name: Cannot open $filename"; } } ################## sub RSS_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t]+", $def); return "Usage: define RSS jpg 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; eval "use GD::Text::Align"; $hash->{fhem}{useTextAlign} = ($@ ? 0 : 1 ); if(!($hash->{fhem}{useTextAlign})) { Log3 $hash, 1, "Cannot use text alignment: $@"; } eval "use GD::Text::Wrap"; $hash->{fhem}{useTextWrap} = ($@ ? 0 : 1 ); if(!($hash->{fhem}{useTextWrap})) { Log3 $hash, 1, "Cannot use text wrapping: $@"; } RSS_readLayout($hash); $hash->{STATE} = $name; 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 ($hostname)= @_; # http://hostname:8083/fhem return "http://$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= "\n"; foreach my $def (sort keys %defs) { if($defs{$def}{TYPE} eq "RSS") { $name= $defs{$def}{NAME}; $url= RSS_getURL($defs{$def}{fhem}{hostname}); $html.= " $name
\n"; } } $html.=""; 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 # |--------- url ----------| |---name --| ext my ($request) = @_; if($request =~ /^.*\/rss$/) { # http://localhost:8083/fhem/rss return (undef,undef); # name, ext } else { # http://hostname:8083/fhem/rss/myDeviceName.rss # http://hostname:8083/fhem/rss/myDeviceName.jpg my $call= $request; $call =~ s/^.*\/rss\/([^\/]*)$/$1/; my $name= $call; $name =~ s/^(.*)\.(jpg|rss)$/$1/; my $ext= $call; $ext =~ s/^$name\.(.*)$/$1/; return ($name,$ext); } } ################## sub RSS_returnRSS($) { my ($name) = @_; my $url= RSS_getURL($defs{$name}{fhem}{hostname}); my $code= "$name1"; return ("application/xml; 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 @d= split("", $rgb); return $S->colorResolve(hex("$d[0]$d[1]"),hex("$d[2]$d[3]"),hex("$d[4]$d[5]")); } 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,$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) = $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 "url") { my $data = GetFileFromURL($arg,3,undef,1); if($imgtype eq "gif") { $I= GD::Image->newFromGifData($data); } elsif($imgtype eq "png") { $I= GD::Image->newFromPngData($data); } elsif($imgtype eq "jpeg") { $I= GD::Image->newFromJpegData($data); } else { return; } } elsif($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); } else { return; } } elsif($srctype eq "data") { 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); } else { return; } } else { return; } 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_evalLayout($$@) { my ($S,$name,$layout)= @_; my @layout= split("\n", $layout); 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; my ($x,$y,$x1,$y1,$x2,$y2,$scale,$boxwidth,$text,$imgtype,$srctype,$arg,$format); my $cont= ""; foreach my $line (@layout) { # 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= ""; #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} = AnalyzePerlCommand(undef, $def); next; } next unless($params{condition}); #Debug "before command $line: x= " . $params{x} . ", y= " . $params{y}; if($cmd eq "rgb") { $def= "\"$def\"" if(length($def) == 6 && $def =~ /[[:xdigit:]]{6}/); $params{rgb}= AnalyzePerlCommand(undef, $def); } elsif($cmd eq "font") { $params{font}= $def; } elsif($cmd eq "pt") { $params{pt}= $def; } 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 = AnalyzePerlCommand(undef, $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 = AnalyzePerlCommand(undef, $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= AnalyzePerlCommand(undef, $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= AnalyzePerlCommand(undef, $text); #Debug "$name: ($x,$y) $txt"; $y= RSS_itemTextBox($S,$x,$y,$boxwidth,$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 "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= AnalyzePerlCommand(undef, $arg); RSS_itemImg($S,$x,$y,$scale,$imgtype,$srctype,$arg,%params); } else { Log3 $name, 1, "$name: Illegal command $cmd in layout definition."; } #Debug "after command $line: x= " . $params{x} . ", y= " . $params{y}; } } ################## sub RSS_returnJPEG($) { my ($name)= @_; 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 # my $S; # let's create a blank image, we will need it in most cases. $S= GD::Image->newTrueColor($width,$height); $S->colorAllocate(0,0,0); # black is the background # wrap to make problems with GD non-lethal eval { # # set the background # # check if background directory is set 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); closedir(BGDIR); # get item number if($#bgfiles>=0) { if($bgnr > $#bgfiles) { $bgnr= 0; } $defs{$name}{fhem}{bgnr}= $bgnr; my $bgfile= $bgdir . "/" . $bgfiles[$bgnr]; my $bg= newFromJpeg GD::Image($bgfile); 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 $S = undef; $S= $bg; } } } } # # evaluate layout # RSS_evalLayout($S, $name, $defs{$name}{fhem}{layout}); }; warn $@ if $@; # # return jpeg image # return ("image/jpeg; charset=utf-8", $S->jpeg); } ################## # # 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 my ($name,$ext)= RSS_splitRequest($request); # name, ext (rss, jpg) 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_returnJPEG($name); } elsif($ext eq "rss") { return RSS_returnRSS($name); } } else { return RSS_Overview(); } } # 1; =pod =begin html

RSS

=end html =cut