Free source guestbook - unfinished

[Robin]

#!/usr/bin/perl -T

use strict;
use warnings;

use CGI qwall);

$CGI:OST_MAX=1024 * 100; # max 100K posts
$CGI:ISABLE_UPLOADS = 1; # no uploads

$" = '';

$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';

my $homepage = "http://www.infusedlight.net"; #change this to your homepage
my $string = '<--->';
my $string2 = '<---->';
my $version = '1.0.0';
my $bookfile = 'book.txt';
my $headerfile = 'header.txt';
my $footerfile = 'footer.txt';
my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_UN = 8;
my $DATE = getdate();
my @head = gethead ($headerfile);
my @foot = getfoot ($footerfile);

if (url_param ('action') eq "sign")
{
sign();
}

elsif (url_param ('action') eq "dosign")
{
dosign();
}
else
{
if (! -e $bookfile)
{
if (open (BOOKFILE, ">$bookfile"))
{
flock (BOOKFILE, $LOCK_EX);
print BOOKFILE '';
flock (BOOKFILE, $LOCK_UN);
close (BOOKFILE);
}
else
{
print header and print "<center><strong>Viewing Guestbook - Version
$version - No guests</strong><hr><a href=\"$homepage\">To
homepage</a></center>" and exit;
}
}
view (1);
}

sub sign
{
print header;
print (@head);
print <<END;
<div align="center">
<p><strong>GBOOK2 - Sign Guestbook - Version $version</strong></p>
<hr size="1">
<form name="form1" method="post" action="gbook.pl?action=dosign">
<table width="85%" border="1" align="center" cellpadding="3"
cellspacing="0" bordercolor="#660000">
<tr>
<td width="50%" bgcolor="#CCCCCC">Your name:</td>
<td width="50%" bgcolor="#999999">
<div align="center">
<input name="name" type="text" id="name">
</div></td>
</tr>
<tr>
<td bgcolor="#999999">Your email: </td>
<td bgcolor="#CCCCCC"><div align="center">
<input name="email" type="text" id="email">
</div></td>
</tr>
<tr>
<td bgcolor="#CCCCCC">Your web site name (not required):</td>
<td bgcolor="#999999"><div align="center">
<input type="text" name="webname">
</div></td>
</tr>
<tr>
<td bgcolor="#999999">Your web site URL (not required):</td>
<td bgcolor="#CCCCCC"><div align="center">
<input name="url" type="text" id="url">
</div></td>
</tr>
<tr>
<td bgcolor="#CCCCCC">Your message: </td>
<td bgcolor="#999999"><div align="center">
<textarea name="message" cols="35" rows="4"
id="message"></textarea>
</div></td>
</tr>
<tr>
<td bgcolor="#333399">
<div align="right">
<input type="submit" name="Submit" value="Submit">
</div></td>
<td bgcolor="#333399">
<div align="left">
<input type="reset" name="Submit2" value="Reset">
</div></td>
</tr>
</table>
</form>
<hr size="1">
</div>
END
print (@foot);
}

sub dosign
{
if (checkforcookie() eq "true")
{
#print header;
#print (@head);
#print ("<center>You have already signed the guestbook once today. Please
sign it again tommorow.<hr></center>");
#print (@foot);
#exit;
}
my $name = param ('name');
my $email = param ('email');
my $website = param ('webname') . $string2 . param ('url');
my $message = param ('message');
if (param ('url') !~ /<.*>/ and param ('webname') !~ /<.*>/ and param
('url') !~ /^\s*$/s and param ('webname') !~ /$string2|$string/ and param
('url') !~ /$string2|$string/)
{
my (@url);
@url = split (/$string2/, $website);
if ($url[1] ne '' and $url[0] eq '')
{
$website = <<END;
<a href="$url[1]">$url[1]</a>
END
}
elsif ($url[0] ne '' and $url[1] ne '')
{
$website = <<END;
<a href="$url[1]">$url[0]</a>
END
}
elsif ($url[0] ne '' and $url[1] eq '')
{
$website = 'None';
}
elsif ($url[0] eq '' and $url[1] eq '')
{
$website = 'None';
}
}
else
{
$website = 'None';
}
if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g and
$email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url') !~
/<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message !~
/$string/g and $website !~ /$string/g and $email !~ /$string/g and $name !~
/$string2/g and $message !~ /$string2/g and $email !~ /$string2/g and param
('webname') !~ /$string2/g and param ('url') !~ /$string2/g)
{
open (BOOKFILE, ">>$bookfile") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (BOOKFILE, $LOCK_EX);
print BOOKFILE <<"END";
<div align="center">
<table width="75%" border="1" cellpadding="3" cellspacing="0"
bordercolor="#660000" align="center">
<tr>
<td>Date of message: </td>
<td>$DATE</td>
</tr>
<tr>
<td width="50%">Name:</td>
<td width="50%">$name</td>
</tr>
<tr>
<td width="50%">Email:</td>
<td width="50%">$email</td>
</tr>
<tr>
<td>Website:</td>
<td>$website</td>
</tr>
<tr>
<td>Message:</td>
<td>$message</td>
</tr>
</table>
<hr size="1">
$string
END
flock (BOOKFILE, $LOCK_UN);
close (BOOKFILE);
chmod (0770, $bookfile);
setcookie ("gbook.pl");
exit;
}

else
{
printerror1 ();
}
}
sub view
{
my ($header) = @_;
open (BOOKFILE, $bookfile) or print header and print
"<center><strong>Viewing Guestbook - Version $version - No
guests</strong><hr><a href=\"$homepage\">To homepage</a></center>" and exit;
flock (BOOKFILE, $LOCK_SH);
my @contentsofbook=<BOOKFILE>;
flock (BOOKFILE, $LOCK_UN);
close (BOOKFILE);
my $contentsofbook=join('', @contentsofbook);
@contentsofbook = split (/$string/, $contentsofbook);
@contentsofbook = reverse (@contentsofbook);
my $len = @contentsofbook;
$len -= 1;
my $s;
$s = 's' if ($len > 1);
print header if ($header);
print (@head);
my $cookie2;
$cookie2 = getcookie();
print <<END;
<div align="center">
<strong>GBOOK2 - Viewing Guestbook - Version $version - $len
guest$s</strong>
<hr size="1"><a href="$homepage">To homepage</a><br><br>
END
if (url_param ('s') ne '' and url_param ('e') ne '')
{
printpages();
}
if (@contentsofbook)
{
print @contentsofbook;
}
else
{
print "No guests.";
}
#print "<br>";
if (url_param ('s') ne '' and url_param ('e') ne '')
{
printpages();
}
print <<END;
<br><a href="$homepage">To homepage</a></div>
END
print (@foot);
exit;
}

sub printpages
{
return;
}

sub printerror1
{
print header;
print (@head);
print ("<center>You did not supply the required fields or you used HTML
tags which are not allowed on this guestbook.<hr></center>");
print (@foot);
exit;
}

sub gethead
{
my ($header) = @_;
my @header;

if (-e "$header")
{
open (HEADER, "$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, $LOCK_SH);
@header = <HEADER>;
flock (HEADER, $LOCK_UN);
close (HEADER);
}
else
{
open (HEADER, ">$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, $LOCK_EX);
print HEADER <<END;
<html>
<head>
<title>GBOOK2 Version $version</title>
</head>
<body>
END
flock (HEADER, $LOCK_UN);
close (HEADER);
open (HEADER, "$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, $LOCK_SH);
@header = <HEADER>;
flock (HEADER, $LOCK_UN);
close (HEADER);
}
chmod (0770, $header);
return @header;
}

sub getfoot
{
my ($footer) = @_;
my @footer;
if (-e "$footer")
{
open (FOOTER, "$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, $LOCK_SH);
@footer = <FOOTER>;
flock (FOOTER, $LOCK_UN);
close (FOOTER);
}
else
{
open (FOOTER, ">$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, $LOCK_EX);
print FOOTER <<END;
</body></html>
END
close (FOOTER);
open (FOOTER, "$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, $LOCK_SH);
@footer = <FOOTER>;
flock (FOOTER, $LOCK_UN);
close (FOOTER);
}
chmod (0770, $footer);
return @footer;
}


sub getdate
{
open (DATE, "date +%D|") or print header and print "Date could not be
obtained. Please contact your system's administrator.<hr>" and exit;
my $date = <DATE>;
$date =~ s/\n//g;
$date =~ s/\r//g;
close (DATE);
return ($date);
}

sub setcookie
{
my ($redir) = @_;
my $cookie;
$cookie = cookie (-name=>'signed', -value=>"signed", -expires=>'+1d');
print redirect (-url=>"$redir", -cookie=>"$cookie");
}


sub checkforcookie
{
my $cookieflag;
$cookieflag = '';
if (getcookie() eq 'signed')
{
$cookieflag = 'true';
}
return ($cookieflag);
}

sub getcookie
{
my $cookiein;
$cookiein = cookie ('signed');
return $cookiein;
}




---------------------------------

 

[A. Sinan Unur]

my $string = '<--->';
my $string2 = '<---->';

Use meaningful names for your variables.

my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_UN = 8;

Don't do that. See perldoc -f flock.

my $DATE = getdate();
my @head = gethead ($headerfile);
my @foot = getfoot ($footerfile);

if (url_param ('action') eq "sign")
{
sign();
}

elsif (url_param ('action') eq "dosign")
{
dosign();
}
else
{

You can benefit from using the CGI::Application module. At the very
least, you can set up a hash like (untested code type directly into
newsreader follows):

my %handlers = (
'default' => \&default,
'sign' => \&sign,
'dosign' => \&dosign,
# etc ...
);

my $q = CGI->new();
my $action = $q->param('action') || 'default';
$handlers{$action}->($q);

You should at the very least read the docs for CGI::Application and
HTML::Template.

if (! -e $bookfile)
{
if (open (BOOKFILE, ">$bookfile"))
{
flock (BOOKFILE, $LOCK_EX);
print BOOKFILE '';
flock (BOOKFILE, $LOCK_UN);
close (BOOKFILE);

Don't do that. See perldoc -f flock.

sub sign
{
print header;
print (@head);
print <<END;
<div align="center">
<p><strong>GBOOK2 - Sign Guestbook - Version $version</strong></p>
<hr size="1">
<form name="form1" method="post" action="gbook.pl?action=dosign">
<table width="85%" border="1" align="center" cellpadding="3"

Do look into HTML::Template.

sub dosign
{
if (checkforcookie() eq "true")
{
#print header;
#print (@head);
#print ("<center>You have already signed the guestbook once today.
Please
sign it again tommorow.<hr></center>");
#print (@foot);
#exit;
}

OK, this is getting very entertaining ...

if (param ('url') !~ /<.*>/ and param ('webname') !~ /<.*>/ and
param
('url') !~ /^\s*$/s and param ('webname') !~ /$string2|$string/ and
param ('url') !~ /$string2|$string/)
Argh!

$website = <<END;
<a href="$url[1]">$url[1]</a>
END

Argh! Argh! Argh!

if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g
and
$email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url')
!~ /<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message
!~ /$string/g and $website !~ /$string/g and $email !~ /$string/g and
$name !~ /$string2/g and $message !~ /$string2/g and $email !~
/$string2/g and param ('webname') !~ /$string2/g and param ('url') !~
/$string2/g)
Sheeeesh!

{
open (BOOKFILE, ">>$bookfile") or print header and print "An error
occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (BOOKFILE, $LOCK_EX);
print BOOKFILE <<"END";

Hmmmmm ...

flock (BOOKFILE, $LOCK_UN);

Don't do that. See perldoc -f flock

close (BOOKFILE);
chmod (0770, $bookfile);
setcookie ("gbook.pl");

What if the poster's browser is not accepting cookies?

flock (BOOKFILE, $LOCK_SH);

Don't do that. See perldoc -f flock.

my @contentsofbook=<BOOKFILE>;
flock (BOOKFILE, $LOCK_UN);
close (BOOKFILE);
my $contentsofbook=join('', @contentsofbook);
@contentsofbook = split (/$string/, $contentsofbook);
@contentsofbook = reverse (@contentsofbook);

If I am not mistake, you have already done some work storing HTML in the
BOOKFILE. What the heck is going on here?

sub printpages
{
return;
}

This sub is the best code you have written so far.

sub printerror1
{
print header;
print (@head);

Try passing arguments to your subs.

sub gethead
{
my ($header) = @_;
my @header;

if (-e "$header")

Useless use of quotes.

sub getdate
{
open (DATE, "date +%D|") or print header and print "Date could not be
obtained. Please contact your system's administrator.<hr>" and exit;

This message is misleading to someone trying to submit an entry to the
guestbook.

 

[Tintin]

Thankfully, you do appear to be taking some notice of the advice given by
the experts here (eventually)

#!/usr/bin/perl -T

use strict;
use warnings;

use CGI qwall);

Good start

my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_UN = 8;

use Fnctl qwflock);

instead of defining your own constants/

if (url_param ('action') eq "sign")
{
sign();
}

It would be helpif you followed a more standard code formatting style. See
perldoc perlstyle

print header and print "<center><strong>Viewing Guestbook - Version
$version - No guests</strong><hr><a href=\"$homepage\">To
homepage</a></center>" and exit;

I'm sure you must have been told many times about alternate quoting
mechanisms and using uppercase file handles.

sub getdate
{
open (DATE, "date +%D|") or print header and print "Date could not be
obtained. Please contact your system's administrator.<hr>" and exit;
my $date = <DATE>;
$date =~ s/\n//g;
$date =~ s/\r//g;
close (DATE);
return ($date);
}

Now I find it difficult to believe after all this time, you don't know about
Perl's internal date functions. Also, why isolate most of the world with an
ambigious date format?

Overall, on the improve, but can/should do much better.

 

[Robin]

yes, I admit it needs work. Thanks you two.
I'll post the revision when it's done.
Later.

 

[Joe Smith]

sub getdate { open (DATE, "date +%D|") ...

A bit inefficient using an external program like that.

I use either
return scalar localtime;
or something like this:

sub get_now {
my ($sec,$min,$hour,$day,$month,$year) = localtime;
sprintf "%4d/%02d/%02d %02d:%02d:%02d",
$year+1900, $month+1, $day, $hour, $min, $sec;
}

The advantage of the result from get_now() is that it sorts properly
into chronological (or reverse chronological) order.
-Joe