free source guestbook (finished)

[Robin]

#!/usr/bin/perl -wT

use Fcntl qw flock);
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 $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;
$len = "No" if ($len == -1);
my $s;
$s = 's' if ($len > 1 or $len eq "No");
print header if ($header);
print (@head);;
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
printpages();
print "<br><br>" if (@contentsofbook);
my $content;
my @contentslen;
@contentslen = @contentsofbook[(url_param ('start') - 1) ..
(url_param('end'))] if (url_param ('start') == 1);
@contentslen = @contentsofbook[(url_param ('start')) .. (url_param('end') -
1)] if (url_param ('start') > 10);
if (! @contentsofbook)
{
print "No guests.";
}
if (url_param ('start') ne '' and url ('end') ne '')
{
print @contentslen;
}
else
{
@contentslen = @contentsofbook[0 .. 10];
print @contentslen;
}
printpages();
print "<br><br>";
print <<END;
<a href="$homepage">To homepage</a></div>
END
print (@foot);
exit;
}

sub printpages
{
my ($counter, $counter2, $tempcount);
open (BOOKFILE, $bookfile) or print "An error occured during this
operation. Please try again.";
flock (BOOKFILE, LOCK_SH);
my @contentstoprint = <BOOKFILE>;
flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);
$counter = 0;
$counter2 =1;
$tempcount = 0;
my $contentstoprint = join ('', @contentstoprint);
@contentstoprint = split (/$string/, $contentstoprint);
@contentstoprint = reverse (@contentstoprint);
my $content1;
print "Pages: [ <a href=\"gbook.pl?start=1&end=10\">1</a> ] " unless (!
@contentstoprint);
foreach $content1 (@contentstoprint)
{
if ($counter == 11)
{
$counter2 += 1;
print "[ <a href=\"gbook.pl?start=$tempcount&end=" , $tempcount + 10 ,
"\">$counter2</a> ] ";
if ($counter2 > 0)
{
$counter = 1;
}
else
{
$counter = 0;
}
}
$tempcount += 1;
$counter += 1;
}
}
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 {
my ($day, $mon, $year)=(localtime)[3,4,5];
$mon++; #month is returned in a 0-11 range
$year +=1900;
my $date = $mon . "/" . $day . "/" . $year;
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;
}

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

yeah I know the indents suck, but I'm too lazy to clean them up. it's just
my program screws them up.
Later,
-Robin

 

[Tassilo v. Parseval]

Also sprach Robin:

Only some essential comments and leaving other issues (like the
idiosyncractic indenting aside):

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

Code like this is almost always wrong. It contains a subtle
race-condition. In theory it's possible that the file does not exist by
the time of the -e check but is created by some other visitor of your
gustbook in between the -e and the open(). Sounds contrived, but it's
possible.

The code above apparently only creates the file if it does not yet
exist. You can drop this checking and creating altogether. You are later
using '>>' for opening. This will create the file for you if it isn't
already there and append otherwise.

sub dosign
{
if (checkforcookie() eq "true")

You made a rather bad choice for checkforcookie()'s return value. "true"
or (in case you use that as well; haven't yet checked) are misleading as
they are both true to perl. Have a function return 1 when you mean true
and 0 (or undef) when you mean false. And then do the check like that:

if (checkforcookie()) {

{
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/)

I hate long lines such as these especially when they are formatted
badly. Line the various conditions up properly:

if (param('url') !~ /<.*>/ and
param('webname') !~ /<.*>/ and
...) {

Also, the /s in '/^\s*$/s' does nothing, so drop that.

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)

Uggh. Maybe it's time to create a function that does the above check for
you. And again, watch your regex modifiers. What is /g supposed to do in
the above matches?

{
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);

Note how this will create $bookfile if it doesn't exist. This is the
behaviour you want and why cou should drop the preliminary check for its
existance further above.

flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);

An explicit unlock is not necessary as closing the file will unlock it
for you. On older perls this can even be a problem as unlocking did not
flush the file. On recent perls however, it is ok. Just drop the LOCK_UN
stuff.

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>;

This can become a problem one day when the gustbook is large. Also
remember that CGI scripts run concurrently. If you have ten users all
requesting to see the guestbook, you have to read keep it in memory ten
times.

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

This looks inefficient. You join it and split it again immediately
afterwards. As I recall, $string is the separator you use between
entries or so. That means you can have perl do that work for you
implicitely:

my @contentsofbook = do {
local $/ = $string;
<BOOKFILE>;
};

After that you have one entry in each array element.

print @contentslen;
}
else
{
@contentslen = @contentsofbook[0 .. 10];
print @contentslen;
}

Bad variable names here. @contentslen does not contains lengths of
something. It apparently contains guastbook entries. Your variable names
should reflect that.

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

if (-e "$header")

Those quotes are not needed. Anything that is not needed should be
dropped. That's one principle of programming.

{
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

You do things at runtime that should be done on installation time. Add
to your README that a header file has to exist. It will simplify your
script if it can be sure that certain files are there.

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;
}

Same for the footer. What you can do is provide an installation script
in your distribution that will first check the integrity and existance
of all files and, in case they aren't there, create them.

sub getdate {
my ($day, $mon, $year)=(localtime)[3,4,5];
$mon++; #month is returned in a 0-11 range
$year +=1900;
my $date = $mon . "/" . $day . "/" . $year;
return $date;
}

Ah, good, you eventually got rid of the call to 'date'.

yeah I know the indents suck, but I'm too lazy to clean them up. it's just
my program screws them up.

Use a better editor. It's no excuse to use bad tools. If you use a sane
editor like vim or emacs, correcting the indentation is just one
key-stroke away. Also, there is

http://perltidy.sf.net/

It can't hurt to let it run over your script.

Tassilo

 

[Robin]

Also sprach Robin:

Only some essential comments and leaving other issues (like the
idiosyncractic indenting aside):

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

Code like this is almost always wrong. It contains a subtle
race-condition. In theory it's possible that the file does not exist by
the time of the -e check but is created by some other visitor of your
gustbook in between the -e and the open(). Sounds contrived, but it's
possible.

The code above apparently only creates the file if it does not yet
exist. You can drop this checking and creating altogether. You are later
using '>>' for opening. This will create the file for you if it isn't
already there and append otherwise.

sub dosign
{
if (checkforcookie() eq "true")

You made a rather bad choice for checkforcookie()'s return value. "true"
or (in case you use that as well; haven't yet checked) are misleading as
they are both true to perl. Have a function return 1 when you mean true
and 0 (or undef) when you mean false. And then do the check like that:

if (checkforcookie()) {

{
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/)

I hate long lines such as these especially when they are formatted
badly. Line the various conditions up properly:

if (param('url') !~ /<.*>/ and
param('webname') !~ /<.*>/ and
...) {

Also, the /s in '/^\s*$/s' does nothing, so drop that.

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)

Uggh. Maybe it's time to create a function that does the above check for
you. And again, watch your regex modifiers. What is /g supposed to do in
the above matches?

{
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);

Note how this will create $bookfile if it doesn't exist. This is the
behaviour you want and why cou should drop the preliminary check for its
existance further above.

flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);

An explicit unlock is not necessary as closing the file will unlock it
for you. On older perls this can even be a problem as unlocking did not
flush the file. On recent perls however, it is ok. Just drop the LOCK_UN
stuff.

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>;

This can become a problem one day when the gustbook is large. Also
remember that CGI scripts run concurrently. If you have ten users all
requesting to see the guestbook, you have to read keep it in memory ten
times.

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

This looks inefficient. You join it and split it again immediately
afterwards. As I recall, $string is the separator you use between
entries or so. That means you can have perl do that work for you
implicitely:

my @contentsofbook = do {
local $/ = $string;
<BOOKFILE>;
};

After that you have one entry in each array element.

print @contentslen;
}
else
{
@contentslen = @contentsofbook[0 .. 10];
print @contentslen;
}

Bad variable names here. @contentslen does not contains lengths of
something. It apparently contains guastbook entries. Your variable names
should reflect that.

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

if (-e "$header")

Those quotes are not needed. Anything that is not needed should be
dropped. That's one principle of programming.

{
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

You do things at runtime that should be done on installation time. Add
to your README that a header file has to exist. It will simplify your
script if it can be sure that certain files are there.

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;
}

Same for the footer. What you can do is provide an installation script
in your distribution that will first check the integrity and existance
of all files and, in case they aren't there, create them.

sub getdate {
my ($day, $mon, $year)=(localtime)[3,4,5];
$mon++; #month is returned in a 0-11 range
$year +=1900;
my $date = $mon . "/" . $day . "/" . $year;
return $date;
}

Ah, good, you eventually got rid of the call to 'date'.

yeah I know the indents suck, but I'm too lazy to clean them up. it's just
my program screws them up.

Use a better editor. It's no excuse to use bad tools. If you use a sane
editor like vim or emacs, correcting the indentation is just one
key-stroke away. Also, there is

http://perltidy.sf.net/

It can't hurt to let it run over your script.

Tassilo

pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
[/QUOTE]
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval

thanks tassilo, thanks bigtime, I shall probably get back to work on it
soon. This is great advice. BTW, the /g modifier means global replace.
-Robin

 

[Robin]

You do things at runtime that should be done on installation time. Add
to your README that a header file has to exist. It will simplify your
script if it can be sure that certain files are there.

Same for the footer. What you can do is provide an installation script
in your distribution that will first check the integrity and existance
of all files and, in case they aren't there, create them.

your right, the header and footer are packaged with the zip file for the
guestbook though, and I implicitly implied that you can edit them, so I
guess I should change it to something else. The files don't really have to
exist though. Although I might add code like
if (! gethead ($headerfile))
{
@head = ('<html>', '<body>, 'etc');
}
else
{
@head = gethead ($headerfile);
}

Do you think that's a good idea?

Thanks,
-Robin

 

[Sherm Pendley]

BTW, the /g modifier means global replace.

Please don't parrot the docs back at people who understand them a lot better
than you do. It's rude.

The /g modifier specifies global operation when used with s///. But the
above code isn't doing any substitution; it's just matching with //. So,
the /g in the above doesn't do anything.

Now, the question remains: What did you *think* it was going to do?

sherm--

 

[Sherm Pendley]

I should change it to something else. The files don't really have to
exist though. Although I might add code like
....

Do you think that's a good idea?

Writing your code so that it's able to cope with exceptional situations -
such as missing and/or unreadable templates - is *always* a good idea. No
one can ever predict all of the possible error conditions, of course; as
soon as we write idiot-proof code, along comes a better idiot. But it's
still worth making the attempt.

One idea you should forget about, though, is the one in the subject. Code is
very rarely, if ever, "finished." Virtually everything you write will need
to be maintained over time.

That's one reason for good formatting, descriptive variable names, comments,
and all that good stuff. It's not just for other people - it's for you too.
Trying to modify one's own five- or ten-year-old code can be an educational
experience.

sherm--

 

[Tassilo v. Parseval]

Also sprach Robin:

your right, the header and footer are packaged with the zip file for the
guestbook though, and I implicitly implied that you can edit them, so I
guess I should change it to something else. The files don't really have to
exist though. Although I might add code like

[...]

You also mailed this as a CC to me. It would help if you could in future
mention this in your mail, otherwise I reply via mail just to realize a
bit later that I should have better responded in the group.

Tassilo

 

[Robin]

Please don't parrot the docs back at people who understand them a lot better
than you do. It's rude.

The /g modifier specifies global operation when used with s///. But the
above code isn't doing any substitution; it's just matching with //. So,
the /g in the above doesn't do anything.

Now, the question remains: What did you *think* it was going to do?

sherm--

your right, I misread my code...sorry everyone...

later,
-Robin

 

[Robin]

Also sprach Robin:

your right, the header and footer are packaged with the zip file for the
guestbook though, and I implicitly implied that you can edit them, so I
guess I should change it to something else. The files don't really have to
exist though. Although I might add code like

[...]

You also mailed this as a CC to me. It would help if you could in future
mention this in your mail, otherwise I reply via mail just to realize a
bit later that I should have better responded in the group.

yeah, I had more to say than one message could say, and I didn't realize it
at first.
-Robin

 

[Matt Garrish]

your right, I misread my code...sorry everyone...

My right? Your left!

How does one misread their own code presumably after having just written it?
Would you please stop posting every stupid thought that comes into your
head.

Matt

 

[Tassilo v. Parseval]

Also sprach Robin:

yeah, I had more to say than one message could say, and I didn't realize it
at first.

That was not what I meant. If you post a follow-up to a posting and
additionally send the follow-up as mail, state that in the mail with
something like

[ also posted to comp.lang.perl.misc ]

or

[ posted and mailed ]

or so.

Tassilo

 

[Michele Dondi]

[snip *252* lines of unneccessary quoted content, including .sig!]

thanks tassilo, thanks bigtime, I shall probably get back to work on it

Please take also some time to learn how to quote and post properly so
that your articles are not such a PITA. Posting guidelines are posted
here regularly just for this purpose...

soon. This is great advice. BTW, the /g modifier means global replace.

I have a *slight* (but mind you: only very slight!) feeling that
Tassilo already knows what /g does mean, but that he was asking *why*
you were doing a global replace!


Michele

 

[John W. Krahn]

I have a *slight* (but mind you: only very slight!) feeling that
Tassilo already knows what /g does mean, but that he was asking *why*
you were doing a global replace!

Actually the OP wasn't doing a global replace. He was using /g on the
match operator in a boolean context which makes no sense at all.


John

 

[Robin]

That was not what I meant. If you post a follow-up to a posting and
additionally send the follow-up as mail, state that in the mail with
something like

[ also posted to comp.lang.perl.misc ]

or

[ posted and mailed ]

or so.

Tassilo
--

will do.

 

[Juha Laiho]

Or alternatively, if a header/footer file doesn't exist, just generate
some default header and footer within the program, without ever creating
the files. So, try to read the relevant file, and provide default content
if errors occur.

Btw, the functionality of getheader/getfooter seems so similar that it's
waste to have separate functions for them. Just pass in relevant
parameters and use the returned value. So, combining with the above, you'd
have function "getpart" or something like that, and if that function
returns undef, you could print out a default header/footer/whatever.

The other way would be to require the files to be in place, and emit an
error message if they're not accessible.

Whichever way you choose, don't attempt to write the files from within
your script, and you'll save quite a lot of hassle from your code:
supposing that the users of your script use an editor to edit the
header/footer contents: editors don't lock the files anyway (or at least
you can't universally trust them to), so if you know your program only
reads the files, there's no point in locking them (because concurrent
read access doesn't need locking).

So, from your current design:

does it exist?
- yes, read (locking the file for access) and return (or possibly just print
out an error and exit)
- no;
- try to create with default contents (locking for access)
- read and return (locking for access)
- and for both cases, possibly print out an error and exit

you change to:
- read (without locking), returning undef if read failed

and in the calling code, depending on your design choice, either:
- if read failed, provide default content
or:
- if read failed, produce an error message

Although I might add code like
if (! gethead ($headerfile))
{
@head = ('<html>', '<body>, 'etc');
}
else
{
@head = gethead ($headerfile);
}

Ouch. First gethead just to determine whether or not the file exists,
and if it did succeed, do it again to actually store the read contents.
So, opening/locking/reading/unlocking/closing the file twice for each
request (if using your original gethead code)? In addition there would
of course be the possible race condition that the header file gets
removed between the two gethead calls; the first call to gethead telling
that the file is there, and thus default content is not needed, and the
second trying to read content from the file that no longer exists.

Also, what's the point of having the head variable as an array instead
of a scalar; anyway you're not editing it in your code, so you an just
slurp it in and spit it out. Using an array for that variable doesn't
make any sense.

 

[Robin]

Juha:

Ouch. First gethead just to determine whether or not the file exists,
and if it did succeed, do it again to actually store the read contents.
So, opening/locking/reading/unlocking/closing the file twice for each
request (if using your original gethead code)? In addition there would
of course be the possible race condition that the header file gets
removed between the two gethead calls; the first call to gethead telling
that the file is there, and thus default content is not needed, and the
second trying to read content from the file that no longer exists.

Also, what's the point of having the head variable as an array instead
of a scalar; anyway you're not editing it in your code, so you an just
slurp it in and spit it out. Using an array for that variable doesn't
make any sense.

And how would I fix this race condition?
and thanks for all the suggestoins.
-Robin

 

[Anno Siegel]

Actually the OP wasn't doing a global replace. He was using /g on the
match operator in a boolean context which makes no sense at all.

....except when you're looping over it. It definitely didn't make
sense the way the OP used it.

Anno

 

[Juha Laiho]

And how would I fix this race condition?

By only opening/reading the file once -- returning either content or
a failure status, instead of reading once for status and re-reading
if the status was ok.

Don't worry -- you're not the first one having done this; in Unix
operating systems there's an "access" library call that is to be
used for checking whether the current user has desired kind of access
to a specified file. The problem of using this library call anyuwhere
is exactly as with your code -- the information might be invalid at
the time it reaches your code. Similarly, the solution there is to not
make the "access" call at all, but to attempt to open the file with
the desired access mode, and use the failure code from the "open"
function. There, either the file open did succeed, or it did not -
no time is provided for someone to change the file between checking
and accessing it.

 

[Robin]

By only opening/reading the file once -- returning either content or
a failure status, instead of reading once for status and re-reading
if the status was ok.

Don't worry -- you're not the first one having done this; in Unix
operating systems there's an "access" library call that is to be
used for checking whether the current user has desired kind of access
to a specified file. The problem of using this library call anyuwhere
is exactly as with your code -- the information might be invalid at
the time it reaches your code. Similarly, the solution there is to not
make the "access" call at all, but to attempt to open the file with
the desired access mode, and use the failure code from the "open"
function. There, either the file open did succeed, or it did not -
no time is provided for someone to change the file between checking
and accessing it.

Thanks, my gethead and getfoot subs are going to be totally rewritten. So
Unix systems have a race condition with this libary call? Or did I
misunderstand you?
-Robin

 

[Malcolm Dew-Jones]

Robin ([email protected]) wrote:


: Unix systems have a race condition with this libary call? Or did I
: misunderstand you?

Any system may have race conditions with virtually any call if they are
used incorrectly.

If there could be a race condition in a particular situation then the
program should use some method to form a lock.

As for access, everyone who uses it knows that since they read the man
page before they made the call (right?).


access is useful for suid programs to test the original user's permissions
to access something. Simply open'ing a file will not do that since the
the suid program will likely not have a permission problem when it opens
the file. (And if that causes a race condition in the program then the
program should use some other method to form a lock.)


access is also useful for checking a user's permissions before starting
something like a batch job. E.g. if a user cannot write to a temporary
directory that will be needed in ten hours then it is stupid to find that
out ten hours from now. Sure, the directory permission may change during
the ten hours before the job runs, but checking first is still the smart
thing to do.