#!/usr/bin/perl -w #
!!;
$html =~ s!\<\/p\>$!!;
$row->{'html'} = $html;
push @comments,$row
}
$csth->finish;
my $commentscount=@comments;
$l->{'comments'} = \@comments;
$l->{'commentscount'} = $commentscount;
#print Dumper($l);
}
# /comments
# hoofd?
#$l->{'hoofd'} = $server->gethoofd('gfx-test');
# voet
#$l->{'voet'} = voet2('plaatjes');
#
# 20040905 votes
#
use Vote;
my $vote = Vote->new( {about => $l->{'id'} ,} );
my @votes = $vote->{'votes'};
$l->{'votetotal'} = $vote->{'votetotal'};
#
# dirnames
# 20041224, try caching
# my @dirnames;
unless ($dirnames[1]){
my $query="
SELECT distinct dirname
FROM images
WHERE dirname LIKE '/gfx/%'
ORDER BY dirname
";
my ($sth,$error)=$server->doq($query);
while (my $row = $sth->fetchrow_hashref){
$row->{'dirname'} =~ s!/gfx!!;
push @dirnames,$row;
}
$sth->finish;
}
#20040611, next,cur,prev dirs
my $dirnumber='0';
my $curdirnumber='0';
foreach my $row(@dirnames){
#while ( my $row = $sth->fetchrow_hashref ){
#print $row->{'dirname'} . " -- " . $l->{'row'}->{'dirname'} ;
#print "
";
# ???????
if ($row->{'dirname'} && $l->{'row'}->{'dirname'}){
if ( $row->{'dirname'} eq $l->{'row'}->{'dirname'}
||
"/gfx". $row->{'dirname'} eq $l->{'row'}->{'dirname'}
){
$row->{'selected'} = 1;
$curdirnumber = $dirnumber;
}
}
$row->{'dirname'} =~ s!/gfx!!;
($row->{'sdirname'}) = $row->{'dirname'} =~ m!.*/(.*?)$!;
# push @dirnames,$row;
$dirnumber++;
}
# print " curdirnumber $curdirnumber ";
my @prevdir;
$prevdir[0] = $dirnames[$curdirnumber - 1];
my @curdir;
$curdir[0] = $dirnames[$curdirnumber];
my @nextdir;
$nextdir[0] = $dirnames[$curdirnumber + 1] if $dirnames[$curdirnumber];
# $l->{'dirnames'} = \@dirnames;
$l->{'prevdir'} = \@prevdir;
$l->{'curdir'} = \@curdir;
$l->{'nextdir'} = \@nextdir;
#
# /dirnames
#
#
# crumb
#
my @crumb;
my $dir = $l->{'row'}->{'dirname'};
my @dirs=split '/' , $dir;
my $cb = $server->{'config'}->{'hostname'};
my $gr = $Qselfs;
foreach my $i(@dirs){
my $c={};
my $d=$i;
my $ddi;
if ($i eq 'gfx'){
$gr = $Qselfs;
$d = 'Plaatjes';
$ddi = $gr;
}else{
$gr .= "/$i";
}
# print "[$i]";
# print $gr;
if ($i && $ddi && ($i eq $ddi) ){
$d = 'Kwark';
$ddi=$server->{'config'}->{'hostname'};
}
if ($i eq ''){
$d = 'Kwark';
$ddi=$server->{'config'}->{'hostname'};
$gr=$ddi;
}
$c->{'url'} = $gr;
$c->{'d'} = $d;
push @crumb,$c;
}
$l->{'crumb'} = \@crumb;
# 200602 topsearches
my @topsearchterms = $l_obj->topsearchterms();
$l->{'topsearchterms'} = \@topsearchterms;
#
# 15 hits
#
my $getlastloginc = {
'imageid' => $l->{'row'}->{'serial'},
'about' => $l->{'row'}->{'id'},
};
my @hitsa = @{Lok::getlastlog($getlastloginc)};
foreach my $hrow( @hitsa ){
# refer
if ( $hrow->{'http_referer'} ){
$hrow->{'http_refererd'} = $server->toencode( $hrow->{'http_referer'} );
$hrow->{'http_refererd'} = $server->spacify( $hrow->{'http_referer'} );
$hrow->{'http_referer'} =~ s!&!&!g;
$hrow->{'http_referer'} =~ s!&!&!g;
$hrow->{'http_refererd'} =~ s!&!&!g;
$hrow->{'http_refererd'} =~ s!&!&!g;
}
#host
if ( $hrow->{'remote_host'} ){
$hrow->{'remote_hostd'} = $server->toencode( $hrow->{'remote_host'} );
$hrow->{'remote_hostd'} = $server->spacify( $hrow->{'remote_host'} );
$hrow->{'remote_host'} =~ s!&!&!g;
$hrow->{'remote_host'} =~ s!&!&!g;
}
}
$l->{'hitsa'} = \@hitsa;
$l->{'totalhits'} = $l_obj->totalhits;
#
# / 15 hits
#
# ajaxy word
my $pjx = CGI::Ajax->new( 'myfunc' => '/x/2006/test-ajax-word.pl',
'search' => '/x/2006/test-ajax-word.pl',
'addword' => '/x/2006/test-ajax-word.pl',
'delword' => '/x/2006/test-ajax-word.pl',
'personsearch' => '/x/2006/test-ajax-word.pl',
'addperson' => '/x/2006/test-ajax-word.pl',
'delperson' => '/x/2006/test-ajax-word.pl',
);
$pjx->cgi( $q );
$l->{'extrajavascript'} = $pjx;
# /ajaxy word
# mangle lastupdate
$l->{'row'}->{'lastannotated'} = UnixDate(ParseDate($l->{'row'}->{'lastannotated'}), "%Y-%m-%d %H:%M %Z");
$l->{'lastannotated'} = $l->{'row'}->{'lastannotated'};
my $cachefilltime = sprintf("%01.3f", tv_interval ( $begin, [gettimeofday]));
$l->{'cachefilltime'} = $cachefilltime;
$cachemisses++;
#
# write cache
#
my $valid=3 * 7 * 24 * 60 * 60;
# we houden gecachede zaken lekker lang vast ... --sjoerd, di mrt 22 11:15:44 CET 2022
$valid = $valid * 1000;
my $cachetimeout = $valid + int(rand($valid)) + 300;
$cache->set( $filee, $l, "$cachetimeout");
#warn "cache filled in $cachefilltime seconds for $filee valid for $cachetimeout";
$goedeurl = $l->{'row'}->{'xurl'};
if( $q->param('update') ){
warn "update redir to $goedeurl";
redirect($goedeurl . "?" . int(rand(10000000000)));
exit;
}
my $remote = $ENV{REMOTE_HOST} ||$ENV{REMOTE_ADDR} || '' ;
warn "generating $remote $filee $mimetype";
} else {
#
# we komen uit de cache hiephiep
#
$l->{'fromcache'} = 1;
$l->{'fromcachespeedup'} = sprintf("%01.1f", $l->{'cachefilltime'} / tv_interval ( $begin, [gettimeofday]) );
$cachehits++;
my $ratio = "$cachehits/$cachemisses";
my $remote = $ENV{REMOTE_HOST} ||$ENV{REMOTE_ADDR} || '' ;
# sjoerd, Sun Mar 1 10:53:52 CET 2009, uitgezet omdat dit geen errorsituatie is maar een indicatie van de cache performance
# warn $l->{'fromcachespeedup'} . "x speedup hitratio $ratio $remote $filee $mimetype";
}
# done caching
#-----------------------------------------------------------
# redir
$goedeurl = $l->{'row'}->{'xurl'};
# redirect rdf trash url
if ($q->param('tmpl') && !$q->param('autonext')
&& $q->param('tmpl') =~ m!foaf!
&& $l->{'row'}->{'rdfurl'}
){
my $goederdfurl = $l->{'row'}->{'rdfurl'};
warn 'rdftrashurl: ' . $Qself . ' goedeurl: ' . $goederdfurl;
print $q->redirect(
-location => $goederdfurl,
-status => 301,
);
exit;
}
my $redirect = 0;
if ($q->param('tmpl')
&& $q->param('tmpl') =~ m!foaf!
&& $q->param('autonext')
){
$redirect = 1;
}
if ($q->param('autonext') && $Qself =~ /foaf/){
$redirect = 1;
}
if ($Qself =~ m/foaf/ && $Qself =~ m!tmpl!){
$redirect =1;
}
if ($redirect){
warn 'trashurl: ' . $Qself . ' goedeurl: ' . $goedeurl;
unless ($goedeurl){
# not found
header(-status => 404);
warn "geen xurl \'$Qself\'";
exit 1;
}
print $q->redirect(
-location => $goedeurl,
-status => 301,
);
exit;
}
# all image props in tmpl
for my $var (keys %{$l->{'row'}} ){
#print $var;
if ($var eq 'lastannotated' && $l->{'row'}->{$var} ){
# TODO
#warn $l->{'row'}->{$var};
$l->{'row'}->{$var} =~ s!^(\d+-\d+-\d+)\s(\d)!$1T$2!;
}
$tmpl->param( $var => $l->{'row'}->{$var} );
}
# alle cgi param
for my $var ( $q->param ){
#print $var;
my $x='cgi_' . $var;
my $val= $q->param($var);
$tmpl->param( $x => $val );
if ($var eq 'autonext'){
$tmpl->param( autonextd => $val . "s" );
$tmpl->param( autonext => $val );
}
}
#voet hoof
# hoofd?
$gfxhoofd = $server->gethoofd('gfx-test') unless $gfxhoofd;
$l->{'hoofd'} = $gfxhoofd;
# voet
$gfxvoet = voet2('plaatjes') unless $gfxvoet;
$l->{'voet'} = $gfxvoet;
my $end=[gettimeofday];
$l->{'elapsed'} = sprintf("%01.3f", tv_interval ( $begin, $end ));
$l->{'running'} = int(sprintf("%01.3f", tv_interval ( $start, $end )));
$tmpl->param($l);
$tmpl->param(
usecount => $usecount,
qselfs => $Qselfs,
qself => $Qself,
filee => $filee,
ufile => $ufile,
);
print $q->header(-type => $mimetype,
-expires => '+96hours' ,
-charset =>'UTF-8');
print $server->compact( $tmpl->output );
my $logres = Lok::newhit($l->{'row'}->{'serial'} , $l->{'about'});
#warn "$filename $Qselfs $filee";
undef $l;
# kla.