# guestbook.cgi
# This is a version of the guestbook that doesn't use POSIX or CGI.pm's wasteful
# escape*() functions.

use strict;
use CGI qw(:standard :html3);
use Apache::File ();
use Apache::Util qw(ht_time escape_uri unescape_uri escape_html);
use Fcntl qw(:flock);
use vars qw(@FIELDS %REQUIRED %BIG $GUESTBOOKFILE);

@FIELDS = qw(name e-mail location comments);
%REQUIRED = ('name' => 1, 'e-mail' => 1);
%BIG = ('comments' => 1);

if ($ENV{MOD_PERL}) {
    $GUESTBOOKFILE = Apache->request->dir_config('GuestbookFile');
}
$GUESTBOOKFILE ||= "/usr/tmp/guestbookfile.txt";

print header,
    start_html(-title => 'Guestbook', -bgcolor => 'silver'),
    h1("Guestbook");

 CASE: {
     $_ = param('action');
     /^sign/i and do    { sign_guestbook(); last CASE; };
     /^confirm/i and do { write_guestbook() and view_guestbook(); last CASE; };
     /^view/i and do    { view_guestbook(1); last CASE; };
     generate_form();
 }

print end_html;
exit 0;

sub generate_form {
    my @rows;
    for my $field (@FIELDS) {
	my $title = "Your $field";
	$title .= " (optional)" if !$REQUIRED{$field};
	my $element = $BIG{$field} ? 
	    textarea(-name => $field,
		     -rows => 4,
		     -columns => 50,
		     -wrap => 1)
		: textfield(-name => $field, -size => 50);
	push @rows, th($title) . td($element);
    }
    print start_form,
    table(TR{-align => 'LEFT'}, \@rows),
    br,
    submit(-name => 'action', -value => 'View Guestbook'),
    submit(-name => 'action', -value => 'Sign Guestbook'),
    end_form;
}

sub sign_guestbook {
    my @missing = check_missing(@FIELDS);
    if (@missing) {
	print_warning(@missing);
	generate_form();
	return;
    }
    my @rows;
    foreach (@FIELDS) {
	push @rows, TR(th({-align=>'LEFT'},$_), 
		       td(escape_html(param($_))));
    }
    print "Here is your guestbook entry.  Press ",
    em('Confirm')," to save it, or ",em('Change'),
    " to change it.",
    hr,
    table(@rows),
    hr;

    print start_form;
    foreach (@FIELDS) {
	print hidden(-name => $_);
    }
    print submit(-name => 'action',
		 -value => 'Change Entry'),
    submit(-name => 'action',
	   -value => 'Confirm Entry'),
    end_form;
}

sub check_missing {
    my %p;
    for (@_) { ++$p{$_} if param($_) }
    return grep !$p{$_}, keys %REQUIRED;
}

sub print_warning {
    print font({-color => 'red'},
	       'Please fill in the following fields: ',
	       em(join ', ', @_),
	       '.');
}

sub write_guestbook {
    my $fh = lock($GUESTBOOKFILE, 1);
    unless ($fh) {
	print strong('Sorry, an error occurred: unable to open guestbook file.'),p();
	Delete('action');
	print a({-href => self_url}, 'Try again');
	return;
    }
    my $date = ht_time(time,'%D');
    print $fh join("\t", $date, map {escape_uri(param($_))} (@FIELDS)),"\n";
    print "Thank you, ", param('name'),", for signing the guestbook.\n";
    $fh->close;
    1;
}

sub view_guestbook {
    my $show_sign_button = shift;
    print start_form,
    submit(-name => 'Sign Guestbook'),
    end_form
	if $show_sign_button;
    my $fh = lock($GUESTBOOKFILE, 0);

    my @rows;
    unless ($fh) {
	print strong('Sorry, an error occurred: unable to open guestbook file.'),br;
	Delete('action');
	print a({-href => self_url},'Try again');
	return;
    }
    while (<$fh>) {
	chomp;
	my @data = map {escape_html($_)} map {unescape_uri($_)} split("\t");
	unshift @rows, td(\@data);
    }
    unshift @rows, th(['Date',@FIELDS]);
    print p(
	    table({-border => ''},
		  caption(strong('Previous Guests')),
		  TR(\@rows)));
    $fh->close;
    print a({-href => '/'}, 'Home');
    1;
}

sub lock {
    my $path = shift;
    my $for_writing = shift;

    my ($lock_type, $path_name, $description);
    if ($for_writing) {
	$lock_type = LOCK_EX; 
	$path_name = ">>$path"; 
	$description = 'writing';
    } 
    else {
	$lock_type = LOCK_SH; 
	$path_name = $path; 
	$description = 'reading';
    }

    my $fh = IO::File->new($path_name) or
	warn "Couldn't open $path for $description: $!", return;

# now try to lock it
    my $success;
    my $tries = 0;
    while ($tries++ < 10) {
	last if $success = flock($fh, $lock_type|LOCK_NB);
	print p("Waiting for $description lock on guestbook file...");
	sleep(1);		# wait a second
    }
    unless ($success) {
	warn("Couldn't get lock for $description"); 
	return;
    }
    return $fh;
}