rss.pl
#
#
#
package rss;
$|++;
use vars qw($ddns $ee $rr $ii $debug $mpc @text $stukjehead);
use strict;
use jip;
$ddns=ddns();
use Date::Manip;
use CGI qw(:standard :html3);
use File::Find;
use File::Slurp;
my $r;
$r = shift if $ENV{MOD_PERL};
my $Q = new CGI($r);
my %param = $Q->param();
# TODO
if ($r){
foreach (split('&|;', $r->args)){
my($var,$val)= $_ =~ m!(.*)=(.*)!;
$param{$var}=$val;
}
}
$debug=$param{'debug'};
print $Q->header(-type=>'text/html',
-expires=>'-1day');
&main($Q,%param);
sub main{
my ($Q)=shift;
my (%param) = @_;
$rr++;
my $id=$param{'id'};
my $cmd=$param{'cmd'};
$id="mom" unless $cmd;
if ($id && $id eq 'mom'){
print mom();
}else{
$id="unknown" unless($id);
$cmd="ximg" if ($cmd eq 'img');
my $doe="print $cmd(\'$id\');";
err($doe) if $debug;
my $res=eval($doe);
print $@;
err($@);
print $@ if ($debug);
err($res);
print "(i:$ii e:$ee r:$rr)" if ($debug);
}
}
sub screenshots{
my @files;
my $dir="/www/gfx/screenshots/";
# @files=`find $dir -name thumb\-\*.png`;
@files=grep !/\.thumbnails\//, `find $dir -name thumb\-\*`;
chop (@files);
for my $i (@files){
$i =~ s!/www/!http://$ddns/!;
my $thumb=$i;
my $pic=$i;
$pic =~ s!thumb-!!;
print <
GROK
}
}
sub ximg{
use Image::Size;
my $id=shift;
my $i;
if ($id eq 'latest'){
$i=`find /www/gfx/ -name \*\.jpg |grep -v xvpics |tail --lines=1`;
chop ($i);
}else{
my @files=`find /www/gfx/ -name \*.jpg|grep -v xvpics`;
chop (@files);
$i=$files[rand(@files)];
}
my ($w,$h)=imgsize($i);
my $comment=jpg_comment($i);
my ($s,$mesg)=("","");
$mesg .= $w."x".$h;
if ($w > $h){
#$mesg .= " w=100%";
$s='width="100%"';
}else{
#$mesg .= " h=100%";
$s='height="90%"';
}
$i =~ s!/www/gfx/!/gfx/!;
my $title=$i;
$title =~ s!/gfx/!!;
my $tablewidth;
$tablewidth='width="100%"' unless ($id eq 'latest');
return <
GROK
}
sub mp3{
my $limit;
unless ($mpc){
$limit="15" unless $limit;
my %when=ff('mp3','nietterzake');
my @names = sort { $when{$b} <=> $when{$a}; } keys %when;
splice(@names, $limit); # discard older stuff
$mpc="
";
foreach my $i(@names){
my ($des,$length)=getmpi($i);
my $r = $i;
$r =~ s!/mp3/!/mp3/mpm/!;
my $re=toencode($r);
$re =~ s!%2F!/!g;
$des=~s!\&!\&!g;
$mpc.= <$des $length
GROK
}
$mpc.= "
";
}
print $mpc;
return "";
}
sub getmpi{
my ($file)=@_;
# use MPEG::MP3Info;
my ($des,$length);
# if $mp3desCache{$file}{
# $des=$mp3desCache{$file};
# }else{
# $des="todo$file";
# }
# my $tit=$tag->{TITLE} unless $warn;
# my $art=$tag->{ARTIST} unless $warn;
# my $minu=$info->{MM};
# my $secs=$info->{SS};
# $length="probalby prut";
# if ($minu||$secs){
# $secs="0".$secs unless($secs>9);
# $length="$minu:$secs";
# }
($des) = $file =~ m!.*/(.*)!;
$des=~ s!\.mp3$!!;
$length="";
return $des,$length;
}
sub com{
my ($id)=shift;
my $file="/www/XML/gist/$id.xml";
err("comment $id") if $debug;
# if (-e $file){
err( "li well");
my $domdoc=&domdoc($file);
err( " d ".$domdoc);
my @comment= $domdoc->getElementsByTagName('comment');
foreach my $c (@comment){
err(" spui($c); ");
print &spuicomment($c);
}
# }else{print " no file $file ";}
}
sub hmm{
my ($id)=@_;
my $rssfile="/www/XML/rss/$id.rss";
my $rsshtml="/www/stukjes/rss/$id";
my @fdate=stat $rssfile;
my @hdate=stat $rsshtml;
print $rsshtml,":",$hdate[9],"\n" if $debug;
print $rssfile,":",$fdate[9],"\n" if $debug;
if ($hdate[9] lt $fdate[9]){
# if ($hdate[9] gt $fdate[9]){
print "html older than rss, make html from rss please" if $debug;
update_rss_stukje($rssfile,$rsshtml,$id);
}else{
print "html up to date" if $debug;
}
open (ST,"<$rsshtml")||die "no such file $rsshtml: $!";
while (){print $_;}
close ST;
return "";
}
sub update_rss_stukje{
my ($rssfile,$rsshtml,$id)=@_;
use XML::RSS;
my $rss=new XML::RSS;
my $content;
my $file=$rssfile;
# print $file;
die "File \"$file\" does't exist.\n" unless -e $file;
# $rss->{'channel'}->{'title'}='';
# $rss->{'channel'}->{'link'}='';
# my $catt=`cat $file`;
#TODO
$rss->parsefile($file);
# warn "rss parse uicommented";
# $rss->parse($catt);
print "parsed" if $debug;
my $html = print_html($rss,$id);
open(ST,">$rsshtml")||die "$!";
print ST $html;
close ST;
return "";
# undef($rss);
}
1;
sub IGNORE { # don't notice these files
## $_[0] is basename, $_[1] is full path
return 1 if ($_[0] !~ /\.mp3/i);
return 1 if ($_[1] =~ /incoming/);
return 0;
}
sub ff{
use vars qw(%when);
my ($ext,$HOWMANY)=@_;
err("finding files..");
my (@TOP) = qw(/fire/mp3/);
#my (%when);
find (sub {
# return $File::Find::prune = 1 if PRUNE $_, $File::Find::name;
# return if PRUNE $_, $File::Find::name;
return unless -f; # only files
return if IGNORE $_, $File::Find::name;
$when{$File::Find::name} = (stat _)[9];
}, @TOP) ;
%when;
}
sub mom{
BEGIN{
srand (time() ^ ($$+($$<<15)));
my $file = "/www/Doc/etext/momus/*";
my $text = `cat $file`;
my $i=0;
my ($stext) = $text =~ /.+left>(.*)
/;
$text = $stext;
$text =~ s/
/ /g;
my(@lines) = split / / , $text;
foreach my $line (@lines){
$line =~ s/puntpuntpunt/\./g;
$text[$i]= $line;
$i++;
}
}
my $zin = $text[rand @text];
$zin =~ s/^ //g;
$zin;
}
sub bofh{
my $i=`fortune bofh-excuses`;
$i=~s/BOFH excuse #//g;
my ($n)=$i=~/(\d+:)/;
$i=~s/$n//;
chop $n;
my $r=<$i
GROK
$r
}
sub print_html {
my $rss = shift;
my $id= shift;
my $title=$rss->{'channel'}->{'title'};
$title="Bord" if ($title eq "Kwark plankje");
my $r = <
";
# if there's a textinput element
if ($rss->{'textinput'}->{'title'}) {
# print <
#$rss->{'textinput'}->{'description'}
#
#
#
#HTML
}
# if there's a copyright element
if ($rss->{'channel'}->{'copyright'}) {
$r .= <$rss->{'channel'}->{'copyright'}
HTML
}
$r .= <
xml
HTML
undef($rss);
$r =~ s!&!&!g;
return $r;
}
sub spuicomment{
my $c=shift;
my $r="";
my (%h);
foreach my $i ('date','name','email','url','text'){
my $v=&di($c,$i);
$v="$v" if ($i eq 'email' && $v);
$v="$v" if ($i eq 'url' && $v);
$r.= "
$i:
$v
\n" if ($v);
}
return <
$r
GROK
}
#
# --------------------- junk
#
# moved to jip.pm
sub voetold{
my $id=shift;
my ($r,$duri,$lfile,$uri);
$duri=$ENV{DOCUMENT_URI};
# foreach my $i (keys %ENV){print "$i= ",$ENV{$i},"\n ";}
#print "host:$duri";
my $httphost=$ENV{'HTTP_HOST'};
$lfile="/www$duri";
print $duri,$lfile if $debug;
#$uri="http://".ddns().$duri;
$uri="http://".$httphost.$duri;
my $chk=htmlcheck($uri);
my ($begun,$css)= lookup_page_begun($lfile);
my $date=`/bin/ls -lc $lfile`;
my ($moddate)= $date=~ /(\W\w+\s+\d+\s\d+\:\d+)/;
my $sname=$id;
#20020508,nedstat
my $nedstatdir="/www/stukjes/nedstat/";
my $nedstatfile=$nedstatdir . "$id";
my $nedstathtml="";
if (-r $nedstatfile){
open (FILE,"<$nedstatfile") || die "cannot open nedstatfile: $nedstatfile ($!)";
while (){
$nedstathtml .= $_;
}
}else{
$sname="indexhtml" if ($sname eq 'index');
$nedstathtml = <
GROK
}
#20020601, geen nedstat als ...
my $remotehost=$ENV{REMOTE_HOST};
# print "$remotehost";
if ($remotehost eq 'kort.xs4all.nl' || $remotehost eq 'localhost'){
$nedstathtml='';
#print "geen teller please";
}
print <