#!/usr/bin/perl -w
use strict;

#  Copyright (C) 2003 Anthony de Boer
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of version 2 of the GNU General Public License as
#  published by the Free Software Foundation.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

my %jt;
my %pt;
my $DB = '.data';
my %db;
my %pgr;
my $thumbprefix = '.t_';
my %hascap;

if (-f $DB) {
	open(DB, $DB) || die "Cannot read $DB: $!\n";
	$/ = '';
	while(<DB>) {
		my ($pg, $id, $rest) = split(/\s+/, $_, 3);
		next if $pg eq 'unsorted' && $id =~ /^\d+$/;
		$rest =~ s/\n+$//;
		die "DB entry $pg $id defined again!\n" if $db{"$pg $id"};
		$db{"$pg $id"} = $rest;
		$hascap{$pg} = 1 if $id =~ /^\d+$/ && $rest =~ /\s\S/;
		}
	close(DB);
	}

undef($/);
opendir(D, ".") || die "Cannot opendir .: $!\n";
for my $f (readdir(D)) {
	# next if $f =~ /^\./;
	next unless defined($f);
	if ($f =~ /\.html$/) {
		next if $f =~ /^unsorted/;
		open(F, $f) || die "Cannot read $f: $!\n";
		$_ = <F>;
		$pt{$f} = $_;
		while(s/<img\s+src\s*\=\s*\"([^"]+)\"//i) {
			$jt{$1} |= 2;
			}
		close(F);
		}
	elsif ($f =~ s/^\.t\_(.+\.jpe?g)$/$1/) {
		$jt{$f} |= 4;
		}
	elsif ($f =~ /^\./) {
		next;
		}
	elsif ($f =~ /\.jpe?g$/) {
		$jt{$f} |= 1;
		}
	else {
		print STDERR "WTF is $f\?\n";
		}
	}

for my $f (sort (keys %jt)) {
	next unless $jt{$f} & 1;
	&getsize($f);
	unless ($jt{$f} & 4) {
		print STDERR "Thumb $f\n";
		my $cmd = "djpeg $f | pnmscale -xsize 150 | cjpeg -quality 50 -smooth 10 -optimize -outfile $thumbprefix$f";
		print STDERR "+ $cmd\n";
	        system $cmd;
		$jt{$f} |= 4;
		}
	&getsize("$thumbprefix$f");
	}

sub getsize {
	my ($f) = @_;
	my $k = "_ $f";
	unless ($db{$k}) {
		my $said = `rdjpgcom -v $f`;
		if ($said =~ /(\d+)w \* (\d+)h/) {
			$db{"_ $f"} = "WIDTH=\"$1\" HEIGHT=\"$2\"";
			}
		else {
			die "Cannot parse rdjpgcom output:\n$said\n";
			}
		}
	}


my %pgt;
my $ixl = '';

for my $k (sort (keys %db)) {
	my ($pg, $id) = split(/\s+/, $k);
	$pgr{$pg} = '' unless defined($pgr{$pg});
	$pgr{$pg} .= $id . ' ' if $id =~ /^\d+$/;
	}

delete ($pgr{'_'});
for my $pg (keys %pgr) {
	$pgt{$db{"$pg title"} || $pg} = $pg unless $pg eq 'index';
	}

for my $pt (sort (keys %pgt)) {
	$ixl .= "<LI><A HREF=\"$pgt{$pt}.html\">$pt<\/A>\n";
	}

delete ($pgr{'unsorted'});

for my $pg (sort (keys %pgr)) {
	&setgen($pg);
	}

my $u = 0;
$pgr{'unsorted'} = '';
for my $i (sort (keys %jt)) {
	next if $jt{$i} & 10;
	print STDERR "$i not in any page\n";
	if ($i =~ /^img_(\d+)\.jpg$/ && $1 > 0) {
		$u = $1 + 0;
		}
	else {
		$u++;
		}
	while($db{"unsorted $u"}) {
		$u++;
		}
	$pgr{'unsorted'} .= "$u ";
	$db{"unsorted $u"} = $i;
	}

open(DB, ">$DB.new") || die "Cannot write $DB.new: $!\n";
for my $k (sort (keys %db)) {
	die "Error writing $DB.new: $!\n" unless print DB "$k $db{$k}\n\n";
	}
close(DB) || die "Error closing $DB.new: $!\n";
rename ($DB, "$DB.bak");
rename ("$DB.new", $DB) || die "Cannot rename $DB.new to $DB: $!\n";

&setgen('unsorted') if $u || $db{"unsorted title"};

sub setgen {
	my ($pg) = @_;
	my $title = $db{"$pg title"} || "foo";
	my @subs = sort({$a <=> $b} (split(/\s+/, $pgr{$pg})));
	my $ttl = $#subs + 1;
	my $main = &header($title, 0, $ttl);
	my $mnbar = &navbar($pg, 0, $ttl);
	$main .= $mnbar . "<P>\n";
	$main .= $db{"$pg intro"} . "<P>\n\n" if $db{"$pg intro"};
	print STDERR "ixl undefined\n" unless defined($ixl);
	$main .= "<UL>\n$ixl<\/UL>\n" if $pg eq 'index' && $db{'index auto'};
	for my $i (1..$ttl) {
		my $snb = &navbar($pg, $i, $ttl);
		my ($im, $tx) = split(/\s+/, $db{"$pg $subs[$i-1]"}, 2);
		$tx = ' ' unless $tx;
		my $photo;
		$jt{$im} |= 8;
		print STDERR "$im referenced but not found\n" unless $jt{$im} & 1;
		print STDERR "$thumbprefix$im referenced but not found\n" unless $jt{$im} & 4;
		$photo = "<IMG SRC=\"$im\"";
		$photo .= ' ' . $db{"_ $im"} if $db{"_ $im"};
		$photo .= "><P>\n\n";
		if (!$hascap{$pg}) {
			$main .= "<A HREF=\"$im\"><IMG SRC=\"$thumbprefix$im\"";
			$main .= ' ' . $db{"_ $thumbprefix$im"} if $db{"_ $thumbprefix$im"};
			$main .= "><\/A>\n";
			next;
			}
		elsif ($tx =~ /nocomment/) {
			$main .= $photo;
			}
		else {
			$main .= "<A HREF=\"$pg\-$i.html\"><IMG SRC=\"$thumbprefix$im\"";
			$main .= ' ' . $db{"_ $thumbprefix$im"} if $db{"_ $thumbprefix$im"};
			$main .= " ALIGN=LEFT><\/A> $tx\n<BR CLEAR=ALL>&nbsp;<P>\n\n";
			}
		my $spg = &header($title, $i, $ttl);
		$spg .= $photo;
		$spg .= "<HR>\n" . $snb . &footer;
		$spg .= "$tx<P>\n\n";
		&flush("$pg\-$i.html", $spg);
		}
	$main .= $db{"$pg tail"} . "\n\n" if $db{"$pg tail"};
	$main .= "<HR>$mnbar\n";
	$main .= &footer;
	&flush("$pg.html", $main);
	}

sub header {
	my ($title, $inof, $ttl) = @_;
	my $tcit = $inof ? "- $inof of $ttl" : '';
	my $hs = $inof ? 'H3' : 'H1';
	return "<HTML>\n<HEAD>\n<TITLE>$title$tcit<\/TITLE>\n<\/HEAD>\n\n<BODY>\n<$hs>$title$tcit<\/$hs>\n";
	}

sub navbar {
	my ($pg, $inof, $ttl) = @_;
	my $parent = './';
	my $r = '';
	$parent = '../' if $pg eq 'index' && !$inof;
	$parent = "$pg.html" if $pg ne 'index' && $inof;
	$r .= "<A HREF=\"$parent\">[up]<\/A> ";
	$r .= "<A HREF=\"$pg\-".($inof-1).".html\">[previous]<\/A> " if $inof>1;
	$r .= "<A HREF=\"$pg\-".($inof+1).".html\">[next]<\/A> " if $inof && $inof<$ttl;
	$r .= " -- ";
	if ($hascap{$pg}) {
		for my $i (1..$ttl) {
			if ($i == $inof) {
				$r .= "<B>$i<\/B> ";
				}
			else {
				$r .= "<A HREF=\"$pg\-$i.html\">$i<\/A> ";
				}
			}
		}
	$r =~ s/ -- $//;
	return $r;
	}

sub footer {
	return "<P>\n<!-- generated -->\n<\/BODY>\n<\/HTML>\n";
	}

sub flush {
	my ($fn, $content) = @_;
	my $ocon = '';
	if (defined($pt{$fn})) {
		my $pold = delete($pt{$fn});
		if ($pold eq $content) {
			# print STDERR "No change to $fn.\n";
			return;
			}
		elsif ($pold !~ /\<\!\-\- generated \-\-\>/) {
			print STDERR "Flagged against overwriting $fn\n";
			return;
			}
		}
	open(F, ">$fn") || die "Cannot write $fn: $!\n";
	die "Cannot print to $fn: $!\n" unless print F $content;
	close(F) || die "Error closing $fn: $!\n";
	print STDERR "Rewrote $fn\n";
	}

for my $p (sort (keys %pt)) {
	print STDERR "Ungenerated page $p\n";
	}
