#!/usr/bin/perl #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 <screenshot $pic 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 <
Kwark > gfx > $title
$title $mesg \n [ k l i k f o r m e e r ]
$comment
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=""; } 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 = <

$title

HTML # print the channel items $r.= "
    "; foreach my $item (@{$rss->{'items'}}) { next unless defined($item->{'title'}) && defined($item->{'link'}); $r .= "
  • {'link'}\">$item->{'title'}
    • \n"; } $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 = <NedStat 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 <
Page by Jip
Modified: $moddate
Started: $begun 		Home || Index $nedstathtml
GROK # foreach my $i (keys %ENV){print "$i= ",$ENV{$i},"\n
";} return " "; } sub toencodeold{ my($toencode) = @_; $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub lastaccessold{ #localhost - - [30/Mar/2000:17:39:22 +0200] "GET / HTTP/1.0" 200 28856 "-" "Mozilla/4.72 [en] (X11; I; Linux 2.2.6 i586)" my @last=`tail --lines=3400 /var/log/apache/access_log|grep '"GET / HTTP/1.[10]"' |grep -v localhost|grep -v kort.xs4all.nl`; print "

lastaccess

\n
    \n"; foreach my $i(@last){ my($host,$time,$refer,$browser)=$i=~ m!(.*)\s-\s-\s\[(.*)\]\s\".*\"\s\d+\s\d+\s\"(.*)\"\s\"(.*)\"!; my ($day,$mon,$hour)=$time =~ m!(\d+)/(\w+)/\d+:(\d+:\d+):.*!; $time="$hour $day $mon"; $host=<$host GROK if ($refer ne '-'){ $refer =~ s!&!&!g; $refer =~ s!&!&!g; my $refert = $refer; $refert =~ s!&!&\n!g; $refer=<$refert GROK }else{$refer='';} $browser='' if ($browser eq '-'); print "
  • $time $host $refer $browser
    • "; } print "
"; return ''; }