#!/usr/bin/perl
#
#gfx.pl
#
#
# pip at dds dot nl
#
package lsplaatjes;
# libs
BEGIN{
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
use Date::Manip;
use strict;
use jip;
use Lok;
use Person;
use Word;
use Vote;
use Location;
use Data::Dumper;
use CGI;
use Server;
}
my $timestart=[gettimeofday];
# cgi
my $q=new CGI;
# server
my $server=Server->instance();
# START: even faken dat dit nog wat doet ...
# di nov 3 15:04:01 CET 2020
$mimetype = 'text/xml';
print $q->header(-type => $mimetype,
-expires => '+34hours',
-status=> '204 No Content'
-charset => 'UTF-8');
# print "ac39fffefe3131";
exit;
# END: even faken dat dit nog wat doet ...
#
# cgi params
#
my $action = $q->param('action');
#my $cgitmpl = $q->param('tmpl') || 'image-lsgfx2';
my $cgitmpl = $q->param('tmpl') || 'lsgfx';
my $type = $q->param('type');
my $update = $q->param('update');
my $mimetype= 'text/html';
if ($type eq 'rss'){
$cgitmpl = 'image-lsgfx-rss';
}
if ( $cgitmpl eq 'image-lsgfx-rss' ){
$type='rss';
}
my $num = int( $q->param('num') ) || 99;
my $vier = $q->param('400') || '';
my $maxnum = '100';
$maxnum = '10000' if $type eq 'rss';
$num = $maxnum if ($num > $maxnum);
my $offset = $q->param('off') || $q->param('start') || 0;
$offset = int($offset);
my $woc = $q->param('woc') || '';
my $que = $q->param('q') || $q->param('que') || '';
my $qque = $server->quote( $que );
my $random = $q->param('random') || '';
#
# /cgi params
#
# header
my $mimetype = 'text/html';
if ($type eq 'rss'){
$mimetype = 'text/xml';
}
print $q->header(-type => $mimetype,
-expires => '+34hours',
-charset => 'UTF-8');
# vars
my $qself = $q->self_url;
my $qselfs = $q->url;
my $debug=0;
my $msg='';
if ($update){
$qself =~ s!\?update=$update$!!;
warn "update $qself";
}
#20060206
my $cache = new Cache::FileCache({namespace => 'ylsgfx'} );
my $r = $cache->get( $qself );
if ( (not defined $r) || $update){
warn "do $qself";
#
# alle rest
#
# template
my $tmpl=$server->gettemplate($cgitmpl);
my $hoofd=hoofd('lsgfx');
my $voet =voet2('lsgfx');
$tmpl->param( 'actionis_' . $action => $action,
'action' => $action,
hoofd => $hoofd,
voet => $voet,
random => $random,
);
#
# qwhere
#
my $qwhere="
LEFT JOIN location AS l on l.about = images.id
WHERE filename IS NOT NULL
";
$qwhere .="
AND images.comment IS NOT NULL
" unless $woc;
$qwhere .= "
AND (
images.comment ~* $qque OR
images.filename ~* $qque OR
images.dirname ~* $qque
OR locationname ~* $qque
)
" if $que;
$qwhere .= "
AND images.dirname NOT LIKE \'/gfx/Patrick%\'
";
#
# /qwhere
#
#
# total found images
#
my $tquery="
SELECT count(images.id) as count FROM images
$qwhere
";
my ($tsth,$terr)=$server->doq($tquery);
print $terr if $terr;
my $trow =$tsth->fetchrow_hashref;
my $total = $trow->{'count'};
$tmpl->param(
total => $total,
tquery => $tquery
);
#
# /total images
#
#
# check
#
my $geenouderemeer;
if ($offset + $num > $total){
$geenouderemeer = 1;
}
my $maxoffset = $total - $num;
# print " off:$offset tot:$total num:$num maxoffset:$maxoffset";
if ($offset > $maxoffset || $offset < 0){
$offset = $maxoffset;
$geenouderemeer = 1;
}
#???
if ($offset < 0){
$offset = 0;
$geenouderemeer = 1;
}
#
# /check
#
#
# query
#
my $query="
SELECT *,images.id as id FROM images
$qwhere
ORDER BY images.filedate desc
LIMIT $num
OFFSET $offset
";
# print $query;
$tmpl->param(query => $query);
my ($sth,$err)=$server->doq($query);
print $err if $err;
#
# /query
#
#
# random
#
my $rquery="
SELECT *
FROM images
WHERE filename IS NOT NULL
AND width > 48
AND height > 48
AND dirname NOT LIKE \'/gfx/Patrick%\'
ORDER BY random()
LIMIT 1
";
my ($rsth,$rerr)=$server->doq($rquery);
print $rerr if $rerr;
my $rrow=$rsth->fetchrow_hashref;
#print Dumper($rrow);
my $randoml=Lok->new( $rrow->{'id'} );
my @randomimages;
push @randomimages , $randoml->{'row'} ;
$tmpl->param( randomimages => \@randomimages );
#
# /random
#
#
# loop images found
#
my @images;
my $lastweek = '';
my $lastday = '';
my $persons; # hash voor personen
my $words; # hash voor words
while (my $row=$sth->fetchrow_hashref){
# print Dumper($row);
my $l = Lok->new($row->{'id'} );
my $lr= $l->{'row'};
# $lr->{'dump'} = Dumper($lr);
#print $lr->{'dump'} = Dumper($lr);
#print Dumper($lr);
my $dm= ParseDate( $lr->{'filedate'} );
my $weeky=&UnixDate($dm,"%Y-%U ");
my $year=&UnixDate($dm,"%Y");
my $week=&UnixDate($dm,"%U");
my $newweek='';
$newweek=$weeky unless($weeky eq $lastweek);
$lastweek=$weeky;
# my $datum=&UnixDate($dm,"%e %b %Y");
my $datum=&UnixDate($dm,"%e %B");
my $day=&UnixDate($dm,"%A");
my $newday='';
$newday=$day unless($day eq $lastday);
if ($newday){
my @dlet;
foreach my $let ( split '' , $day ){
# print "let:$let";
my $h;
$h->{'let'} = $let;
push @dlet,$h;
}
while ( @dlet < 9){
push @dlet , { 'let' => ' ', } ;
}
$lr->{'dlet'} = \@dlet;
}
$lastday=$day;
$lr->{'datum'} = $datum;
$lr->{'day'} = $day;
$lr->{'year'} = $year;
$lr->{'week'} = $week;
$lr->{'newweek'} = $newweek;
$lr->{'newday'} = $newday;
$lr->{'400'} = $vier;
# person
my $depicts = new Person( { lok => $lr } );
foreach my $person ( @{$depicts} ){
my $nick=$person->{'nick'};
$persons->{$nick} = $person;
}
$lr->{'depicts'} = $depicts;
# /person
#vote
my $vote = Vote->new( {about => $lr->{'id'} ,} );
my @votes = $vote->{'votes'};
#warn Dumper(@votes);
#my $t=[];
#$t = @votes;
#$lr->{'votes'} = [ {la=>'la'}, {la=>'la'}];
$lr->{'votetotal'} = $vote->{'votetotal'};
#/vote
# location
my $loc=Location->new( $lr );
unless ( $loc->{'lat'} && $loc->{'lon'} ){
$lr->{'nolocation'} = 1;
}else{
$lr->{'haslocation'} = 1;
$lr->{'lat'} = $loc->{'lat'};
$lr->{'lon'} = $loc->{'lon'};
$lr->{'locationname'} = $loc->{'locationname'};
}
# /location
# word 200312
my $word = Word->new( $lr->{'id'} );
if ( $word->{'words'} ){
my @awords;
foreach my $w (@{$word->{'words'} }){
my $row={};
my ($sw) = $w =~ m!1\.6/(.*?)$!;
$row->{'word'} = $w;
$row->{'sword'} = lc($sw);
$words->{$sw} = $row;
push @awords, $row;
" word:$w \n";
}
$lr->{'words'} = \@awords;
}
# 2006
# TODO cleanup, remove word1
my ($word2,$wlastupdated) = Word->getwords({imageid => $l->{'serial'},
about => $l->{'id'},
}
);
my @arr;
$lr->{'words2'} = \@arr;
if ($word2){
$lr->{'words2'} = $word2;
$lr->{'words'} = $word2;
}
# /word
# 400
my $maxvier=1000;
$vier = $maxvier if ($vier > $maxvier);
if ( $vier > 1 ){
$lr->{'displaywidth'} = $vier / 400 * $lr->{'displaywidth'};
$lr->{'displayheight'} = $vier;
}
# /400
push @images,$lr;
}
#
# /loop images found
#
$tmpl->param( images => \@images );
# persons
my @coperson;
foreach my $var(sort keys %{$persons} ){
push @coperson,$persons->{$var};
}
$tmpl->param( coperson => \@coperson );
# /persons
# words
if ($words){
my @coword;
#print Dumper($words);
foreach my $var(sort keys %{$words} ){
push @coword, $words->{$var} ;
}
$tmpl->param( coword => \@coword );
}
# /words
# totalimages
my $l = Lok->new( '/gfx/jip.png' );
my $totalimages = 1;
if ($l){
$totalimages = $l->totalimages;
}
# access
my $la = Lok->new( '/gfx/Icons/jip.kijkt.jpg' );
my @hits = @{$la->updateaccess( {onlywithrefer => 1,} ) };
my $totalhits = $la->totalhits;
#print Dumper(@hits);
my $refer=$ENV{'HTTP_REFERER'};
if ($refer){
my $refersearch = $server->url2search($refer);
#my ($refersearch) = $refer =~ m!q=(.*?)&!;
#$refersearch =~ s!\+! !g;
my $msg .= " referersearch:$refersearch ";
$tmpl->param( refer => $refer,
msg => $msg,
refersearch => $refersearch,
);
}
#
# end
#
my $end=[gettimeofday];
my $elapsed = tv_interval ( $timestart , $end );
$elapsed = sprintf("%01.3f", $elapsed);
#
# /end
#
#
# spui
#
$tmpl->param( elapsed => $elapsed,
num => $num,
off => int( $offset ),
offset => int( $offset ),
offsetminlimit => int($offset) - int($num),
offsetpluslimit => int($offset) + int($num),
woc => $woc,
q => $que,
totalimages => $totalimages,
totalminoff => $total - $offset,
totalminoffminnum => $total - $offset - $num + 1,
geenouderemeer => $geenouderemeer,
totalminoffplus1 => $total - $offset + 1,
totalminoffplus1pluslimit => $total - $offset + 1 + $num,
totalhits => $totalhits,
400 => $vier,
qself => $qself,
qselfs => $qselfs,
hits => \@hits,
rbcolor => $server->rbcolor,
rdcolor => $server->rdcolor,
rcolor => $server->rcolor,
);
my $output = $tmpl->output;
$r = $server->compact($output);
$cache->set($qself, $r, 7 * 24 * 60 * 60);
warn 'caching lsgfx ' . $qself;
#
# Kla.
#
} # kla with alles
print $r;