Post by Haldred on Jun 7, 2004 3:26:20 GMT
Well, there isn't a Perl thing here. So I figured I would post this here.
This is a VERY Basic GuestBook using Perl.
Save this as:
guestbook.cgi
Somewhere in there, it asks for where the File is. Put the EXACT location of the guestbook.cgi file there.
Then (I prefer it), make an HTML page, with a Link to the GuestBook.
Enjoy.
This is a VERY Basic GuestBook using Perl.
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'ENV'} = '';
$ENV{'IFS'} = '';
use CGI;
use strict;
use vars qw($__START__ $CGI $GUESTBOOK);
# change this to the real path to your guestbook file
$GUESTBOOK = "FILETOGUESTBOOK";
$CGI = "guestbook.cgi";
eval { main() }; $__START__ = __LINE__;
if ($@) {
chomp($@);
$@ =~ s/\(eval\) line (\d+)/${CGI} . " line " .
($__START__-$1-1)/e;
$@ =~ s/( at ).*( line )/$1${CGI}$2/;
my $error_message = $@;
print <<ERR;
Content-type: text/html
<html>
<head><title>Error</title></head>
<body>
<h1>Error</h1>
<code>$error_message</code>
</body>
</html>
ERR
}
exit(0);
# main
sub main {
my $q = new CGI;
# If we got some input, add a guestbook entry with that input
# Otherwise, show the guestbook.
if ($q->param()) {
add_entry($q);
} else {
display_guestbook($q);
}
}
# subroutines
# in: CGI object
# out:
# description:
# Reads the guestbook file & prints it as html
sub display_guestbook {
my $q = shift;
my ($html,$e,$num_entries,$entries);
$html = $q->header . $q->start_html("My Guestbook");
# The '.=' operator appends the right side of the
# expression to the left side; this line is functionally
# equivalent to saying '$html = $html . $q->h1("My Guestbook");
$html .= $q->h1("My Guestbook");
open (GB, "<$GUESTBOOK") ||
die "Unable to read guestbook file '$GUESTBOOK' (error: $!). " .
"Please try again later, or contact the webmaster of this " .
"site for assistance";
# Get a read lock on the guestbook
# The '\*GB' is a reference to the filehandle
# we just created when we opened the guestbook.
# We need to lock it so that nobody tries to write
# to it while we're reading it, which could produce
# 'unpredictable' results.
lock_filehandle(\*GB, 'R');
while (!eof(GB)) {
my $e = new CGI(\*GB); # read the 'frozen' CGI input
$num_entries++; # increment the entry counter
$entries .= draw_guestbook_entry($e); # and draw the entry
}
close (GB);
# Insert the count of entries, and the entries themselves, into
# the html page
if ($num_entries) {
$html .= "<p>Signed $num_entries time" . (($num_entries > 1) && ("s"));
$html .= $entries . "</p>";
} else {
$html .= "<h3>No entries!</h3><hr/>";
}
$html .= entry_form($q); # add the form to the page
$html .= $q->end_html; # and end the page
print $html;
}
# in: CGI object
# out:
# description:
# Adds entry to guestbook file, then prints guestbook html
sub add_entry {
my $q = shift;
my ($name,$email,$homepage,$msg,$entry,$url);
$url = $q->url;
untaint_params($q); # check & clean up the input
# Open the guestbook for appending
open (GB, ">>$GUESTBOOK") ||
die "Unable to write to guestbook (error: $!). " .
"Please try again later, or contact the webmaster " .
"of this site for assistance";
# get a write lock on the guestbook,
# so that nobody else tries to read or write
# to it while we're writing to it
lock_filehandle(\*GB, 'W');
$q->save(\*GB); # 'freeze' the CGI input into the file
# closing automatically removes the file lock
close GB;
# say thanks, with a link back to the questbook
print $q->header,
$q->start_html("Thanks"),
$q->h1("Thanks!"),
$q->h3("Your message has been added to my guestbook."),
$q->p,
$q->a({href=>$q->url}, "Go back to the guestbook"),
$q->end_html;
}
# in: guestbook entry
# out: guestbook entry in html format
# description:
# Format a guestbook entry as html
sub draw_guestbook_entry {
my $entry = shift;
my $author;
# import the CGI input into a namespace, for easy
# interpolation below.
$entry->import_names('E');
# include email & homepage links, if present
$author = $E::name;
if ($E::email =~ /(.*?)@((.*?)\.)+.*/) {
$author = qq|<a href="mailto:$E::email">$E::name</a>|;
}
if ($E::homepage) {
# make sure the homepage url begins with http://
$E::homepage =~ s|^(http://)?|http://|;
# qq means 'double quote' -- it works the same as putting
# "quotes" around something. We use it here because the
# something we're quoting has quotes in it already.
$author .= qq| (<a href="$E::homepage">$E::homepage</a>)|;
}
# 'here documents' aren't just for printing -- you can assign
# them to a variable or, as here, return them directly from
# a function
return <<ENTRY;
<p><b>$author</b>
<br/>$E::message</p>
<hr/>
ENTRY
}
sub entry_form {
my $q = shift;
my $url = $q->url;
my $form = <<E_FORM;
<h3>Sign my guestbook:</h3>
<form action="$url" method="post">
<p><b>Name</b>: <input type="text" name="name"/></p>
<p><b>E-mail</b>: <input type="text" name="email"/></p>
<p><b>Homepage</b>: <input type="text" name="homepage"/></p>
<p><b>Message</b>:</p>
<p><textarea cols="30" rows="6" wrap="virtual" name="message">Type your message here.</textarea>
<p><input type="submit"/></p>
</form>
E_FORM
# You don't have to use 'return' to return a value; the value
# of the last expression in a function will automatically be
# returned. In this case the expression is just a variable,
# so the value of the variable is returned.
$form;
}
# untaint_params
# in: CGI object
# out: trusted (scalar) params, or dies if suspicious input seen
# NOTE: this function will NOT work properly with multi-value params!
# If you submit a <select> field with multiple selections, you'll get
# an odd result: the number of selections made, not the selections
# themselves. Later in the book we'll show you how to deal with
# multiple-value fields in a function like this.
sub untaint_params {
my $q = shift;
my (@k, $k, $p);
@k = $q->keywords;
foreach $k(@k) {
$q->param(-name=>$k, -value=>untaint($q->param($k)));
}
}
sub untaint {
my $val = shift;
# allow alphanumeric characters, whitespace, and punctuation
my $ok_chars = q|[\w\s.,:/?!\-@'"]|;
die "Illegal character(s) in input ($val)" unless
($val =~ /^($ok_chars*)$/);
return $1;
}
# lock_filehandle
# in: filehandle
# out: -
# description: flock()s a filehandle, for concurrency-safe access
# This won't work on operating systems (like MacOS) that don't
# support flock().
sub lock_filehandle {
my $fh = shift;
my $lock = shift;
use Fcntl qw(:flock);
my $lock_code;
if ($lock =~ /^r/i) {
$lock_code = LOCK_SH;
} elsif ($lock =~ /^w/i) {
$lock_code = LOCK_EX;
} else {
$lock_code = LOCK_UN;
}
# give it two tries
unless (flock ($fh, $lock_code | LOCK_NB)) {
unless (flock($fh, $lock_code)) {
die "flock: could not get $lock lock on $GUESTBOOK";
}
}
return 1;
}
Save this as:
guestbook.cgi
Somewhere in there, it asks for where the File is. Put the EXACT location of the guestbook.cgi file there.
Then (I prefer it), make an HTML page, with a Link to the GuestBook.
Enjoy.
)
But I like PHP more...
.
