#!/usr/bin/perl -w
#
# guestbook : perl 5 "guestbook" script for web based guestbook.
#
# Requires Perl 5 (you may need to change the "#!/usr/bin/perl" line above
# to reflect where perl is installed on your machine) and the CGI.pm 
# and Date::Format modules.  All of these can be obtained from the CPAN 
# archives - see the Perl Language Home Page (http://www.perl.com/perl) or 
# contact your local sysadmin or Perl guru for more details
#
# You may freely copy, distribute, modify and use this script on your own 
# web site as long as the original author attribution remains intact.  
# See message below.
#
# Copyright (C) 1996,97 Andy Wardley.  All Rights Reserved.
#

use strict;
use lib "/home/abw/lib";
use CGI qw(:all);
use Date::Format;
use MetaText;

$| = 1;

# program/author identity constants (note the use of RCS values "Revision"
# and "Date" in $VERSION and $DATE, below). 
my $PROGRAM   = 'Guestbook';
my $VERSION   = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
my $DATE      = &format_date(q$Date: 1997/07/04 09:10:05 $ =~ /([\d\/]+)/);

# mode constants
my $READ      = 'read';
my $BEST      = 'best';
my $SIGN      = 'sign';
my $FORM      = 'form';
my $READALL   = 0;
my $READBEST  = 1;

# the location of the guestbook file (i.e. where messages get written to)
my $HOME      = '/home/abw';
my $GUESTBOOK = "$HOME/websrc/etc/guestbook";

# user identification
my $EMAIL     = 'abw@kfs.org';          # where email should go
my $NAME      = "Andy Wardley";         # your name
my $SENDMAIL  = "/usr/lib/sendmail";    # where does sendmail reside?


# create a global CGI object
my $query     = new CGI or &fatal("Failed to create CGI object", 1);

# create a MetaText object 
my $config = {
	'elempath'  => "$HOME/websrc/elements",
};

my $template  = new MetaText $config;

# define a profile for MetaText substitutions
my $profile = {
	'home'      => '/~abw',
	'images'    => '/~abw/images',
	'maillink'  => "mailto:$EMAIL",
	'bodytags'  => 'bgcolor="#ffffff" vlink="#ba427c"',
	'keywords'  => 'abw,Andy Wardley,guestbook',
	'heat'      => '030',
	'secname'   => 'guestbook',
	'secdesc'   => 'Guestbook',
	'back'      => 'misc',
	'program'   => $PROGRAM,
	'version'   => $VERSION,
	'progdate'  => $DATE };



#
# main section: page header, relevant content, page footer.
#

&page_header();

# page contents, depending on "mode=????" parameter
MODE: {
	my $mode = $query->param('mode') || '';

	# read all the guestbook
	$mode =~ /read/ && do {
		&read_guestbook($READALL);
		last MODE;
	};

	# read the higlights
	$mode =~ /best/ && do {
		&read_guestbook($READBEST);
		last MODE;
	};

	# sign the guestbook (form submission)
	$mode =~ /sign/ && do {
		&sign_guestbook();
		last MODE;
	};

	# default action is to display submission form
	&guestbook_form();
}

&page_footer();


               ##### END OF MAIN - SUB_ROUTINES FOLLOW #####


#
# read_guestbook($mode)
#
# Read the guestbook file and generate the html page displaying the messages.
# $mode can be $READALL or $READBEST to select all messages or just those
# selected as tops by the guestbook owner.
#

sub read_guestbook {
	my $mode = shift || $READALL;
	my @entries;
	local *GBFP;

	@entries = ();

	# read guestbook entries if we can
	open(GBFP, "< $GUESTBOOK") && do {
		@entries = <GBFP>;
		close GBFP;
	};

	# ignore any 0 rated enties if "read best" mode is specified
	@entries = grep(!/^0:/, @entries) if $mode == $READBEST;

	printf("<h1>%sGuestbook Entries</h1>\n\n", 
			$mode == $READBEST ? "Favourite " : "");

	foreach (@entries) {
		print "\n<p>\n";
		&guestbook_entry($_);
	}
}



# 
# sign_guestbook()
#
# Process the submitted guestbook form, adding the message to the guestbook 
# file.
#

sub sign_guestbook {
	my ($speech, $name, $email, $url, $comments, $entry);
	local *GBFP;

	$speech  = join(' ', 
				$query->param('salutation'),
				$query->param('arrived'),
				$query->param('webpage'),
				$query->param('action'),
				$query->param('final'));

	$name     = $query->param('name')     || 'Anon.';
	$email    = $query->param('email')    || '';
	$url      = $query->param('url')      || '';
	$comments = $query->param('comments') || '';

	# blank URL if it only contains default value
	$url = '' if $url eq 'http://';

	# mail guestbook owner
	&mail_owner($name, $email, $url, $speech, $comments);

	# clean up any suspect characters
	foreach ($speech, $name, $email, $url, $comments) {
		# url-encode ':', '<' and '>'
		s/:/&#58;/g;
		s/</&lt;/g;
		s/>/&gt;/g;
	}

	# zap/convert CR's
	$comments =~ s/\r?\n\r?\n/<p>/g;
	$comments =~ s/\r//g;
	$comments =~ s/[\r\n]+/ /g;

	# build full guestbook entry adding time stamp and "quality rank"
	$entry = "0:" . time . ":$name:$email:$url:$speech:$comments";

	open(GBFP, ">> $GUESTBOOK") || &fatal("Cannot open guestbook: $!\n");
	print GBFP "$entry\n";
	close GBFP;

	print <<EOF;

	<!-- guestbook entry summary -->
	<h1>Guestbook Entry Submitted</h1>

EOF

	&guestbook_entry($entry);
}



# 
# sub guestbook_form()
#
# Generate the HTML form for users to complete to sign the guestbook.
# 

sub guestbook_form {
	my $submit = $query->url;

	print <<EOF;

	<!-- guestbook form -->

	<center>

	<form method="post" action=$submit>
	<input type=hidden name=mode value=sign>

	<b><i>Auto-Magic</i> Message Maker</b>

	<p>

	<select name="salutation">
	<option selected>Hi Andy,
	<option>Hey Dude,
	<option>Hello You,
	<option>Dear Mr Wardley,
	<option>Yo,
	<option>Oi!
	</select>

	<select name="arrived">
	<option selected>I checked out
	<option>I stumbled across
	<option>I was gagging for
	<option>I was lucky enough to find
	<option>I was hit on the head by
	<option>I surfed into
	</select>

	<select name="webpage">
	<option selected>your cool home page
	<option>your way cool home page
	<option>your mediocre home page
	<option>your armour-plated battle-mug
	<option>your pathetic collection of tat
	</select>

	<select name="action">
	<option selected>and thought I'd sign your guest book.
	<option>and was very impressed</option>
	<option>and dug it.
	<option>and cried with joy.
	<option>and I barfed.
	<option>and couldn't escape the gravitational pull.
	<option>and fell in love with you.
	<option>and wanted to buy you a beer.
	</select>

	<select name="final">
	<option selected>Nice One.
	<option>Take it easy, Dude.
	<option>You're my best mate.
	<option>Chill!
	<option>I love you, you're my best mate.
	<option>I mean it man, I love you.  You're my best mate.
	<option>Don't bother me again.
	<option>Will you marry me?
	<option>Can I have a drink of water, please?
	</select>


	<p>
	<b><i>Fill-In-Thingy</i> Name and Stuff</b>
	<p>

	<table border="0">
	<tr>
		<td><b><i>Name:</i></b></td>
		<td><input size="40" name="name"></td>
	</tr>

	<tr>
		<td><b><i>Email Address:</i></b></td>
		<td><input size="40" name="email"></td>
	</tr>

	<tr>
		<td><b><i>An URL of your own:</i></b></td>
		<td><input size="40" name="url" value="http://">
	</tr>

	<tr>
		<td valign="top"><b><i><br>Comments:</i></b></td>
		<td><textarea name="comments" rows="4" cols="40"></textarea></td>
	</tr>
	</table>

	<p>
	<b><i>Sign</i> or <i>Start Over</i> Click Spots</b>
	<p>

	<font size="+1"><input type="submit" name="submit" value=" Sign Me Up! ">
	<input type="reset" value=" Start Over "></font>
	</form>

	<p>
	<i>Please note that I reserve the right to edit or delete entries on 
	a whim...<br>
	...Oh, and HTML tags gets splatted.  Sorry!</i>

	<p>

	</center>

	<!-- end of guestbook form -->

EOF
}



#
# guestbook_entry($entry)
#
# Prints a nicely formatted guestbook entry
#

sub guestbook_entry {
	my $entry = shift;

	my ($rank, $time, $name, $email, $url, $speech, $comments)
		= split(/:/, $entry, 7);
	
	$email = "<a href=\"mailto:$email\">$email</a>" if $email;
	$url   = "<a href=\"$url\">$url</a>"            if $url;
	$time  = time2str('%d-%b-%y %H:%M:%S', $time);

	print <<EOF;
	<h2>$name</h2>
	<ul>
		<b>Email</b>: $email<br>
		<b>Url</b>:   $url<br>
		<b>Date</b>:  $time<br>

		<p>
		<i>"$speech"</i>
		<p>
		$comments
	</ul>

	<p>
EOF
}



# 
# menu()
#
# Prints the menu of links.
#

sub guestbook_menu {
	my $url = $query->url;

	print "<center>\n";
	print "[ <a href=\"$url?mode=$READ\">Read Guestbook</a> ]\n";
	print "[ <a href=\"$url?mode=$BEST\">Best Entries</a> ]\n";
	print "[ <a href=\"$url?mode=$FORM\">Sign Guestbook</a> ]\n";
	print "</center>\n";
}



#
# page_header()
#
# Print html header, title, page header, etc., etc, whatever you want.
#

sub page_header {

	print $query->header();
	print $query->start_html(
			"-title"   => "Andy's Groovy Guestbook", 
			"-bgcolor" => "#ffffff",
			"-vlink"   => "#ba427c");

	print "\n\n";

	print $template->process("header", $profile);

	&guestbook_menu();

	print "<p>\n";
}



#
# page_footer()
#
# Print page footer and end html.
#

sub page_footer {

	&guestbook_menu();

	print $template->process('progfoot', $profile);
}



#
# format_date($date)
#
# Very simply date formatter that converts yyyy/mm/dd (as RCS provides it)
# into the format dd-Mon-yy (as I prefer it).
#

sub format_date {
	my $date   = shift;
	my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

	$date =~ /(\d+)\/(\d+)\/(\d+)/;

	sprintf("%02d-%s-%02d", $3, $months[$2 - 1], $1 % 100);
}



#
# fatal($message, $header)
#
# Very basic fatal error reporting page.  Prints "$message" and exits.
# $header flag, if non-zero, indicates that a CGI/HTML page header is
# required to prefic the error.
#

sub fatal {
	my $message = shift;
	my $header = shift || 0;


	#
	# optional header
	# 

	print <<EOF if $header;
Content-type: text/html

<html>
<head>
<title>Guestbook Error</title>
</head>

<body bgcolor="#ffffff" vlink="#ba427c">
EOF

	#
	# error message
	#

	print <<EOF;
<h1>Error</h1>

An error has occured: $message

<p>

</body>
</html>
EOF

	exit 1;
}



#
# mail_owner
#
# mail the guestbook owner
#

sub mail_owner {
	my ($name, $email, $url, $speech, $comments) = @_;
	local (*MAIL);
	
	$comments =~ s/\n/\n  /g;

	# secure the path (stops perl complaining about insecure path)
	$ENV{ PATH } = '';
	open(MAIL, "| $SENDMAIL $EMAIL") || &fatal("Sendmail failed: $!\n");

	print MAIL <<EOF;
To: $EMAIL ($NAME)
From: $email ($name)
Subject: Guestbook Entry

New Guestbook Entry:

   Name: $name
  Email: $email
    URL: $url

Auto-Message:
  $speech

Comments:
  $comments


EOF

}