#!/usr/local/bin/perl
###########################################################################
# Program:       gbmaint
# Version:       2.01
# Revisions:     1.0 May ??, 1995
#                1.001 June 2, 1995--some changes to menus, etc.  Added 
#                date/time to bottom of page. Still lots to do, should
#                happen real soon now.
#                2.0 June 9, 1995--rewrote dbm parts kind of.  Changed
#                menus.  NEED guest.cgi VERSION 2.0 TO WORK WITH THIS!!!
#                (available at http://www.pobox.com/~mattl/src)
#                2.01 June 16, 1995--fixed bug that made display of a guest
#                record with no page not display the comment.
# Description:   Perl script for guestbook dbm maintenance.
# Requirements:  perl (4 or 5), a webserver that allows user cgi
# Author:        Matt Leonard
#                mattl@pobox.com
#                http://www.pobox.com/~mattl
# Comments:      User data coming from guest.html goes through guest.cgi
#                into the "incoming" dbm.  This program then manipulates
#                the incoming dbm allowing viewing, deletions, and 
#                movement of records to the guestbook page.  You can
#                generate a "testbook.html" page of all entries in incoming.
#                Testbook can then be examined and if you like, you can
#                use this program to move all records from incoming into
#                guestbook at once.
#                gbmaint tries to disable any html entered in the name,
#                email, and comments fields by changing all < and > to
#                | (pipe symbols).
#                If you generate a testbook or guestbook, you MUST EXIT
#                THIS PROGRAM for the changes to the pages to take effect!
# Tabstop:       3
# Copyright:     This program is copyright 1995-1997 Matt Leonard.
#                
###########################################################################

#
# variables
#

# many of these will need to be changed to work on your system
# (Actually, you can probably just change the $Data_Dir and maybe the
# $Pager (if necessary) and it oughta work)

# location of dbm
$Data_Dir = "/home/leonarm/public_html/source/cgi";

# name of dbm
$Dbm_Name = "incoming";

# Perms is the permissions used to open the dbm.  It should initially
# be 0644 (this will create the dbm the first time this script is run), 
# then change it to undef (this way, you'll know if the dbm disappears
# or is somehow hosed since the undef will not create the file).
#$Perms = "undef";
$Perms = "0644";

# names of fields in records (Don't change the number of these unless you've
# also changed them in guest.cgi)
@Rec_Field_Names = ("Email", "Page", "Comment");

# name of guestbook page
$Guestbook_Page = "guestbook.html";

# name of temporary file
$Temp_Filename = "ttemp.html";

# name of program for paging (less, more, etc.)
$Pager = "/usr/local/bin/less";

#
# begin script
#

# get number of fields in records
$i = 0;
while($Rec_Field_Names[$i]) {
	$i++;
} # while
$Rec_Field_Num = $i - 1;

# loop forever
# get action for incoming dbm
while (1 == 1) {
	$Answer = "";
	system "tput clear";
	print "Incoming dbm Maintainance\n\n";
	print "1 -- View all incoming records\n";
	print "2 -- View/Delete individual incoming records\n";
	print "3 -- Generate test web page from incoming dbm\n";
	print "4 -- Move all incoming records to guestbook (clears incoming dbm)\n";
	print "5 -- Clear incoming dbm.\n";
	print "6 -- Exit\n\n";
	print "Your choice: ";
	chop($Answer = <STDIN>);

	FAKESWITCH: {
		if ($Answer eq "1") {&View_All;      last FAKESWITCH;}
		if ($Answer eq "2") {&View_Delete;      last FAKESWITCH;}
		if ($Answer eq "3") {&Make_Test_Html("$Data_Dir/testbook.html"); last FAKESWITCH;}
		if ($Answer eq "4") {&Move_All_To_Gb;        last FAKESWITCH;}
		if ($Answer eq "5") {&Clear_Dbm("incoming"); last FAKESWITCH;}
		if ($Answer eq "6") {print "Thanks for using gbmaint!\n"; exit(0);};
	} # FAKESWITCH
} # while (main loop)

#
# subroutines after this
#

#
# View_Delete lets user go through recs 1 at a time and delete if they want
#
sub View_Delete {
	local($Answer) = "";
	local($Answer2) = "";
	system "tput clear";
	# loop through the "incoming" dbm
	if (dbmopen(%NEWUSERINFO, "$Data_Dir\/$Dbm_Name", "$Perms")) {
		foreach $Key (sort keys(%NEWUSERINFO)){
			$Record = $NEWUSERINFO{$Key};
			@Uservars = split(/\(/, $Record);
			$Answer = "";
			while (1 == 1) {
				system "tput clear";
				# loop through record fields
				print "\n";
				print "Record: $Key\n";
				for ($i = 0; $i <= $Rec_Field_Num; $i++) {
					print "$Rec_Field_Names[$i]: $Uservars[$i]\n";
				} # for
				print "(D)elete (N)ext (Q)uit: ";
				chop($Answer = <STDIN>);
				if ($Answer =~ /^[dD]$/) {
					print "Delete $Key [Y/N]: ";
					chop($Answer2 = <STDIN>);
					if ($Answer2 =~ /^[yY]$/) {
						# delete record from incoming dbm
						delete $NEWUSERINFO{"$Key"};
						print "\nDeleted $Key\n";
						print "Hit enter to continue ";
						<STDIN>;
						last;
					} # if
				} # if
				if ($Answer =~ /^[nN]$/) {
					# skip to next record
					last;
				} # if
				if ($Answer =~ /^[qQ]$/) {
					# done
					dbmclose(%NEWUSERINFO);
					return;
				} # if
			} # while
		} # while
	} else {
		die "Couldn't open incoming dbm, does it exist?\n";
	} # else
	dbmclose(%NEWUSERINFO);
	return;
} # View_Delete

#
# View_All lets user view all dbm records
#
sub View_All {
	system "tput clear";
	# open pipe to less for viewing
	if (open(PIPE, "| $Pager")) {
		# loop through the $Dbm_Name dbm
		if (dbmopen(%NEWUSERINFO, "$Data_Dir/$Dbm_Name", $Perms)) {
			foreach $Key (sort keys(%NEWUSERINFO)){
				$Record = $NEWUSERINFO{$Key};
				@Uservars = split(/\(/, $Record);
				# loop through record fields
				print PIPE "\n";
				print PIPE "Record: $Key\n";
				for ($i = 0; $i <= $Rec_Field_Num; $i++) {
					print PIPE "$Rec_Field_Names[$i]: $Uservars[$i]\n";
				} # while
			} # foreach
		} else {
			die "Couldn't open $Dbm_Name dbm, does it exist?\n";
		} # else
		close(PIPE);
	} else {
		# didn't get pipe to less, just print the records
		# loop through the $Dbm_Name dbm
		if (dbmopen(%NEWUSERINFO, "$Data_Dir/$Dbm_Name", $Perms)) {
			foreach $Key (sort keys(%NEWUSERINFO)){
				$Record = $NEWUSERINFO{$Key};
				@Uservars = split(/\(/, $Record);
				# loop through record fields
				print "\n";
				print "Record: $Key\n";
				for ($i = 0; $i <= $Rec_Field_Num; $i++) {
					print "$Rec_Field_Names[$i]: $Uservars[$i]\n";
				} # while
			} # foreach
		} else {
			die "Couldn't open $Dbm_Name dbm, does it exist?\n";
		} # else
	} # else
	dbmclose(%NEWUSERINFO);
	print "\nHit enter to return to main menu \n";
	<STDIN>;
	return;
} # View_All
 
#
# Make_Test_Html creates a simple page of incoming dbm records
#
sub Make_Test_Html {
	local($FILENAME) = $_[0];

	system "tput clear";

	open(TEMPFILE, "> $FILENAME") ||
		die "Couldn't open Testbook, check directory: $!";
	&Html_Header("Testbook", "Testbook entries", TEMPFILE);
	# loop through the "incoming" dbm
	if (dbmopen(%NEWUSERINFO, "$Data_Dir/incoming", $Perms)) {
		while (($Key, $Record) = each(%NEWUSERINFO)) {
			print "Adding $Key to Testbook\n";
			@Uservars = split(/\(/, $Record);
			if ($Key) {     			 # name
				$_ = $Key;
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				$Key = $_;
				print TEMPFILE "
$Key
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[0]) {      # email
				$_ = $Uservars[0];
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				$Uservars[0] = $_;
				print TEMPFILE "
$Uservars[0]
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[1]) {      # page
				print TEMPFILE "
<a href=\"$Uservars[1]\">$Uservars[1]</a>
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[2]) {      # comment
				$_ = $Uservars[2];
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				s/\cM/<br>/g;         # turn carriage returns into <br>s
				$Uservars[2] = $_;
				print TEMPFILE "
$Uservars[2]
<br>
";                      # close printing to html response
			} # if
			print TEMPFILE "<p>";
		} # while
		&Html_Trailer(TEMPFILE);
		print "\nCreated Testbook\n";
		print "Hit enter to continue ";
		<STDIN>;
	} else {
		die "Couldn't open incoming dbm, does it exist?\n";
	} # else
	close($FILENAME);
} # Make_Test_Html

#
# Move_All_To_Gb moves all incoming recs to guestbook, clears incoming dbm
#
sub Move_All_To_Gb {
	local($FILENAME) = "$Data_Dir\/$Temp_Filename";

	system "tput clear";

	# copy guestbook contents to temp file minus html trailer
	open(TEMPFILE, "> $FILENAME") ||
		die "Couldn't open $FILENAME";
	open(GUESTBOOK, "$Data_Dir\/$Guestbook_Page") ||
		die "Couldn't open $Data_Dir\/$Guestbook_Page: $!";
	while (<GUESTBOOK>) {
		# exclude the last lines, they'll be re-generated later (kludge?)
		if ($_ !~ /(\/html)|(\/body)|(LAST UP)/) {
			print TEMPFILE;
		} # if
	} # while
	close(GUESTBOOK);

	# loop through the "incoming" dbm
	if (dbmopen(%NEWUSERINFO, "$Data_Dir\/$Dbm_Name", $Perms)) {
		foreach $Key (sort keys(%NEWUSERINFO)){
			$Record = $NEWUSERINFO{$Key};
			@Uservars = split(/\(/, $Record);
			print "Adding $Key to Guestbook\n";
			if ($Key) {     			 # name
				$_ = $Key;
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				$Key = $_;
				print TEMPFILE "
<strong>$Key</strong>
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[0]) {      # email
				$_ = $Uservars[0];
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				$Uservars[0] = $_;
				print TEMPFILE "
$Uservars[0]
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[1]) {      # page
				print TEMPFILE "
<a href=\"$Uservars[1]\">$Uservars[1]</a>
<br>
";                      # close printing to html response
			} # if
			if ($Uservars[2]) {      # comment
				$_ = $Uservars[2];
				s/\</\|/g;            # disable html
				s/\>/\|/g;
				s/\cM/<br>/g;         # turn carriage returns into <br>s
				$Uservars[2] = $_;
				print TEMPFILE "
$Uservars[2]
<br>
";                      # close printing to html response
			} # if
			print TEMPFILE "<p>\n";
			delete $NEWUSERINFO{"$Key"};
		} # while
	} else {
		die "Couldn't open incoming dbm, does it exist?\n";
	} # else
	$Time = `date`;
	chop($Time);
	# definite kludge putting the "</center>" on this line
	print TEMPFILE "LAST UPDATED: $Time<p></center>\n";
	&Html_Trailer(TEMPFILE);
	close(TEMPFILE);
	dbmclose(%NEWUSERINFO);
	system "mv $FILENAME $Data_Dir\/$Guestbook_Page" ||
		print "Unable to mv $FILENAME to $Data_Dir\/$Guestbook_Page, check it out.\n";
	print "\nCreated Guestbook\n";
	print "Hit enter to continue ";
	<STDIN>
} # Move_All_To_Gb

#
# Clear_Dbm clears a dbm
#
sub Clear_Dbm {
	system "tput clear";
	local($Dbm_To_Clear) = $_[0];
	local($Answer) = "";
	# check to make sure...
	print "Are you sure you want to clear $Data_Dir\/$Dbm_To_Clear\n [Y/N]? ";
	chop($Answer = <STDIN>);
	if ($Answer =~ /^[yY]$/) {
		# clear it
		if (dbmopen(%TEMP, "$Data_Dir/$Dbm_To_Clear", $Perms)) {
			foreach $Key (keys %TEMP) {
				print "Deleting $Key\n";
				delete $TEMP{"$Key"};
			} # foreach
		} else {
			die "Couldn't open incoming dbm, does it exist?\n";
		} # else
		dbmclose(%TEMP);
		print "Cleared $Data_Dir\/$Dbm_To_Clear, hit enter to continue. ";
		<STDIN>;
	} # if
	return;
} # Clear_Dbm

# 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 {
	local($Document_Title) = $_[0];
	local($Document_Header) = $_[1];
	local($FILENAME) = $_[2];
	print $FILENAME "<html>\n";
	print $FILENAME "<head>\n";
	print $FILENAME "<title>$Document_Title</title>\n";
	print $FILENAME "</head>\n";
	print $FILENAME "<body>\n";
	print $FILENAME "<h1><center>$Document_Header</center></h1>\n";
	print $FILENAME "<p>\n";
} # Html_Header

sub Html_Trailer {
	local($FILENAME) = $_[0];
	print $FILENAME "</body>\n";
	print $FILENAME "</html>\n";
} # Html_Trailer