#! /usr/bin/perl -w

# $Id: picpage.cgi,v 1.25 2004/01/09 04:44:32 ddb Exp $

use Date::Format;
use URI::Escape;
use File::stat;
use Fcntl ':flock';		# import LOCK_* constants

my $debug = 0;

# Easy lookup index of image files we'll handle
my %imagetypes = (
	       'jpg', 1,
	       'jpeg', 1,
	       'JPG', 1,
	       'JPEG', 1,
	       'gif', 1,
	       'GIF', 1,
	       'png', 1,
	       'PNG', 1
	       );

# This script is intended to work in conjunction with image-index. It
# makes a custom page for the given image, and brings in possible
# associated data for that page.  Put picpage in /cgi-bin; it expects
# the path to the file in PATH_INFO.

# It's to be invoked with additional path info leading to the actual
# image; $PATH_TRANSLATED must point there.

# This extended version should be backwards-compatible with the old
# one, and also work (rather more featurefully) with galpage.pl
# pages. 

# Newform is used if the galinfo.yaml file is present and doesn't
# contain <the thing to force oldform>.  In newform, you specify the
# album directory as additional path info, and the photo ID as a
# parameter (id=).

$newform = 0;

$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";

# Config add comments (overridden by galcfg in galinfo for newform)
my $AddCommentsScript = 'GalleryAddComment.pl';
#my $AddCommentsScript = 'gac.cgi'; # ZZZ for testing
my $AddCommentsText = 'To add a comment to this photo, enter it here and click submit.';
my $AddCommentsFromPrompt = 'Who is commenting?';

# Get directory part of path info only, even if filename is there too.
$ENV{'PATH_TRANSLATED'} =~ qr|^(.*?)(/[^/]+\..+)?$|;
my $picdir = $1;
chdir ($picdir) || die "Can't chdir to $picdir";    
my $galinfo;
my $picid;

if (-r "galinfo.yaml") {
    use YAML qw (LoadFile);
    $galinfo = LoadFile ("galinfo.yaml");
    if (! $galinfo) {
	die "Failed to load galinfo.yaml";
    }
    if ($galinfo->{OLDPICPAGE}) {
	$newform = $galinfo->{OLDPICPAGE};
    } else {
	$newform = 1;
    }
    undef $galinfo unless $newform;
}
# Missing id can override above decision, however
# Note this isn't fully general!
if ($ENV{QUERY_STRING} =~ /id=(.*)/i) {
    $picid = uri_unescape($1);
} else {
    $newform = 0;
}

if ($newform) {

    # Show a single picture in the context of a gallery; meaning links
    # back to the gallery, and forward and backward links, and title
    # and info information and comments.

    use strict;
    use warnings;
    use Data::Dumper;

    my ($title, $picurl, $picfile, $picnav, $previd, 
	$nextid, $debinfo, $descr, $piccomments, $mtimestr, 
	$entercmt, $style, $picbottomtext);
    my $error = '';
    $debinfo = '';
    eval {			# Trap errors to make error page
	# Get data
	my $picobj;

	# Photo ID must be present
	if (! defined ($picid)) {
	    die "No picture id defined in query string";
	}
	if (! exists ($galinfo->{OBJINFO}->{$picid})) {
	    die "Invalid picture id $picid";
	}
	$picobj = $galinfo->{OBJINFO}->{$picid};
	$picurl = $ENV{PATH_INFO};
	if ($picurl =~ /(\.\.)/) {
	    die "Attempt to leave current directory in picture path $picurl";
	}
	$picfile = $picobj->{file};
	if ($picfile =~ /(\.\.)|\//) {
	    die "Attempt to leave current directory in picture file $picfile";
	}
	if (! -r $picfile) {
	    die "No readable file for picture $picfile";
	}
	my $ext;
	if ($picfile =~ /^.*\.(.+)$/) {
	    $ext = $1;
	    die "$picfile not a picture type I understand" unless $imagetypes{$ext};
	} else {
	    die "No file extension in $picfile";
	}

	# Allow local config of comment prompts and handling
	$AddCommentsScript = $galinfo->{GALCFG}->{ADDCOMMENTSSCRIPT} || $AddCommentsScript;
	$AddCommentsText = $galinfo->{GALCFG}->{ADDCOMMENTSTEXT} || $AddCommentsText;
	$AddCommentsFromPrompt = $galinfo->{GALCFG}->{ADDCOMMENTSFROMPROMPT} ||
	    $AddCommentsFromPrompt;
	# Make ordered list
	my @order = sort {$a->[1] <=> $b->[1] || $a->[0] cmp $b->[0]} map [$_,$galinfo->{OBJINFO}->{$_}->{sort}], keys %{$galinfo->{OBJINFO}};
	$debinfo .= " order " . Dumper (@order);
	# Find our current one ($picid). Only once, so no point bulding hash.
	for (my $i=0; $i<$#order; $i++) {
	    if ($order[$i]->[0] eq $picid) {
		if ($i > 0) {
		    # There's a previous, get it
		    $previd = $order[$i-1]->[0];
		} else {
		    undef $previd;
		}
		if ($i < $#order) {
		    # There's a next, get it
		    $nextid = $order[$i+1]->[0];
		} else {
		    undef $nextid;
		}
		last;
	    }
	}

	# Assemble the navigation elements
	$picnav = "";
	$picnav .= "<a href=\"$ENV{SCRIPT_NAME}$picurl?id=$previd\">[prev]</a>" if $previd;
	$picnav .= "<a href=\".\">[up]</a>";
	$picnav .= "<a href=\"$ENV{SCRIPT_NAME}$picurl?id=$nextid\">[next]</a>" if $nextid;

	if ($picobj->{title}) {
	    $title = $picobj->{title};
	} else {
	    $title = $picid;
	}

	$descr = $picobj->{descr};

	# Get comment block, if any
	my ($commentfn, $commentts);
	$commentfn = "$picid.comments";
	eval {			# Protect from blowouts
	    $piccomments = "";
	    $commentts = 0;
	    my $if;
	    open ($if, $commentfn) and
		flock ($if, LOCK_SH) and
		($commentts = stat($if)->mtime) and
		($piccomments = join (" ", <$if>)) and
		flock ($if, LOCK_UN);
	    close $if;
	};
	if ($@) {
	    # It's legal to not have this stuff
	    $piccomments = '';
	    $commentts = 0;
	}

	# Decide if we're allowing comments, and generate html block
	# to allow users to do so, or else blank block.
	$entercmt = '';
	if ($galinfo->{GALCFG}->{COMMENTS} && 
	    (-w "$picid.comment" || -f ".mkcomment")) {
	    $entercmt =  qq|<p><hr></p>\n|;
	    $entercmt .=  "<p>$AddCommentsText</p>\n";
	    $entercmt .=  "<form method=\"post\" action=\"$AddCommentsScript$picurl?id=$picid\">\n";
	    $entercmt .=  "<p>$AddCommentsFromPrompt <input type=\"text\" size=30 maxsize=50 name=\"user\"></p>\n";
	    $entercmt .=  qq|<p><textarea name="comment" rows=5 cols=60></textarea></p>\n|;
	    $entercmt .=  qq|<p><input type="submit" value="Submit Comment"></p>\n|;
	    $entercmt .=  "</form>\n";
	}

	# Figure out what lie we're going to tell about last-modified time
	# Check actual image file
	my $imagets;
	$imagets = stat($picobj->{file})->mtime or 0;
	my $mtime;
	$mtime = $imagets > $commentts ? $imagets : $commentts;
	$mtimestr = time2str ("%a, %d %b %Y %H:%M:%S %z", $mtime, "GMT");

	# Grab proper local stylesheet from config in info
	$style = $galinfo->{GALCFG}->{STYLESHEET} || "local.css";

	# Very bottom text (bottom nav, usually)
	$picbottomtext = $galinfo->{GALCFG}->{PICBOTTOMTEXT};
    };
    if ($@) {
	$error = $@;
	# Display error page
	print <<errpage ;
Content-type: text/html; charset=iso-8859-1;
Cache-Control: no-cache;

<html><head>
<title>Picture display error</title>
</head>
<body>
<h1>Picture Display Error</h1>
<p>$error</p>
</body></html>
errpage
    } else {
	# Display page
	# We don't use CGI since it's so big, and this is doing such simple
	# stuff.
	print <<pagetop ;
Content-type: text/html; charset=iso-8859-1;
Cache-Control: public;
Last-Modified: $mtimestr;

<html><head>
<title>$title</title>
<base href="$picurl/">
<link rel="stylesheet" type="text/css" href="$style">
pagetop

        print "</head><body>\n";
	print '<!-- Generated by $Id: picpage.cgi,v 1.25 2004/01/09 04:44:32 ddb Exp $ -->', "\n";
	print "<div class=\"picnav\">", $picnav, "</div>\n";
	print "<div class=\"pictitle\">$title</div>\n";
	print "<div class=\"picimg\">",
	"<img class=\"picimg\" src=\"$picfile\" alt=\"$title\">",
	"</div>", "\n";
	print "<div class=\"picinfo\">", $descr, "</div>\n";
	print "<div class=\"picnav\">", $picnav, "</div>\n";
	print "<div class=\"piccomments\">", $piccomments, "</div>\n";
	print "<div class=\"picentercomments\">", $entercmt, "</div>\n";
#	print "<div class=\"debug\">picdir $picdir<br> previd $previd <br>picid $picid <br>nextid $nextid <br>picurl $picurl <br>picfile $picfile
#<p>$debinfo</p></div>\n";
	print "<div class=\"posttext\">", $picbottomtext, "</div>\n";
	print "</body></html>\n";
    }
} else {
    # Old-style display
    # Set some defaults, which the config file may override.
    my $AddComments = 0;

# Pick up a config file if it's in the same directory as the image file
# ZZZ Should follow the chain up somehow, or at least look at the "top".
# ZZZ Should make image-index behave identically in finding config files
    if ($ENV{"PATH_TRANSLATED"}) {
	$ENV{'PATH_TRANSLATED'} =~ qr{(.*)/[^/]*};
	$dir = $1;
	chdir ($dir) || die "Can't chdir to $dir";    
	@buf = ();
	open (CUSTOM, "image-index.config") && 
	    (@buf = <CUSTOM>) &&
		close (CUSTOM);
	eval "@buf"; warn "image-index: error in $dir init file: $@" if $@;
    }

    $error = undef;
    $fpath = $ENV{'PATH_TRANSLATED'};
    if (!$fpath) {
	$error = "No path to image file specified";
    } elsif (! -r $fpath) {
	$error = "Image file nonexistent or unreadable";
    } elsif ($fpath !~ /^(.*)\.([^.]+)$/) {
	$error = "Image file name doesn't have an extension";
    } else {
	$base = $1;
	$extn = $2;
	if (!$imagetypes{$extn}) {
	    $error = "Image file extension isn't one we recognize";
	} else {
	    eval {
		$name = "";
		$namemtime = 0;
		open (NFILE, "$base.name") and 
		    $namemtime = stat(NFILE)->mtime and
			$name = join (" ", <NFILE>);
		close NFILE;
	    };
	    if (!$name) {
		$name = "Image $base";
	    }
	    eval {
		$info = "";
		$infomtime = 0;
		open (IFILE, "$base.info") and
		    $infomtime = stat (IFILE)->mtime and
			$info = join (" ", <IFILE>);
		close IFILE;
	    };

	    # Note that the image mtime isn't needed, since the image is fetched
	    # separately from a static file, and Apache provides the right mtime
	    # for that. This may result in an mtime of 0 if no .name or .info is
	    # present!  But it'll be consistent from request to request, so that's 
	    # okay.

	    # Pick latest modification date
	    $infomtime = $namemtime if $namemtime > $infomtime;

	    print "Content-type: text/html\n";
	    print "Last-Modified: ", time2str ("%a, %d %b %Y %H:%M:%S %z", $infomtime, "GMT"), "\n";
	    print "Cache-control: public\n";
	    print "\n";

	    print "<html><head>\n";
	    print '<!-- $Id: picpage.cgi,v 1.25 2004/01/09 04:44:32 ddb Exp $ -->' . "\n";
	    print "<title>$name</title>\n";
	    print "</head><body>\n";
	    print "<h1>$name</h1>\n";
	    $URL = $ENV{'PATH_INFO'};
	    $URL =~ s/ /%20/g ;
	    print '<img src="' . $URL . '">' . "\n";
	    if ($debug) {
		print '<p>URL: ' . $URL . "</p>\n";
		print "</p>\n";
	    }
	    if ($info) {
		print "<div> $info </div>\n";
	    }
	    if ($AddComments && -w "$base.info") {
		print qq{<p><hr></p>}, "\n";
		print "<p>$AddCommentsText</p>\n";
		print "<form method=\"post\" action=\"$AddCommentsScript$URL\">\n";
		print "<p>$AddCommentsFromPrompt <input type=\"text\" size=30 maxsize=50 name=\"user\"></p>\n";
		print '<p><textarea name="comment" rows=5 cols=60></textarea></p>', "\n";
		print '<p><input type="submit" value="Submit Comment"></p>', "\n";
		print '</form>', "\n";
	    }
	    print "</body></html>\n";
	}
    }
    if ($error) {
	print "Content-type: text/html\nCache-Control: no-cache\n\n";
	print "<html><head><title>picpage error</title></head>\n";
	print "<body>\n";
	print "<h1>Picpage error</h1>\n";
	print "<p> $error </p>\n";
	print '<p> Image file: ' . $ENV{'PATH_INFO'} . "\n";
	print "</body></html>\n";
    }
}