http://www.perlmonks.org?node_id=68502
Category: CGI Programming
Author/Contact Info Hero Zzyzzx
Description:

This script, zen.pl, allows you to create,edit, list and show random quotes. I originally wrote this to display a random buddhist koan (very entertaining short instructive stories) on my site(s), hence all the references to "koan."

This is partially a meditative exercise, I wanted to try "subroutining" everything so that it made sense to me, and using CGI.pm to generate all output. This is probably the first thing I've written that I'm proud of.

Zen.pl has a moderate amount of security for "administrator" type functions, and should be speedy because of it's use of mySQL. My idea is to enter several hundred (or as many as I can find) koans, which screamed "RDBMS!" to me.

I believe this should work OK with mod_perl, though that isn't tested yet.

  • Limitations / Errata:
  • Doesn't use HTML::Parser to strip tags. Sorry, I haven't figured out how to use this mod yet.
  • Assumes your cgi-bin directory is cgi-bin. Edit if you need to.
  • Wants all quotes to be sequential in the mySQL database.
  • The security is good (I think) but not perfect. See the notes in the code.

Please let me know what you think and if you get any use out of this.

#!/usr/bin/perl -wT
use DBI;
use CGI ":standard";
use CGI::Carp "fatalsToBrowser";
use Digest::MD5 qw(md5_hex);
use strict;



#####
# The structure of the mySQL koan table follows.
#
#    CREATE TABLE zen (
#      id int(11) NOT NULL auto_increment,
#      koan text,
#     PRIMARY KEY (id)
#    ) TYPE=MyISAM;



#####
# The structure of the users table is
#
#    CREATE TABLE zenusers (
#      username char(12) NOT NULL default '',
#      passwd char(20) NOT NULL default '',
#      PRIMARY KEY (username)
#    ) TYPE=MyISAM;
#
# To create a user, make sure to use mySQLs password() function.
# To create a user from the mySQL client:
#     insert into zenusers values("username",password("your_pass"));



#####
# My idea around this is to include it as an SSI on a page.
# Embed the SSI in a paragraph, and use CSS to control the look
# of the text, with "<p class="cssclass">" for instance.
#
# This script isn't incredibly secure, it could be made more so
# by using a random encrypted cookie and storing that in a table 
# to use for future authentication.
# However, enough is enough.  You can set the seed for the md5 digest
# to whatever you want.
# 
# I know I should probably use HTML::Parser to strip tags but for 
# the life of me I couldn't figure it out. Maybe down the road. . .



##### Connect
    my $dbh;
    $dbh = DBI->connect( "dbi:mysql:yourdb","username","password") 
        or die("Can't connect: ", $dbh->errstr);
##### End connect.

    my $q = new CGI;

##### Flow control. 
if ($q->param("koan")){# if "koan" is defined, do this loop.

    my $date=mydate();

# if cookie is set, and correct, allow access to other functions    
if ($q->cookie("valid") eq md5_hex($date)){ 

        if ($q->param("koan") eq 'addkoan'){
            addkoan();

        } elsif ($q->param("koan") eq 'createkoan'){
            createkoan();

        } elsif ($q->param("koan") eq 'listkoan'){
            listkoan();
    
        } elsif ($q->param("koan") eq 'editkoan'){
            editkoan();

        } elsif ($q->param("koan") eq 'controlkoan'){
            controlkoan();
        
        } else { 
            #if "koan" isn't in the above list, show a koan.
            showkoan();
        }
        
} else {
    login();
}
    
    } else {
        # if "koan" and cookie isn't defined, do this loop.
        showkoan();
}




##### Creates form to manage koans
sub controlkoan { 
print
    $q->header(),
    $q->start_html("-title"=>"Control Panel for Koans"),
    $q->h2("Control Panel for Koans"),
    $q->br,
    $q->a({-href =>"/cgi-bin/zen.pl?koan=createkoan"},"Add a koan"),
    $q->br,
    $q->a({-href =>"/cgi-bin/zen.pl?koan=listkoan"},"List all koans"),
    $q->br,
    $q->a({-href =>"/cgi-bin/zen.pl?koan=editkoan"},"Edit koans"),
    $q->end_html();
}




##### Lists all koans in order by id.
sub listkoan {
    my $tth=$dbh->prepare("select koan from zen order by id") 
        or dienice("Can't connect: ",$dbh->errstr);
    $tth->execute;
    print $q->header();
    while (my $koan = $tth->fetchrow_array){
        print $koan,
            $q->hr();
        }
}


##### Login and Authenication
sub login{
if ($q->param("username")){ 
     # if username is defined, check again zenusers table.
     my $passwd=$q->param("passwd");
     my $username=$q->param("username");
     my $sth=$dbh->prepare("select username from zenusers where (passw
+d=password(\"$passwd\")". 
        "and username=\"$username\")") or die("can't execute query ",$
+dbh->errmsg);
     $sth->execute;
     my $usertest= $sth->fetchrow_array;
     if ($usertest){ 
          # if it matches a username,  set the cookie goto controlkoan
+()
          my $date=mydate();
          my $value= md5_hex($date);
          my $cookie = $q->cookie(-name=>"valid",
          -value=>"$value");
          print "Set-Cookie: $cookie\n";
          print $q->redirect("/cgi-bin/zen.pl?koan=controlkoan");
          } else {
          # if it doesn't match, cryptically redirect and showkoan().
          print $q->redirect("/cgi-bin/zen.pl");
          }
     } else {
     # if username isn't defined, allow the user to attempt login.
print
    $q->header(),
    $q->start_html("-title"=>"Control Panel for Koans"),
    $q->h2("Login to control koans"),
    $q->start_form(-method =>"post", -action =>"/cgi-bin/zen.pl"),
    $q->hidden(-name=>"koan",-default=>"login",-override=>"true"),
    $q->br,
    $q->b("Username:"),
    $q->textfield(-name=>"username"),
    $q->br,
    $q->b("Password:"),
    $q->password_field(-name=>"passwd"),
    $q->br,
    $q->submit("Login"),
    $q->end_form(),
    $q->end_html();
    }
}



##### Lists all koans, allowing for editing. Changes "<br>" back to \n
+.
sub editkoan {
    my $tth=$dbh->prepare("select id,koan from zen order by id") 
        or dienice("Can't connect: ",$dbh->errstr);
    $tth->execute;
        
    print 
        $q->header(),
          $q->start_html("-title"=>"Add Koan"),
           $q->h2("Update Koans"),
           $q->h3("Blank lines will be retained, all HTML tags will be
+ removed.");
            
    while (my ($id,$koan) = $tth->fetchrow_array){
        $koan =~ s/<br>/\n/g;
        
        print $q->br,
            $q->start_form(-method =>"post", -action =>"/cgi-bin/zen.p
+l"),
            $q->textarea(-name=>"koantext",-default=>"$koan",
                "wrap=\"virtual\" cols=\"70\" rows=\"15\""),
            $q->hidden(-name=>"koan",-default=>"addkoan",-override=>"t
+rue"),
            $q->hidden(-name=>"id",-default=>"$id",-override=>"true"),
            $q->br,
            $q->submit("Update This Koan"),
            $q->reset(),
            $q->end_form();
    }
    print $q->end_html();
}



##### adds or updates a koan depending on where the request comes from
+.
sub addkoan { 
    my $koan = $q->param("koantext");
    $koan =~ s/<([^>])*>//g;
    $koan =~ s/\n/<br>/g;
    my $id=$q->param("id");
    if ($q->param("id")){
        my $rth=$dbh->prepare("update zen set koan=(?) where id=$id ")
+ or die();
        $rth->execute($koan);
        } else {
        my $rth=$dbh->prepare("insert into zen (koan) values (?)") or 
+die();
        $rth->execute($koan);
        }
print
    $q->header(),
    $q->start_html("-title"=>"Koan Added/Updated"),
    $q->h3("Koan Added/Updated"),
    $q->end_html();
    
}



##### Creates form to add a koan.
sub createkoan {
print     
    $q->header(),
    $q->start_html("-title"=>"Add Koan"),
    $q->h2("Enter Koan"),
    $q->h3("Blank lines will be retained, HTML tags will be removed.")
+,
    $q->br,
    $q->start_form(-method =>"post", -action =>"/cgi-bin/zen.pl"),
    $q->textarea(-name=>"koantext",
    "wrap=\"virtual\" cols=\"70\"rows=\"15\""),
    $q->hidden(-name=>"koan",-default=>"addkoan",-override=>"true"),
    $q->br,
    $q->submit("Add Koan"),
    $q->reset(),
    $q->end_form(),
    $q->end_html();
}



##### This selects and displays a random koan.
sub showkoan { 
    srand(time() ^ ($$ + ($$ << 15)) );
    my (@ids,$rth,$id,$tth,$koan,$selid);
    $rth=$dbh->prepare("select max(id) from zen order by id") 
        or die("Can't connect: ", $dbh->errstr);
    $rth->execute;
    $id=$rth->fetchrow_array;
    $selid=int(rand($id)+1);
    $tth=$dbh->prepare("select koan from zen where id=$selid") 
        or die("Can't connect: ",$dbh->errstr);
    $tth->execute;
    $koan = $tth->fetchrow_array;
print
    $q->header(),
    $koan;
        
}


##### This creates the date for the md5 digest
sub mydate{
    my ($sec,$min,$hr,$mday,$yr,$yday,$isdist,$fixmo,$mon,$timestr2);
    ($sec,$min,$hr,$mday,$mon,$yr,$yday,$isdist)= localtime(time);
    $fixmo = $mon + 1;
    $timestr2= sprintf("%04d-%02d-%02d",($yr+1900),$fixmo,"01");
    return $timestr2;
    }
Replies are listed 'Best First'.
Re: mySQL-driven Random Quote generator
by Masem (Monsignor) on Mar 31, 2001 at 01:31 UTC
    In "showkoan"...
    $rth=$dbh->prepare("select max(id) from zen order by id") or die("Can't connect: ", $dbh->errstr); $rth->execute; $id=$rth->fetchrow_array; $selid=int(rand($id)+1); $tth=$dbh->prepare("select koan from zen where id=$selid") or die("Can't connect: ",$dbh->errstr); $tth->execute; $koan = $tth->fetchrow_array;
    This is the part of the code that I was interested in. I do believe that you can make this much simplier (and faster) with one SQL call:
    $tth=$dbh->prepare("select koan from zen order by rand() limit 1") + or die("Can't connect: ",$dbh->errstr); $tth->execute; $koan = $tth->fetchrow_array;
    ("order by rand()" is mentioned in chapter 7 of the mysql doc, and I used this trick for a random quote generator of my own.)
    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain

      That "order by rand()" trick is great, thanks for the heads up! However it only works in 3.23.xx according to my New Riders mySQL book.

      Duly noted, and thanks for the tip, Doc! I'll probably revisit this script sometime soon and make edits once I've gotten more feedback.

Re: mySQL-driven Random Quote generator
by Anonymous Monk on Oct 30, 2008 at 02:29 UTC
    Hero Zzyzzx,

    HTML::Parser is an annoyingly complex event-driven parser, but it is quite powerful. If you want to strip tags from $html, try something like this:
    use HTML::Parser; our $parser=new HTML::Parser ( # Call &event_handler on all plaintext, pass plaintext as argument + 0 (decodes entities) 'text_h' => [\&event_handler,'dtext'] ); our $text_buffer=''; $parser->parse($html); sub event_handler { $text_buffer.=$_[0]; }
    chomp; #nom nom nom