#!/usr/bin/perl

use strict;

# tempate file to use for individual poems
my $poem_template = 'poem2.tmpl';

# template file to use for the list of poems
my $list_template = 'poetry.html';

if( ! $ENV{'PATH_INFO'} 
	|| $ENV{'PATH_INFO'} eq '' ) {

	# No path info; redirect to have at least a / (as if we're a dir.)
	my $redir_path = 'http://' . $ENV{'HTTP_HOST'};
	if( $ENV{'REQUEST_URI'} =~ /\.cgi$/ ) {
		$redir_path .= $ENV{'REQUEST_URI'} . '/';
	} else {
		$redir_path .= "$ENV{'REQUEST_URI'}poem.cgi/";
	}
	
	print "Location: $redir_path\n";
	print "URI: $redir_path\n";
	print "\n";
	exit 0;

} elsif( $ENV{'PATH_INFO'} eq '/' ) {

	# This is a request for the list page.
	
	# Output the header...
	#
	print "Content-type: text/html\n\n";
	
	# Create the system information structure...
	#
	my $sysinfo = &create_sysinfo();
	
	my $rval = &parse_poem_template( $sysinfo, $list_template );
	
	# That's it; we're done.  Exit.
	#
	exit $rval;

} else {

	# This is a request for a specific poem.
	
	# Output the header...
	#
	print "Content-type: text/html\n\n";
	
	# Create the system information structure...
	#
	my $sysinfo = &create_sysinfo();
	$$sysinfo{poemname} = $ENV{'PATH_INFO'};
	$$sysinfo{poemname} =~ s:^/::;
	$$sysinfo{poemname} =~ s:/$::;
	
	my $rval = &parse_poem_template( $sysinfo, $poem_template );
	
	# That's it; we're done.  Exit.
	#
	exit $rval;

} # $ENV{'PATH_INFO'}

# We shouldn't ever get here...
exit 1;

sub parse_poem_template {
	# 'generic' parsing routine for poem templates.
	my ($sysinfo, $template_file) = @_;
	
	# Template parsing routines
	use HTML::Parser::Tmpl;
	
	# An instance of the template parser
	my $t = new HTML::Parser::Tmpl;
	
	# Setup defaults to print unknown items
	# (if you don't do this, they do nothing)
	#
	$t->set_print;
	
	# Setup all the callbacks...
	#
	&setup_callbacks( $t, $sysinfo );
	
	# Do the actual parsing
	# The possible routines are those found in HTML::Parser
	#
	my $rval = $t->parse_file( $template_file );
	
	return $rval;
}

sub setup_callbacks {
	my ($t, $sysinfo) = @_;
	
	$t->add_start( prs_tag => 'poemname', prs_cb => \&poem_name_cb, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'poemimg', prs_cb => \&poem_img_cb, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'poemlist', prs_cb => \&print_list, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'poemslist', prs_cb => \&print_slist, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'poem', prs_cb => \&print_poem, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'psize', prs_cb => \&print_size, prs_param => $sysinfo );
	
	$t->add_start( prs_tag => 'sprev', prs_cb => \&sprev_link, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'snext', prs_cb => \&snext_link, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'uprev', prs_cb => \&prev_link, prs_param => $sysinfo );
	$t->add_start( prs_tag => 'unext', prs_cb => \&next_link, prs_param => $sysinfo );
}

sub create_sysinfo {
	my %sysinfo;
	&parse_cache_file( \%sysinfo );
	
	return \%sysinfo;
}

sub poem_img_cb {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	print "<h1>$$sysinfo{cache}->{$$sysinfo{poemname}}->[0]</h1>";
}

sub poem_name_cb {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	print $$sysinfo{cache}->{$$sysinfo{poemname}}->[0];
}

sub prev_link {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{names};
	my $index = $$cache{$$sysinfo{poemname}}->[1];
	
	if( $index > 0 ) {
		my $prevfile = $$names[$index - 1];
		print "<a href=\"../$prevfile/\">", $$cache{$prevfile}->[0], "</a>";
	}
}

sub next_link {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{names};
	my $index = $$cache{$$sysinfo{poemname}}->[1];
	
	if( $index < @$names - 1 ) {
		my $nextfile = $$names[$index + 1];
		print "<a href=\"../$nextfile/\">", $$cache{$nextfile}->[0], "</a>";
	}
}

sub sprev_link {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{snames};
	my $index = $$cache{$$sysinfo{poemname}}->[2];
	
	if( $index > 0 ) {
		my $prevfile = $$names[$index - 1];
		print "<a href=\"../$prevfile/\">", $$cache{$prevfile}->[0], "</a>";
	}
}

sub snext_link {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{snames};
	my $index = $$cache{$$sysinfo{poemname}}->[2];
	
	if( $index < @$names - 1 ) {
		my $nextfile = $$names[$index + 1];
		print "<a href=\"../$nextfile/\">", $$cache{$nextfile}->[0], "</a>";
	}
}

sub print_list {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{names};
	
	foreach my $key (@$names) {
		print "<a href=\"$key/\">", $$cache{$key}->[0], "</a><br>\n";
	}
}

sub print_slist {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	my $cache = $$sysinfo{cache};
	my $names = $$sysinfo{snames};
	
	foreach my $key (@$names) {
		print "<a href=\"$key/\">", $$cache{$key}->[0], "</a><br>\n";
	}
}

sub print_poem {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	# This function is dependent on the poem name
	# ... abort if it's not set.
	if( ! $$sysinfo{poemname} ) {
		return undef;
	}
	
	my $cache = $$sysinfo{cache};
	
	# Security: make sure the file is one we know about.
	if( ! $$cache{$$sysinfo{poemname}} ) {
		return undef;
	}
	
	my $filename = $$sysinfo{poemname} . ".txt";
	open( FILE, "<$filename" ) || die( "open: $filename: $!" );
	
	# Read the first line, which we won't use
	my $line = <FILE>;
	
	# Read & print the file 'til we're done.
	$line = <FILE>;
	while( $line ) {
		$line =~ s/\n/<BR>\n/g;
		
		print $line;
		$line = <FILE>;
	}
	
	close( FILE );
}

sub print_size {
	my( undef, undef, undef, undef, $sysinfo ) = @_;
	
	my $size = @{$$sysinfo{names}};
	print $size;
}

sub parse_cache_file {
	my $sysinfo = shift;
	
	my $list_file = 'list';
	my $cache_file = 'list.cache';
	
	if( &check_cache( $list_file, $cache_file ) ) {
		&update_cache( $list_file, $cache_file );
	}
	
	open( LISTCACHE, "<list.cache" ) || return undef;
	my %cache;
	my @unamecache;
	my @snamecache;
	
	my $count = 0;
	my $line = <LISTCACHE>;
	while( $line ) {
		chop( $line );
		my ($filename, $poemname) = split( /=/, $line, 2 );
		
		if( $filename ) {
			$cache{$filename}->[0] = $poemname;
			$cache{$filename}->[1] = $count;
			$unamecache[$count] = $filename;
		}
		
		$line = <LISTCACHE>;
		$count++;
	}
	
	close( LISTCACHE );
	
	@snamecache = sort {uc($a) cmp uc($b)} ( @unamecache );
	for( my $c=0; $c < @snamecache; $c++ ) {
		$cache{$snamecache[$c]}->[2] = $c;
	}
	
	$$sysinfo{cache} = \%cache;
	$$sysinfo{names} = \@unamecache;
	$$sysinfo{snames} = \@snamecache;
}

sub check_cache {
	my( $list_file, $cache_file ) = @_;
	
	# Get ages of the relevant files
	my $list_age = -M $list_file;
	my $cache_age = -M $cache_file;
	
	# Does it need an update?
	if( $cache_age > $list_age ) {
		# Needs update
		return 1;
	}
	
	# No update necessary
	return 0;
}

sub update_cache {
	my ($list_file, $cache_file) = @_;
	
	my $new_cache_file = $cache_file . '.tmp';
	my $bak_cache_file = $cache_file . '.bak';
	
	my $line;
	my @list;
	
	# Read in list...
	open( LIST, "<$list_file" ) || die( "open: $list_file: $!" );
	
	$line = <LIST>;
	while( $line ) {
		chop( $line );
		push @list, $line;
		
		$line = <LIST>;
	}
	
	close( LIST );
	
	open( CACHE, ">$new_cache_file" ) || die( "open: $new_cache_file: $!" );
	foreach my $file (@list) {
		my $filename = $file . '.txt';
		open( POEMFILE, $filename ) || die( "open: $filename: $!" );
		$line = <POEMFILE>;
		chop( $line );
		print CACHE "$file=$line\n";
		close( POEMFILE );
	}
	close( CACHE );
	
	rename $cache_file, $bak_cache_file;
	rename $new_cache_file, $cache_file;
	
	return 0;
}
