#!/usr/bin/perl 
#
# 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
#
# In most instances, your web server will be running as a different user
# to yourself.  Thus, your guestbook file (see $GUESTBOOK, below) must
# be writable by this user, world writable, or the script should be run
# setuid to your user.  The safest way to do this is to use a C wrapper
# program (see The Camel Book).
#
# 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 CGI qw(:all);
use Date::Format;


# Program identity constants (note the use of RCS values "Revision" and 
# "Date" in $VERSION and $DATE, below).  You shouldn't need to change
# these unless you modify the script.  If you're not using RCS, you might
# want to replace the VERSION and DATE fields with simple values.
# e.g. my $VERSION = "1.2.abw.beta";   my $DATE = "30-Feb-98";

my $PROGRAM   = 'Guestbook';
my $VERSION   = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
my $DATE      = &format_date(q$Date: 1997/02/17 15:14:50 $ =~ /([\d\/]+)/);


# This is about *YOU*.  These values are used to determine who you are
# and how your system is set up.  Change them to add your own name, email,
# etc.

my $EMAIL     = 'abw@peritas.com';      # where email should go
my $NAME      = "Andy Wardley";         # your name
my $TITLE     = "Andy's Guestbook";     # page title
my $SENDMAIL  = "/usr/lib/sendmail";    # where does sendmail reside?


# This last one is the name of the file where you want guestbook messages
# to be stored.  Read the note in the header above about file permissions.

my $GUESTBOOK = "/usr/people/abw/www/public/etc/guestbook";


    #### You probably don't need to change anything below here ####


# This is about *ME*.  The following items define the constants used to 
# build the copyright message.  You may change the script and add your own
# name wherever you like, but the original copyright message (or one saying
# "based on the original by Andy Wardley, etc.") must remain.

my $AUTHNAME  = 'Andy Wardley';
my $AUTHEMAIL = 'abw@peritas.com';
my $AUTHHOME  = 'http://www.peritas.com/~abw';
my $EMAILLINK = "<a href=\"mailto:$AUTHEMAIL\">&lt;$AUTHEMAIL&gt;</a>";
my $HOMELINK  = "<a href=\"$AUTHHOME\">$AUTHNAME</a>";
my $ATTRIB    = "Copyright (C) 1996,1997 $HOMELINK $EMAILLINK";

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

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


#
# 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;

	$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, $comments);

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

	$comments =~ s/\n/<br>/g;


	# build full guestbook entry adding time stamp and "quality rank"
	$entry = "0:" . time . ":$name:$email:$url:$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>

	<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>

	</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, $comments)
		= split(/:/, $entry, 8);
	
	$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);
	$comments =~ s/\n/<br>/g;

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

		<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 "<center><h1>$TITLE</h1></center>\n\n";

	&guestbook_menu();

	print "<p>\n";
}



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

sub page_footer {

	&guestbook_menu();

	print <<EOF;
<p>
<hr>

<font size="-1" color="#444444">
$PROGRAM V$VERSION $DATE<br>
$ATTRIB
</font>

EOF

	print $query->end_html();
}



#
# 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, $comments) = @_;
	local (*MAIL);
	
	$comments =~ s/\n/\n  /g;

	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

Comments:
  $comments


EOF

}