#!/usr/bin/perl 

# Guestbook program (version 1.14)
#
# Copyright 2001-2002 Felippe Mora


use 5.004;             # as written needs Perl 5.004 or later
use strict;            # enforce declarations and quoting
use CGI qw(:standard); # import shortcuts
use Fcntl qw(:flock);  # imports LOCK_EX, LOCK_SH, LOCK_NB

$| = 1; 

my (
    $URL, $GUESTFILE, $MAXSAVE, $PERPAGE, $BLOCKIMAGES, $CAPITALIZE,
    $TITLE, $WELCOME, $BGIMAGE, $BGCOLOR, $FORMCOLOR, $ERRCOLOR,
    $HOURADJUST, $TZONE,        
    $new,                # new entry in the guestbook
    @entries,            # holds all entries
    $entry,              # one particular entry   
    $timestamp,          # date and time (adjustable for different timezones)
    $ip, $remotehost,    # IP, DNS address of message sender
    $link,               # email or URL of guest
    $formatted_message,  # message with HTML line breaks inserted
    $count,              # total number of messages
    $number,             # message being displayed   
    $page, $newpage,     # page number being displayed, new page to display
    $next, $remaining,   # number of previous messages on next page, remaining 
    $sorry,              # error message regarding user entry
   );

### site defaults
$GUESTFILE = "guestbook";                # name of guestbook file
$MAXSAVE = 100;                          # how many messages to save
$PERPAGE = 20;                           # how many messages per page
$BLOCKIMAGES = 0;                        # block inline images from messages
$CAPITALIZE = 1;                         # capitalize names
$TITLE = "Cousins Picninc's Guestbook";                    # page title 
$WELCOME = "<font color=#ffff00>The NEW Cousins Picnic's Guestbook:</font>";    # <H3>$WELCOME</H3>
$BGIMAGE = '';
$BGCOLOR = 'green';                    # overall background color
$FORMCOLOR = '#ffff00';                  # background color for input form
$ERRCOLOR = 'red';                       # font color for error messages
$HOURADJUST = 0;                         # add this local hour 
$TZONE = 'EST';                          #  to display this time zone
#                                        #  automatically adjusts for
###                                      #  daylight savings (EST -> EDT, etc)


print header, start_html(-TITLE => $TITLE,
			 -BACKGROUND => $BGIMAGE,
                         -BGCOLOR => "$BGCOLOR"), h2($WELCOME);


$new = CGI->new();                         # get request
$URL = $new->script_name();                # capture script URL
greet($new->param("name"));                # greet any special visitors
if  ($CAPITALIZE) {                        # capatalize visitors name  
    my $name = $new->param("name");
    $name =~ s/(\w+)/\u$1/g;                  
    $new->param("name",$name);
}
if ($new->param("message") =~ m/\S/) {     # new (non-null) message
    if ($BLOCKIMAGES && $new->param("message") =~ m/<\s*IMG\s*.*SRC\s*=/i) {
	$sorry = 'Sorry, you cannot embed images in messages.';
    } elsif (!($new->param("name") =~ m/\S/)) {
	$sorry = 'You have to enter a name to send a message.'.
	         ' [Be creative and make one up.]';
    } else {
	$timestamp = get_time();
	$new->param("date", $timestamp);       # set the current date/time
	$new->param("agent",$ENV{'HTTP_USER_AGENT'});  # save remote agent 
	$ip = $ENV{'REMOTE_HOST'};             # save remote host address
	$remotehost = hostname($ip) || $ip; 
	$new->param("host", $remotehost);
	@entries = ($new);                     # save message to array
    };
};

# open the file for read-write (preserving old contents)
if (-e $GUESTFILE) {
    open(CHANDLE, "+< $GUESTFILE") || bail("cannot open $GUESTFILE: $!");
} else {
    open(CHANDLE, "+> $GUESTFILE") || bail("cannot open $GUESTFILE: $!"); 
}
# get exclusive lock on the guestbook
flock(CHANDLE, LOCK_EX) || bail("cannot flock $GUESTFILE: $!");

# grab up to $MAXSAVE old entries, newset first
while (!eof(CHANDLE) && @entries < $MAXSAVE) {
    $entry = CGI->new(\*CHANDLE);   # pass the filehandle by reference
    push @entries, $entry;
    $count++;
}
seek(CHANDLE, 0, 0) || bail("cannot rewind $GUESTFILE: !");
foreach $entry (@entries) {
    $entry->save(\*CHANDLE);        # pass the filehandle by reference
}
truncate(CHANDLE, tell(CHANDLE)) || 
                                 bail("cannot truncate $GUESTFILE: $!");
close(CHANDLE) || bail("cannot close $GUESTFILE: $!");


print hr;  # table around table produces a colored border in Netscape
print "<font size=-1 color=ffffff><b>All messages should now be posted in the
<a href=http://www.cousinspicnic.com/boards/><font size=-1 color=ff8000>Forums</font></a></b></font><br><br><a href=fsguestbook.html><font size=-1 color=ff8000><B>View entries form the OLD Guestbook</B></font></a></TD></TR></TABLE>\n"; 
print hr;


print "<CENTER><B><FONT COLOR=\"$ERRCOLOR\">$sorry</FONT></B></CENTER>", 
                      hr if ($sorry);  # display user entry error message

$page = $new->param("page") || 1;      # get page to be displayed
if ($page > 1) {                       # print "go back" message if needed 
    $newpage = $page-1;
    print "<CENTER><B><A HREF=\"$URL?page=$newpage\">
           Show $PERPAGE more recent messages</a>
      </B></CENTER><HR>\n";
}
$number=0;
foreach $entry (@entries) {
    if (($page-1)*$PERPAGE <= $number) {  # display only the proper 
	if ($number < $page*$PERPAGE) {   # number of messages for each page
           $formatted_message = $entry->param("message");
           $formatted_message =~ s/(.+)\n/$1<BR>/g;  # preserve line breaks
	    $link = $entry->param("email");
	    if ($link) {
		if ($link =~ m/@/) {
		    printf ("<B><a href=\"mailto:%s\"><font color=#ffcc00>%s</font></a></B>\n",
			    $link, $entry->param("name"));
		} else {
		    $link =~ s/^http:(\/\/|\\)//;	    
		    printf ("<B><a href=\"http:\/\/%s\">%s</a></B>\n",
			    $link, $entry->param("name"));
		};
	    } else {
		printf ("<B>%s</B>\n", $entry->param("name"));
	    };
	   printf ("<font color=#ffffff> %s<P> %s</font>\n", 
		   $entry->param("date"), $formatted_message );
# this is another way to preserve line breaks, but it doesn't look as nice:
#	   printf (" %s <BR><PRE>%s</PRE>\n",
#	           $entry->param("date"),
#	           $entry->param("message"));
	   print hr;
	};
    };
    $number++;
}
$remaining = $count-$PERPAGE*$page;     # number of older messages 
if ($remaining > 0) {                   
    if ($remaining < $PERPAGE) {        # determine number on next page
	$next = $remaining;
    } else {
	$next = $PERPAGE;
    };
    $newpage = $page + 1 ;              # next page number
    print "<CENTER><B><A HREF=\"$URL?page=$newpage\">   
                      Show $next of $remaining earlier messages</a>
           </B></CENTER><HR>\n";
};


### uncomment these lines to add a VersaCounter to page
#   (adjust directory paths and options as necessary)
#{
#local $ENV{'DOCUMENT_URI'} = '/cgi-bin/guestbk';       # page name
#local $ENV{'REQUEST_METHOD'} = 'GET';                  # ensure GET method
#local $ENV{'QUERY_STRING'} = 'header=0&show=nothing';  # counter options
#print `/usr/local/www/cgi-bin/counter`;                # call counter
#}
###

print end_html;


sub greet {

    my %special = ( 'bill clinton' => 'Thank you, Mr. President'
		   );
	
    foreach (keys %special) {
	$sorry = $special{$_} if ($_[0] =~ m/$_/i);
    };

}

sub get_time {

my (
    $sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst,
    @months
    );
    @months = ("January","February","March","April","May","June","July",
	       "August","September","October","November","December");
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst) 
	                                 = localtime(time()+$HOURADJUST*3600);
    if ($hour < 10) {
	$hour = '0'.$hour;
    }    
    if ($min < 10) {
	$min = '0'.$min;
    }
    if ($sec < 10) {
	$sec = '0'.$sec;
    }
    $year += 1900;               # Y2K OK!
    $TZONE =~ tr/S/D/ if ($dst); # fix time zone string for daylight savings 
    return $timestamp = "$months[$mon] $mday, $year $hour:$min:$sec ($TZONE)";

}


sub hostname {

    my (@bytes, 
	$packedaddr, 
	$host_name
	);

        @bytes = split(/\./, $_[0]);
        $packedaddr = pack("C4",@bytes);
        $host_name = (gethostbyaddr($packedaddr, 2))[0];
        return($host_name);

}


sub bail {             # print errors directly to browser
    my $error = "@_";
    print h1("Error:"), p($error), end_html;
    die $error;
}