Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > Free source guestbook - unfinished

Reply
Thread Tools

Free source guestbook - unfinished

 
 
Robin
Guest
Posts: n/a
 
      04-20-2004
#!/usr/bin/perl -T

use strict;
use warnings;

use CGI qw(:all);

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




---------------------------------
--
Regards,
-Robin
--
[ webmaster @ infusedlight.net ]


 
Reply With Quote
 
 
 
 
A. Sinan Unur
Guest
Posts: n/a
 
      04-20-2004
"Robin" <robin @ infusedlight.net> wrote in
news:c63mud$6fe$(E-Mail Removed):

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


--
A. Sinan Unur
http://www.velocityreviews.com/forums/(E-Mail Removed) (reverse each component for email address)
 
Reply With Quote
 
 
 
 
Tintin
Guest
Posts: n/a
 
      04-20-2004

"Robin" <robin @ infusedlight.net> wrote in messtage
news:c63mud$6fe$(E-Mail Removed)...

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 qw(:all);


Good start


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


use Fnctl qw(:flock);

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.


 
Reply With Quote
 
Robin
Guest
Posts: n/a
 
      04-20-2004
yes, I admit it needs work. Thanks you two.
I'll post the revision when it's done.
Later.

--
Regards,
-Robin
--
[ webmaster @ infusedlight.net ]


 
Reply With Quote
 
Joe Smith
Guest
Posts: n/a
 
      04-21-2004
Robin wrote:

> 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
 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Lost unfinished e-mail Colin Palmer Computer Support 2 07-27-2007 06:17 AM
Loading an unfinished questionnaire from a database Vili ASP .Net 2 04-30-2007 11:59 AM
Unfinished Loop 2nervous@gmail.com Javascript 5 10-21-2006 11:35 PM
[Unfinished] "counter-based loops" tutorial available Alf P. Steinbach C++ 7 12-22-2004 11:24 PM
free source guestbook (finished) Robin Perl Misc 19 05-03-2004 04:23 PM



Advertisments