package jip; #jip.pm # # # # use Carp; #20020913 global config var use vars qw(@ISA @EXPORT $debug $ddns $stukjehead %config); require Exporter; require DynaLoader; require AutoLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(last imgdes lastaccess voet hoofd lookup_page_begun htmlcheck jpg_comment err mkclean ddns toencode d2moch d2uur d2hum domdoc di imgsiz getfiles exif_data getconfig _getexif getfileswhen voet2 ) ; use strict; use Date::Manip; use Image::Size; use Storable; sub getconfig{ #20020814 my $file='/www/bin/x/gfx.conf'; return %config if %config; my %config; open (FILE,"<$file")||die "cannot open config $file $!"; LINE: while (){ my $line=$_; next LINE if $line =~ m!^#!; my ($var,$val)= $line =~ m!(.*)=(.*)!gics; next LINE unless ($var&&$val); $val=~ s!\n$!!gis; if ($var&&$val){ $config{$var}=$val; } } if ($debug){ print " configfile [$file] "; foreach my $var(keys %config){ my $val=$config{$var}; print " $var: [$val] "; } print " br "; } return %config; } sub getfiles{ # 20020913, wrapper voor getfileswhen() my ($file)=@_; print " getfiles($file) " if $debug; my %config=getconfig(); my $cachedir=$config{'cachedir'}; print " cachedir: $cachedir " if $debug; my $filem="when." . $file . ".cache" ; $filem=~ s!//!/!gis; $filem=~ s!/!_!gis; my $findcache=$cachedir . "/" . $filem; print " findcache: $findcache " if $debug; my %when; if (-e $findcache){ print " cache bestaat. " if $debug; %when = %{ retrieve($findcache) }; }else{ print " cache bestaat niet. " if $debug; %when=getfileswhen($file); store(\%when, $findcache); } return %when; } sub getfileswhen{ my ($file)=@_; warn " getfiles($file) "; my %when; use File::Find; find (sub { return unless -f; return if (-d $File::Find::name); return if ($_ =~ /rdf/); return if ($File::Find::name =~ /\.xvpics/); return if ($File::Find::name =~ /\.html/); return if ($File::Find::name =~ /thumb/); return if ($File::Find::name =~ /\.pl$/); return if ($File::Find::name =~ /Small/); return if ($File::Find::name =~ /\.xml$/); return if ($File::Find::name =~ /orig/); return if ($File::Find::name =~ /\.mpg$/); return if ($File::Find::name =~ /\.yuv$/); return if ($File::Find::name =~ /\~$/); return if ($File::Find::name =~ /README/); return if ($File::Find::name =~ /follow\//); return if ($File::Find::name =~ /\.sh$/); return if ($File::Find::name =~ /index.png/); return if ($File::Find::name =~ /\.db$/i); $when{$File::Find::name} = (stat _)[9]; },$file) || print " Error: getfileswhen($file) $!"; unless(%when){ warn " warning:getfileswhen($file) is empty "; } return %when; } sub imgsiz{ my $file=shift; my %size; # $debug=1; my %config=getconfig(); my $cachedir=$config{'cachedir'}; print " cachedir: $cachedir " if $debug; my $filem="size.$file.cache"; $filem=~ s!//!/!gi; $filem=~ s!/!_!gis; my $findcache=$cachedir . "/" . $filem; print " sizecache:$findcache " if $debug; if (-e $findcache){ print " cache bestaat. " if $debug; %size = %{ retrieve($findcache) }; }else{ print " cache bestaat niet. " if $debug; my ($w,$h)=imgsize($file); $size{'w'}=$w; $size{'h'}=$h; store(\%size, $findcache); } return $size{'w'},$size{'h'}; } sub imgdes{ my $file=shift; # $debug=1; my %config=getconfig(); my $cachedir=$config{'cachedir'}; print " cachedir: $cachedir " if $debug; my $filem="description.$file.cache"; $filem=~ s!//!/!gis; $filem=~ s!/!_!gis; my $findcache=$cachedir . "/" . $filem; print " descriptioncache:$findcache " if $debug; my $des; if (-e $findcache){ print " cache bestaat. " if $debug; $des = ${ retrieve($findcache) }; }else{ print " cache bestaat niet. " if $debug; $des=jpg_comment($file); $des = "" if ($des=~/LEAD/); if ($des =~ /rdf:RDF/){ $des =~ s!<\?xml version.*#image">!!gs; $des =~ s!(.*)<\/s\d:.*>!$1: $2!g; $des =~ s!<\/rdf:Description>.*!!gs; # mangle rdf my $de; $des =~ s!<\?xml version.*#image">!!gs; $des =~ s!(.*)<\/s\d:.*>!$1: $2!g; ($de)=$des=~ /Title:(.*?)\n/s; $des=$de; } $des =~ s!\n!
\n!g; $des="" if ($des =~ /Created\s+with\s+The\s+GIMP/) ; $des="" if ($des =~ /gPhoto2/) ; $des="" if ($des =~ /CREATOR/) ; $des="" if ($des =~ /XV/); $des="" if ($des =~ /LEAD/); $des="" if ($des =~ /Adobe/); $des=$des." "; store(\$des, $findcache); } $des=~ s!\s$!!gis; $des=~ s!^\s!!gis; return $des; } sub last{ my $t=shift; my $r; print "
$t
" if $debug; my @last=`tail --lines=93400 /var/log/apache/access_log|grep '"GET /$t HTTP/1.[10]"' |grep -v localhost|grep -v kort.xs4all.nl`; # my @last=`tail --lines=93400 /var/log/apache/access_log|grep '"GET /[Gf]fx/$t HTTP/1.[10]"' |grep -v localhost|grep -v utr.casema.net`; return unless (@last); $r="
    "; foreach my $i(@last){ my($host,$refer,$browser)=$i=~ m!(.*)\s-\s-\s\[.*\]\s\".*\"\s\d+\s\d+\s\"(.*)\"\s\"(.*)\"!; $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 '-'); $r .= "
  • $host $refer $browser
    • "; } $r .= "
"; return $r; return $t; } sub lastaccess{ my $t=shift; my $r; print "
$t
" if $debug; my @last=`tail --lines=93400 /var/log/apache/access_log|grep '"GET /gfx/$t HTTP/1.[10]"' |grep -v localhost|grep -v utr.casema.net`; # my @last=`tail --lines=93400 /var/log/apache/access_log|grep '"GET /[Gf]fx/$t HTTP/1.[10]"' |grep -v localhost|grep -v utr.casema.net`; return unless (@last); $r="
    "; foreach my $i(@last){ my($host,$refer,$browser)=$i=~ m!(.*)\s-\s-\s\[.*\]\s\".*\"\s\d+\s\d+\s\"(.*)\"\s\"(.*)\"!; $refer=" " unless $refer; $browser=" " unless $browser; $host=" " unless $host; $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 '-'); $r .= "
  • $host $refer $browser
    • "; } $r .= "
"; return $r; return $t; } sub lastaccesstmp{ my $ding=shift; my $r; my @last=`tail --lines=3400 /var/log/apache/access_log|grep '"GET /$ding HTTP/1.[10]"' |grep -v localhost|grep -v utr.casema.net`; return unless (@last); $r .= "

lastaccess

\n
    \n"; } sub voet{ my $id=shift; my ($r,$duri,$lfile,$uri); #20020510, foot voor scripts en include # $debug=1; $duri=$ENV{DOCUMENT_URI}; $lfile=$ENV{SCRIPT_FILENAME} unless ($duri); $duri=$ENV{SCRIPT_NAME} unless $duri; my $srcipt; my $slfile=$ENV{SCRIPT_FILENAME}; if ($slfile){ $slfile=~ s!/www!!; $srcipt =<$slfile GROK } $srcipt="
    $srcipt
    " if $srcipt; $lfile="/www$duri" unless $lfile; print " duri:$duri lfile:$lfile " if $debug; $uri="http://".ddns().$duri; my $chk=htmlcheck($uri); my ($begun,$css)= lookup_page_begun($lfile); my $date=`/bin/ls -lc $lfile`; #20020809,datum modified my $statmod= (stat($lfile))[9]; my $moddate=d2hum($statmod); #my ($moddate)= $date=~ /.*(\W\w+\s+\d+\s\d+).*/gcs; my $sname=$id; print " date:$date moddate:$moddate " if $debug; #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){ if ($remotehost eq 'kort.xs4all.nl' || $remotehost eq 'localhost' || $remotehost eq 'ns.iway.nl' || $remotehost eq 'mail.tesseractic.com' || $remotehost eq 'mail.iway.nl' || $remotehost eq '213.84.2.175' || $remotehost eq 'a213-84-2-175.adsl.xs4all.nl' || $remotehost eq 'kwark.org' || $remotehost eq 'mail.xitix.nl' ){ $nedstathtml=''; #print "geen teller please"; } } # 20051020, nooit meer nedstat $nedstathtml = ''; # 200511 analytics $nedstathtml = < GROK print <
    Page by Jip
    Modified: $moddate
    Started: $begun $srcipt     		kwark $nedstathtml
    GROK # foreach my $i (keys %ENV){print "$i= ",$ENV{$i},"\n
    ";} return " "; } sub voet2{ my $id=shift; my ($r,$duri,$lfile,$uri) = ('','','',''); # print " voet2($id) "; #20020510, foot voor scripts en include # $debug=1; $duri=$ENV{DOCUMENT_URI}; $lfile=$ENV{SCRIPT_FILENAME} unless ($duri); $duri=$ENV{SCRIPT_NAME} unless $duri; my $srcipt; my $slfile=$ENV{SCRIPT_FILENAME}; if ($slfile){ $slfile=~ s!/www!!; $srcipt =<$slfile GROK } $srcipt="
    $srcipt
    " if $srcipt; $lfile="/www$duri" unless $lfile; print " duri:$duri lfile:$lfile " if $debug; $uri="http://".ddns().$duri; my $chk=htmlcheck($uri); my ($begun,$css)= lookup_page_begun($lfile); my $date=`/bin/ls -lc $lfile`; #20020809,datum modified my $statmod= (stat($lfile))[9]; my $moddate=d2hum($statmod); #my ($moddate)= $date=~ /.*(\W\w+\s+\d+\s\d+).*/gcs; my $sname=$id; print " date:$date moddate:$moddate " if $debug; #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){ if ($remotehost eq 'kort.xs4all.nl' || $remotehost eq 'localhost' || $remotehost eq 'ns.iway.nl' || $remotehost eq 'mail.tesseractic.com' || $remotehost eq 'mail.iway.nl' || $remotehost eq '213.84.2.175' || $remotehost eq 'a213-84-2-175.adsl.xs4all.nl' ){ $nedstathtml = ''; # print "geen teller please $nedstathtml"; } } # 20051020, nooit meer nedstat #2 $nedstathtml = ''; # 2005 analytics $nedstathtml = < GROK return <
    Page by Jip
    Modified: $moddate
    Started: $begun $srcipt     		kwark $nedstathtml
    GROK } sub voetold{ my $id=shift; my ($r,$duri,$lfile,$uri,$srcipt); $duri=$ENV{DOCUMENT_URI}; $lfile=$ENV{SCRIPT_FILENAME} unless ($duri); $duri=$ENV{SCRIPT_NAME} unless $duri; my $slfile=$ENV{SCRIPT_FILENAME}; if ($slfile){ $slfile=~ s!/www!!; $srcipt =<$slfile GROK } $srcipt.="
    "; $lfile="/www$duri" unless $lfile; print $duri,$lfile if $debug; $uri="http://".ddns().$duri; my $ddns=ddns(); my $chk=htmlcheck($uri); my ($begun,$css)= lookup_page_begun($lfile); my $date=`/bin/ls -lc $lfile`; #print " $lfile $date "; my ($moddate)= $date=~ /(\W\w+\s+\d+\s\d+\:\d+)/; my $sname=$id; $sname="indexhtml" if ($sname eq 'index'); $r= <
    Page by Jip
    $srcipt Modified: $moddate
    Started: $begun     		Home || Index NedStat
    GROK # foreach my $i (keys %ENV){print "$i= ",$ENV{$i},"\n
    ";} return $r; } sub lookup_page_begun{ my($file) = @_; my $head=""; my $begun=""; my $css=""; if (open(IN, "<$file")) { line: while () { $head .= $_; if ( m!!i; ($css)= $head =~ m! Kwark > $id $stukjehead GROK $r; } sub htmlcheck{ my $i=shift; my $nameu=toencode($i); my $htmlhelp="http://www.htmlhelp.com/cgi-bin/validate.cgi?url=$nameu&input=yes"; return $htmlhelp; } sub toencode{ my($toencode) = @_; $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub mkclean{ my $r=shift; $r =~ s/\&/\&/g; $r =~ s/\&/\&/g; $r; } sub ddns{ return "www.kwark.org"; } sub d2uur{ my ($d)=shift; return &UnixDate($d,"%H:%M"); } sub d2moch{ my ($d)=shift; return &UnixDate($d,"%Y%m%d%H.%M"); } sub d2hum{ my ($d)=shift; my $dd=scalar localtime $d; my $ddd=ParseDate($dd); return &UnixDate($dd,"%a %e %b %Y %H:%M"); } # geen idee waarvoor domdoc sub domdocold{ my $file=shift; my $parser = new XML::DOM::Parser; my $r; # eval ($r=$parser->parsefile ("$file") || die "Cant domopen file $file $!\n"); $r=$parser->parsefile("$file"); # print $@; $r; } sub domdoc{ my $file=shift; my $parser; if ($parser) { err( "parserda ") if ($debug); } else { $parser = new XML::DOM::Parser; err( "created domparser: ".$parser) if($debug); } $parser->parsefile ("$file") || die "Cant domopen file $file $!\n"; } sub di{ my $user=shift; my $tagname=shift; my $re; my $t = $user->getElementsByTagName("$tagname"); my $ar=$t->[0]; print "$tagname" if $debug; my $arr=$ar->getFirstChild if $ar; $re = $arr->getData if $ar; $re; } sub err{ my $i=shift; print "$i
    \n" if $debug; } sub jpg_comment{ my $file=shift; my ($filec,$comment); $comment = `/usr/local/bin/rdjpgcom \"$file\" 2>/dev/null`; $comment=~ s/\s*$//g; $comment=~ s/\n$//; $comment; } # TODO siz des th sub exif_data{ my $file=shift; unless ($file =~ m!ds!i){ return; } my $self=1; return cachethingy($self,'exif',$file); # return _getexif($self,$file); } sub cachethingy{ my $self=shift; my $name=shift; my $file=shift; #$debug=1; unless ($self && $name && $file){ die "cache fout"; }else{ # warn "$self $name $file"; } my $r; #config TODO in self my %config=getconfig(); my $cachedir=$config{'cachedir'}; print " cachedir: $cachedir " if $debug; #uni name my $filem="$name.$file.cache"; $filem=~ s!//!/!gis; $filem=~ s!/!_!gis; my $cachefile=$cachedir . "/" . $filem; print " cachefile:$cachefile " if $debug; # haal if (-e $cachefile){ print " cache bestaat. " if $debug; $r= ${ retrieve($cachefile) }; # of maake }else{ print " cache bestaat niet. " if $debug; # TODO size des exif thumb $r=_getexif($self,$file); store(\$r, $cachefile); } return $r; } sub _getexif{ my ($self,$file)=@_; unless ($file){ die " _getexif() file not defined. "; } my $exif = `/usr/bin/jhead \"$file\" 2>/dev/null`; #return $exif; if ($exif =~ m!time!){ # print $exif; my ($date) =$exif =~ m!Date/Time.*?:.*?(.*?)\n!s; #ISO equiv. : 100 my ($iso) =$exif =~ m!ISO\sequiv\..*?:.*?(.*?)\n!s; #Aperture : f/3.4 my ($a) =$exif =~ m!Aperture.*?:.*?(.*?)\n!s; # Exposure time: 0.070 s (1/14) my ($s) =$exif =~ m!Exposure\stime.*?:.*?(.*?)\n!s; #Focal length : 7.8mm my ($l) =$exif =~ m!Focal\slength.*?:.*?(.*?)\n!s; #Flash used : No my ($flash)=$exif =~ m!Flash used.*?:.*?(.*?)\n!s; my $f=''; if ($flash =~ /Yes/){ $f="with flitser"; } # mm mangle if ($l =~ m!^(.+)mm$!){ my ($mm)=$l=~ m!^(.+)mm$!; # if ($mm < 33){ $mm = $mm * 4.84; $mm = sprintf("%d",$mm); $l=$mm . "mm"; # } } # shutter mangle my ($ss)= $s =~ m!\((.*?)\)!; $s=$ss if $ss; $s=~ s!s!!; $s=~ s!\n*$!!; $s=~ s!\s*$!!; $iso=~ s!^\s+!!; $iso=~ s!\s+$!!; # date mangle $date=~ s!\s+$!!; $date=~ s!\:\d\d$!!; my ($y,$m,$d,$H,$M)=$date=~ m!(\d+):(\d+):(\d+)\s(\d+):(\d+)!; $date = "$d-$m-$y $H:$M"; # warn $exif; $exif = "$date ISO"."$iso $s". "s $a $l $f"; # print "exif:$exif"; return $exif; }else{ return; } } 1;