Free source guestbook - unfinished

Discussion in 'Perl Misc' started by Robin, Apr 20, 2004.

  1. Robin

    Robin Guest

    #!/usr/bin/perl -T

    use strict;
    use warnings;

    use CGI qw:)all);

    $CGI::pOST_MAX=1024 * 100; # max 100K posts
    $CGI::DISABLE_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 ]
     
    Robin, Apr 20, 2004
    #1
    1. Advertising

  2. "Robin" <robin @ infusedlight.net> wrote in
    news:c63mud$6fe$:

    > 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
    (reverse each component for email address)
     
    A. Sinan Unur, Apr 20, 2004
    #2
    1. Advertising

  3. Robin

    Tintin Guest

    "Robin" <robin @ infusedlight.net> wrote in messtage
    news:c63mud$6fe$...

    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.
     
    Tintin, Apr 20, 2004
    #3
  4. Robin

    Robin Guest

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

    --
    Regards,
    -Robin
    --
    [ webmaster @ infusedlight.net ]
     
    Robin, Apr 20, 2004
    #4
  5. Robin

    Joe Smith Guest

    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
     
    Joe Smith, Apr 21, 2004
    #5
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. John ©
    Replies:
    5
    Views:
    4,761
    Skeleton Man
    Jun 24, 2004
  2. Alf P. Steinbach
    Replies:
    7
    Views:
    360
    Ioannis Vranos
    Dec 22, 2004
  3. Vili
    Replies:
    2
    Views:
    303
  4. Robin

    free source guestbook (finished)

    Robin, Apr 22, 2004, in forum: Perl Misc
    Replies:
    19
    Views:
    2,488
    Malcolm Dew-Jones
    May 3, 2004
  5. Unfinished Loop

    , Oct 21, 2006, in forum: Javascript
    Replies:
    5
    Views:
    116
    Michael Winter
    Oct 22, 2006
Loading...

Share This Page