#!/usr/local/bin/perl
###########################################################################
# Program:       guest.cgi
# Version:       2.0
# Revisions:     1.0 May ??, 1995
#                1.01 May 25, 1995--Added subject to mailing and introduced
#                     $Mailto.
#                1.02 June 02, 1995--Changed more fields to be variables
#                     Put 'em at top with comments for changing.
#                     Handle "blank" home page entries
#                2.0 June 9, 1995-- Dbm changes to work with new version of
#                gbmaint (2.0).  NEED gbmaint 2.0 TO WORK WITH THIS!!!
#                (available at http://www.pobox.com/~mattl/src)
# Description:   Perl cgi script to take user input and put it in a dbm.
# Requirements:  perl (4 or 5), a webserver that allows user cgi
# Author:        Matt Leonard
#                mattl@pobox.com
#                http://www.pobox.com/~mattl
# Comments:      
# Copyright:     This program is copyright 1995-1997 Matt Leonard.
# Tabstop:       3
###########################################################################

#
# variables
# many of these will need to be changed to work on your system
#
# Path_To_Dbm is the full path to the incoming dbm database (needs to 
# be changed for other systems)
$Path_To_Dbm = "/home/leonarm/public_html/source/cgi/incoming";

$Perms = "undef";

# Mail_Prog is the path to the mail program you want to use to mail
# messages.  (probably doesn't need changing if you're on UNIX)
$Mail_Prog = "/bin/mail";

# Mailto is the person who will get the mail messages when a person 
# enters a guestbook record (DEFINITELY needs to be changed!)
$Mailto = "nobody\@nowhere.com";

# Subject is the subject line of a mail notification (change to suit
# your taste)
$Subject = "Someone entered a guestbook record";

# Msg_To_Usr is what the user will see as a "result of submission".  This
# initial setting is what appears if everything goes well, otherwise it
# is reset later in the program.  (change to suit, you'll at least want to
# change the "User" to someone else)
$Msg_To_User = "Your input has been entered into the \"incoming\" database and as soon as User gets around to it, it will be added to the guestbook.  This typically takes a couple of days.";

# Resp_Title is the title of the response page. (change to suit)
$Resp_Title = "Guestbook Response";

# Resp_Head is the heading of the response page. (change to suit)
$Resp_Head = "OK, Got Your Input";

#
# begin program
#

# get user's input variables
%Uservars = &read_query_string;

# put the data into the dbm
if (dbmopen(%USERINFO, $Path_To_Dbm, $Perms)) {
	# get rid of blank page entries that only have "http://"
	if ($Uservars{'page'} eq "http:\/\/") {
		$Uservars{'page'} = "";
	} # if
	# incoming dbm records' fields are "(" delimited
	$Record = $Uservars{'email'} . "(" .
				 $Uservars{'page'} . "(" .
				 $Uservars{'comment'};
	$USERINFO{$Uservars{'name'}} = $Record;
	# mail notification to $Mailto
	if (! open(MAIL, "| $Mail_Prog $Mailto")) {
		$Msg_To_User = "Sorry, there's a problem with mail, try again later.";
		delete $USERINFO{$Uservars{'name'}};
	} else {
		print MAIL "Subject: $Subject\n";
		print MAIL "\nPerson: $Uservars{'name'}\n";
		print MAIL "Entered a guestbook record\n";
	} # else 
	dbmclose(%USERINFO);
	close (MAIL);
} else {
	$Msg_To_User = "Sorry, there's a problem with the \"incoming\" database, try again later.";
} # else

# build html response page

&Html_Header($Resp_Title, $Resp_Head);

if ($Uservars{'name'}) {
print "
<strong><em>YOU:</strong></em><br>
$Uservars{'name'}
<p>
";                           # close printing to html response
} # if

if ($Uservars{'email'}) {
print "
<strong><em>YOUR ADDRESS:</strong></em><br>
$Uservars{'email'}
<p>
";                           # close printing to html response
} # if

if ($Uservars{'page'}) {
print "
<strong><em>YOUR PAGE:</strong></em><br>
$Uservars{'page'}
<p>
";                           # close printing to html response
} # if

if ($Uservars{'comment'}) {
print "
<strong><em>YOUR COMMENTS:</strong></em><br>
$Uservars{'comment'}
<p>
";                           # close printing to html response
} # if

print "
<strong><em>RESULTS OF SUBMISSION:</strong></em><br>
$Msg_To_User
<p>
<hr align=center width=\"75%\">
<center>
--<a href=\"http://some.site.com/~username/page1.html\"> Page 1 </a>
--<a href=\"http://some.site.com/~username/page2.html\"> Page 2 </a>
--<a href=\"http://some.site.com/~username/page3.html\"> Page 3 </a>
--<a href=\"http://some.site.com/~username/page4.html\"> Page 4 </a>
--
</center>
";                           # close printing to html response

&Html_Trailer;

#
# subroutines after this point
#

# the html_header header and trailer subroutines are lifted straight
# out of the Managing Internet Information Resources O'Reilly book
# Page 365 (with a bit of modification).

sub Html_Header {
	$Document_Title = $_[0];
	$Document_Header = $_[1];
	print "Content-type: text/html\n\n";
	print "<html>\n";
	print "<head>\n";
	print "<title>$Document_Title</title>\n";
	print "</head>\n";
	print "<body>\n";
	print "<h1><center>$Document_Header</center></h1>\n";
	print "<p>\n";
} # Html_Header

sub Html_Trailer {
	print "</body>\n";
	print "</html>\n";
} # Html_Trailer

# this subroutine is lifted directly out of the Leeds CGI tutorial.
# http://agora.leeds.ac.uk/nik/Cgi/start.html
# It is very similar to the code in the cgi-lib.pl stuff
sub read_query_string
{
	local ($buffer, @pairs, $pair, $name, $value, %FORM);
	# Read in text
	$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	} else { # this is a "GET method
		$buffer = $ENV{'QUERY_STRING'};
	} # else
	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%(..)/pack("C", hex($1))/eg;
		$FORM{$name} = $value;
	} # foreach
	%FORM;
}