#!/usr/bin/perl -w

#<head><title>gfx-test.pl</title>
#<meta name="category" content="pl,perl">
#<meta name="description" content="A scriptje to look naar plaatjes.">
#<meta name="begun" content="Mei 2003">
#</head>

# TODO use strict;

package Kwark::Gfx;

# libs
BEGIN{
  use strict;
  use jip;
  use Date::Manip;
  use CGI qw(:standard :html3);
  use CGI::Ajax;
  use File::Find;
  use Server;
  use Lok;
  use Data::Dumper;
  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
  use Text::Textile qw(textile);
}

# globals; cache dirnames in global var
use vars qw($G $L $debug  $start @dirnames $usecount $cachehits $cachemisses $gfxhoofd $gfxvoet);

$usecount++;
$cachehits   = 0 unless $cachehits;
$cachemisses = 0 unless $cachemisses;
$start       = [gettimeofday] unless ($start);

my $begin=[gettimeofday];

my $apacher;
$apacher   = shift if $ENV{MOD_PERL};
my $q      = new CGI($apacher);
my $Qself  = $q->self_url;
my $Qselfs = $q->url;

# hmm lok lok
$debug=$q->param('debug');
$G="/Gfx";
#$G="/x/gfx2.pl";
$L="/www/gfx";

# mimetype
my $mimetype='text/html';
if ( $q->param('tmpl') && $q->param('tmpl') =~ m!foaf!){
    $mimetype="text/xml";
}
if ($q->self_url =~ m!\.rdf$!){
	$mimetype="text/xml";
}

my $server = Server->instance('gfx');
# @konijn
#print "xxxx\n";
#print "server: $server";
#exit;

# filename
my ($ufile)=$Qself =~ m!$Qselfs/(.*)!i;
$ufile = '' unless $ufile;
my ($filename) = $Qself =~ m!$Qselfs/(.*)!i;

# remove ? param en .html
$ufile  =~ s!\?.*!!;
$ufile  =~ s!\.html$!!;   
$ufile  = "/" unless ($ufile);

# template
my $tmpl;  
if ($q->param('tmpl')){
  $tmpl   = $server->gettemplate($q->param('tmpl'));
}elsif($ufile =~ m!\.rdf$!){
  $tmpl   = $server->gettemplate('image-foaf');
  $ufile =~ s!\.rdf$!!;  
}elsif($ufile =~ m!\.test$!){
  $tmpl = $server->gettemplate('image-test');
  $ufile =~ s!\.test$!!; 
} else{
  $tmpl = $server->gettemplate('image');
}

#TODO FIXME
my $cufile = $ufile;
$cufile =~ s!^gfx!!;    
$cufile =~ s!/$!!;
$cufile =~ s!/gfx/!!;
my $filee=$server->a2id("/gfx/$cufile");
$filee = '/gfx/' if ($filee eq '/gfx');

my $cache = new Cache::FileCache({namespace => 'gfx'} );
my $l = $cache->get($filee);
if (not defined $l && ! $q->param('update') ){
  my $l_obj=Lok->new($filee);
  $l = $l_obj;
  
  # redirect mislukte urls
  my $host = $server->{'config'}->{'hostname'};
  $host =~ s!/$!!;
  my $xurl = $l_obj->{'row'}->{'xurl'} || '/';
  
  # not found
  unless ($l_obj->{'row'}->{'serial'}){
    header(-status => 404);
    warn "geen filee \'$filee\'";
    exit 1;
  }
  
  
  if ( $l->{'row'}->{'filename'}  && $l->{'row'}->{'dirname'} ){
    $l->{'row'}->{'lastannotated'} = $l->{'row'}->{'filedate2'};
    #
    # 20030611, location
    #
    use Location;
    my $loc=Location->new($l->{'row'});
    unless ( $loc->{'lat'} && $loc->{'lon'} ){
      $l->{'row'}->{'nolocation'}=1;
    }else{
      $l->{'row'}->{'haslocation'}      = 1;
      $l->{'row'}->{'lat'}              = $loc->{'lat'};
      $l->{'row'}->{'lon'}              = $loc->{'lon'};
      $l->{'row'}->{'locationname'}     = $loc->{'locationname'};
      $l->{'row'}->{'fromlocation'}     = $loc->{'fromlocation'};
      $l->{'row'}->{'fromlocationname'} = $loc->{'fromlocationname'};
      #20040821
      if ($loc->{'airport'}){
	$l->{'row'}->{'airport'}        = $loc->{'airport'};
      }
      if ($loc->{'airportiata'}){
	$l->{'row'}->{'airportcountry'}   = $loc->{'airportcountry'};
	$l->{'row'}->{'airportlatitude'}  = $loc->{'airportlatitude'};
	$l->{'row'}->{'airportlongitude'} = $loc->{'airportlongitude'};
	$l->{'row'}->{'airportname'}      = $loc->{'airportname'};
	$l->{'row'}->{'airportiata'}      = $loc->{'airportiata'};
	$l->{'row'}->{'airportdistance'}  = $loc->{'airportdistance'};
	$l->{'row'}->{'airport'}          = $loc->{'airportiata'};
      }
      # lastannotated TODO, niet locationname maar location
      #    if (defined($loc->{'lastupdate'}) &&
      #    $loc->{'lastupdate'} gt  $l->{'row'}->{'lastannotated'} ){
      #	 $l->{'row'}->{'lastannotated'} = $loc->{'lastupdate'};
      #	 $l->{'row'}->{'lastannotatedthing'} = 'location';
      #}
      
  }
    
    
    
    
    
  # 20040921 TODO testing nearby locations
  if (defined($l->{'row'}->{'haslocation'})
       &&
      $l->{'row'}->{'haslocation'} eq 1){
    my $lat =  $l->{'row'}->{'lat'};
    my $lon =  $l->{'row'}->{'lon'};
    my @locationnames = Location::getnearnames( lon => $lon,
						lat => $lat,
						limit => 20,
					      );
    # print Dumper(@locationnames);
    $l->{'nearlocationnames'} = \@locationnames;

    # BBBOX @TODO
    my ($bllon,$bllat,$trlon,$trlat) = (999,999,-999,-999);
    foreach   (@locationnames){
      $bllat = $_->{'lat'}  if ($_->{'lat'} && $_->{'lat'} < $bllat);
      $bllon = $_->{'lon'}  if ($_->{'lon'} && $_->{'lon'} < $bllon);
      $trlat = $_->{'lat'}  if ($_->{'lat'} && $_->{'lat'} > $trlat);
      $trlon = $_->{'lon'}  if ($_->{'lon'} && $_->{'lon'} > $trlon);
    }
    $l->{'bllat'} = $bllat;
    $l->{'bllon'} = $bllon;
    $l->{'trlat'} = $trlat;
    $l->{'trlon'} = $trlon;
  }

  #
  # /location
  #
  
  
  #
  # person 20030822
  #
  
  
  use Person;
  my $depicts=new Person( { lok => $l, });
  if ($depicts->[0]->{'riplastupdate'}){
    #warn Dumper($depicts);
    #lastannotated TODO
    if ($depicts->[0]->{'riplastupdate'} gt $l->{'row'}->{'lastannotated'}){
      $l->{'row'}->{'lastannotated'} = $depicts->[0]->{'riplastupdate'};
      $l->{'row'}->{'lastannotatedthing'} = 'person';
    }
    $l->{'depicts'} = $depicts;
  }
  # }
  
  #
  # /person
  #
  
  
  
    #
    # word 2003-12
    #
    #TODO anno
    use Word;
    my ($word2,$wlastupdated) = Word->getwords({imageid => $l->{'serial'},
				about => $l->{'id'},
					       }

				      );

    my @arr;
    $l->{'words2'} = \@arr;
    if ($word2){
      $l->{'words2'} = $word2;
    }
    
    
    my $word = Word->new($filee);
    if ($word->{'lastupdate'} 	
	&&
	($word->{'lastupdate'} gt $l->{'row'}->{'lastannotated'} )
       ){
      $l->{'row'}->{'lastannotated'} = $word->{'lastupdate'};
      $l->{'row'}->{'lastannotatedthing'} = 'word';
    }
    #print Dumper($word->{'words'} );
    if ( $word->{'words'} ){
      my @words;
      foreach my $w (@{$word->{'words'} }){
	my $row={};
	$row->{'word'} = $w;
	# my ($sw) = $w =~ m!(\w+$)!;
	my ($sw) = $w =~ m!1\.6/(.*?)$!;
	#$row->{'lcsword'} = lc($sw);
	$row->{'sword'} = $sw;
	
	$row->{'shortword'} = lc($sw);
	$row->{'shortword'} =~ s/-\d+$//;
	
	if ($row->{'synsetid'} && $row->{'wordid'}){
	my $ww = Word->newfromwordid($row->{'wordid'}, $row->{'synsetid'}); 
      }
	
	
	push @words, $row;
	#" word:$w \n";
      }
      $l->{'words'} = \@words;
    }
    
    #
    # /word 2003-12
    #
    
    
    
    #
    # .txt 20041104
    #
    if (0){
      my $textfilee =  '/www/' . $filee . ".txt";
    if ( -r $textfilee ){
      warn "textfilee: $textfilee";
      open (FILEE,"<$textfilee") || warn "cannot open textfilee $!";
      my $extext;
      while (<FILEE>){
	$extext .= $_;
      } 
      close FILEE;
      
      warn "textfilee inhoud: $extext";
      my ($eurl) = $extext =~ m!url\:(.*)!;
      $eurl =~ s!\s^!!;
      $eurl =~ s!$\s!!;
      if ($eurl){
	warn "textfilee found [$eurl]";
      }
      
    }else{
      warn "geen textfilee: $textfilee";
    }
  }
  #
  # /.txt
  #

    #
    # next en prev
    #
  
  my ($lp,$ln) = ($l->getnextenprev);
  
  if ($ln){
    my $lokn=Lok->new($ln);
    my @loknext;
    $lokn->{'row'}->{'qselfs'}=$Qselfs;
    push @loknext,$lokn->{'row'};

    $l->{'loknext'}     =  \@loknext;
    $l->{'loknexturl'}  = $lokn->{'row'}->{'id'};



    #    $tmpl->param(
#		 loknext => \@loknext,
#		 loknexturl => $lokn->{'row'}->{'id'}
#		);
  }else{
    
    # anders volgende = dir up
    
    my $lokn=Lok->new( $l->{'row'}->{'dirname'} );
    my @loknext;
    $lokn->{'row'}->{'qselfs'}=$Qselfs;
    $lokn->{'row'}->{'comment'}='End';
    
    push @loknext,$lokn->{'row'};

    $l->{'loknext'}   = \@loknext;
    $l->{'loknexturl'} = $lokn->{'row'}->{'id'};

#    $tmpl->param(
#		 loknext => \@loknext,
#		 loknexturl => $lokn->{'row'}->{'id'}
#		);
    
  }
  
  if ($lp){
    my $lokp=Lok->new($lp);
    # print Dumper($lp);
    my @lokprev;
    $lokp->{'row'}->{'qselfs'}=$Qselfs;
    push @lokprev,$lokp->{'row'};

    
    
    $l->{'lokprev'} = \@lokprev;
    $lokprevurl  = $lokp->{'row'}->{'id'};
    $l->{'lokprevurl'} =  $lokprevurl ;
    # $tmpl->param(
    #		 lokprev => \@lokprev,
    #		 lokprevurl => $lokp->{'row'}->{'id'}
    #		 
    #		);
  }
  
    #
    # /end next en prev
    #
  
  
  

    
  }elsif (  $l->{'row'}->{'dirname'} ) {
  #
  # A DIRECTORY
  #
  # print Dumper($l->getdir);
  my $dirname = $l->{'row'}->{'dirname'};
  #print Dumper($l);
  
  my $files=$l->getdir;
  my @images;
  foreach my $i (@{$files}){
    my $il=Lok->new($dirname . "/$i");
    my $irow=$il->{'row'};
    $irow->{'qselfs'} = $Qselfs;
    #print $i . Dumper($irow);
    push @images,$irow;
  }
  $l->{'images'} = \@images;
  #  $tmpl->param(images => \@images);


  my $dirreadmef = $server->{'config'}->{'prefix'} . $dirname;
  $dirreadmef = "$dirreadmef/README";
  my $dirreadme;
  $dirreadme = `cat "$dirreadmef"` if -r "$dirreadmef";
  
  
  #print "dirreadme: file[$dirreadmef] [$dirreadme] ";
  #exit;
  
  $l->{'dirreadme'} = $dirreadme;
  # $tmpl->param(dirreadme => $dirreadme);
  
  
  
}







  if (1){
    # comments
    my $cid  = $l->{'row'}->{'id'};
    my $qcid = $server->quote( "%$cid%" );
    my $xurl= $l->{'row'}->{'xurl'} || '';
    $xurl =~ s!.html$!!;
    my $qcxurl= $server->quote( "%$xurl%" );
    my $cq = " 
   SELECT * FROM comments
   WHERE about LIKE  $qcid OR about LIKE $qcxurl
   ORDER BY timestamp desc
   LIMIT 30
  ";
    my ($csth,$cerror)=$server->doq($cq);
    print $cerror if $cerror;
    
    my @comments;
    while (my $row=$csth->fetchrow_hashref){
      my $html = textile($row->{'comment'} . " ");
      $html =~ s!(http\:\/\/.*?)\s!<a href="$1">$1</a>!;
      $html =~ s!^\<p\>!!;
      $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 "<br />";
    # ???????
    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!&amp;!&!g;
      $hrow->{'http_referer'}  =~ s!&!&amp;!g;
      $hrow->{'http_refererd'}  =~ s!&amp;!&!g;
      $hrow->{'http_refererd'}  =~ s!&!&amp;!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!&amp;!&!g;
      $hrow->{'remote_host'}   =~ s!&!&amp;!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.
