3856l1.orig 100664 1061 330 4746 7030014172 11125 0 ustar mlr ljedit Listing 1: rank-category.pl, which allows users to add new categories
to the ranking database.
#!/usr/bin/perl -wT
# filename: rank-category.pl
use strict;
use diagnostics;
use CGI::Pretty qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use DBI;
# Create an instance of CGI
my $query = new CGI;
# Send a MIME header
print $query->header("text/html");
print $query->start_html(-title => "Add a new category");
# ------------------------------------------------------------
# If this program was invoked with POST, then retrieve
# the new category name and try to insert it.
if ($query->request_method eq "POST")
{
# Connect to the database
my $dbh = DBI->connect("DBI:mysql:test:localhost") ||
die qq{DBI error from connect: "$DBI::errstr"};
my $new_category_name = $query->param("new_category_name");
my $new_category_description =
$query->param("new_category_description");
# Check that there are printable characters
unless ($new_category_name =~ /\S/)
{
print h1("Error with new category"),
p("Category names must contain at least one printable character"),
p("Please try again.");
exit;
}
# Insert the new category
my $sql = "INSERT INTO RankCategories ";
$sql .= "(category_name, category_description) ";
$sql .= "VALUES (?,?) ";
my $sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
my $success =
$sth->execute($new_category_name, $new_category_description);
# Finish with the database
$sth->finish;
$dbh->disconnect;
# Print an appropriate message, depending on the INSERT's success
if ($success)
{
print p("Successfully added the new category ",
b($new_category_name), ".");
}
else
{
print p("Error adding the category ",
b($new_category_name), ". Perhaps it already exists",
"or contained illegal characters?");
exit;
}
}
# ------------------------------------------------------------
# Allow users to add a new category
print h1("Add a new ranking category");
print startform(-method => "POST",
-action => $query->self_url);
print p("New category:",
textfield(-name => 'new_category_name',
-size => 25,
-override => 1,
-maxlength => 25));
print p("Description: ",
textfield(-name => 'new_category_description',
-size => 80,
-override => 1,
-maxlength => 100));
print submit(-value=>'Add category');
print endform;
print p("Now go ",
a({-href=>'/cgi-bin/rank-something.pl'}, "rank something"),
"!");
print $query->end_html;
3856l2.orig 100664 1061 330 17377 7030014232 11147 0 ustar mlr ljedit Listing 2: rank-something.pl, which allows users to rank an item. If
the item does not exist in RankItems, the user can add a new item from
the same form.
#!/usr/bin/perl -wT
# rank-something.pl, from Linux Journal
# Written by Reuven M. Lerner (reuven@lerner.co.il)
# Released under the GNU General Public License, available from
# http://www.gnu.org/copyleft/gpl.html
use strict;
use diagnostics;
use CGI::Pretty qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use DBI;
# Create a new instance of CGI
my $query = new CGI;
# Send a MIME header and HTML title to the user's browser
print $query->header("text/html");
print $query->start_html(-title => "Rank something!");
# Get the category and item IDs, if set
my $category_id = $query->param("category_id") || 0;
my $existing_item_id = $query->param("existing_item_id");
# Connect to the database
my $dbh = DBI->connect("DBI:mysql:test:localhost") ||
die qq{DBI error from connect: "$DBI::errstr"};
# Declare some variables that we will use a lot
my $sql;
my $sth;
my $result;
my $success;
my @items = ();
# ------------------------------------------------------------
# If the program was invoked with POST, insert a new ranking
if ($query->request_method eq "POST")
{
my $item_id;
# If $existing_item_id was set, then the user chose to
# use an existing item, rather than insert a new one
if ($existing_item_id)
{
$item_id = $existing_item_id;
}
# Insert the new item and get its ID, if the user so chooses
else
{
my $item_name = $query->param("new_item_name") || "";
my $item_category =
$query->param("new_category_id") || "";
my $item_description =
$query->param("new_item_description") || "";
# Make sure that the item has a name, description, and
# category ID
unless ($item_name and $item_description and $item_category)
{
print $query->start_html(-title => "Missing item name");
print p("In order to rank a new item, it must have a name,",
"description, and category. Please try again.");
print p("Alternatively, you can rank an existing item.");
exit;
}
# Insert this new item into RankItems
$sql = "INSERT INTO RankItems ";
$sql .= "(category_id, item_name, item_description) ";
$sql .= "VALUES (?,?,?) ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$success =
$sth->execute($item_category, $item_name, $item_description);
# Check for errors
unless ($success)
{
print h1("Error inserting new item");
print p("There was an error inserting the item: $DBI::errstr");
print p("Perhaps this item already exists in the database?");
exit;
}
$sth->finish;
# Get the inserted item ID
$item_id = $dbh->{"mysql_insertid"};
}
# ------------------------------------------------------------
# Since the item is definitely in RankItems, we can rank it
# Check for a name and e-mail address
my $ranker_name = $query->param("ranker_name") || "";
my $email = $query->param("email") || "";
unless ($ranker_name and $email)
{
print $query->start_html(-title => "Missing information");
print p("You must include your name and e-mail address ",
"in order for your ranking to be accepted. ",
"Please enter this information and try again.");
exit;
}
# Remove HTML from the comments, and separate
# paragraphs with and
my $comments = $query->param("comments");
$comments =~ s|<.*?>||g;
$comments =~ s|[\r\n]{2,}|
\n\n|g;
my $rank = $query->param("rank");
$sql = "INSERT INTO Rankings ";
$sql .= "(item_id, ranker_name, email, comments, rank) ";
$sql .= "VALUES (?,?,?,?,?) ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$success =
$sth->execute($item_id, $ranker_name, $email, $comments, $rank);
unless ($success)
{
print h1("Error inserting ranking");
print p("There was an error inserting the ranking: $DBI::errstr");
print p("Perhaps you have ranked this item in the past?");
exit;
}
$sth->finish;
# Indicate that the ranking was successful
print p("Your ranking was successfully entered.");
}
# ------------------------------------------------------------
# Get all of the items, choosing a specific category if the user
# selected one
$sql = "SELECT item_id, item_name ";
$sql .= "FROM RankItems ";
$sql .= "WHERE category_id = $category_id" if $category_id;
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my %items = ();
while (my $row = $sth->fetchrow_arrayref)
{
# Get the elements that we retrieved
my ($id, $name) = @$row;
# Put information about this item in a hash
$items{$id} = $name;
}
$sth->finish;
# ------------------------------------------------------------
# Get all of the categories, for future entries
$sql = "SELECT category_id, category_name ";
$sql .= "FROM RankCategories ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my %categories = ();
while (my $row = $sth->fetchrow_arrayref)
{
# Get the elements that we retrieved
my ($id, $name) = @$row;
# Put information about this item in a hash
$categories{$id} = $name;
}
$sth->finish;
# ------------------------------------------------------------
# Now produce some output for the user, in an HTML
# form that can be used
print h1("Rank something!"),
startform(-method => "POST",
-action => $query->url);
print p("Add a new category",
a({-href=>'/cgi-bin/rank-category.pl'}, "here"),
".");
print p("View existing rankings",
a({-href=>'/cgi-bin/view-ranking.pl'}, "here"),
".");
print table({-border => 1, -cellpadding => 15},
Tr({-valign => 1},
td([
# Table cell for existing items
p(b("Choose an existing item...")) .
popup_menu(-name => "existing_item_id",
-values => [0, (sort {
$items{$a} cmp $items{$b}} keys %items)],
-labels => {0 => "Choose one",
map {($_, $items{$_})} %items},
-default => $existing_item_id,
-override => 1),
# Table cell for new items
p(b("... or add a new one to the database:")) .
"Name:" .
textfield(-name => 'new_item_name',
-size => 25,
-override => 1,
-maxlength => 25) .
" Category:" .
popup_menu(-name => 'new_category_id',
-values => [0, sort {$categories{$a} cmp $categories{$b}}
keys %categories],
-default => 0,
-override => 1,
-labels => {0 => "Choose one", %categories}) .
p("Detailed description: ") .
p(textarea(-name => "new_item_description",
-rows => 10,
-columns => 50,
-override => 1,
-default => "Use this space to provide contact and
pricing information, among other things."))])));
# Allow the user to rank the item
print hr, h3("Now rank the item:");
print p("Your name:",
textfield(-name => 'ranker_name',
-size => 25,
-override => 1,
-maxlength => 30),
"Your e-mail address:",
textfield(-name => 'email',
-size => 25,
-override => 1,
-maxlength => 40));
print p("Ranking:",
popup_menu(-name => 'rank',
-values => [0 ..10],
-default => 5,
-override => 1,
-labels => {0 => "0 (worst)",
5 => "5 (average)",
10 => "10 (best)"}));
print p("Detailed comments: "),
p(textarea(-name => "comments",
-rows => 10,
-columns => 50,
-override => 1,
-default => "Why did you like or dislike this item?
Would you recommend it to your friends?"));
# Produce a "submit" button
print submit(-value => 'Rank this item');
print endform;
# End the HTML, and disconnect from the database
print $query->end_html;
$dbh->disconnect;
3856l3.orig 100664 1061 330 16422 7030014266 11145 0 ustar mlr ljedit Listing 3: view-ranking.pl, which allows users to examine the rankings
for a given item.
#!/usr/bin/perl -wT
# view-ranking.pl, from Linux Journal
# Written by Reuven M. Lerner (reuven@lerner.co.il)
# Released under the GNU General Public License, available from
# http://www.gnu.org/copyleft/gpl.html
use strict;
use diagnostics;
use CGI::Pretty qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use DBI;
# Declare some variables that we will use a lot
my $sql;
my $sth;
my $result;
my $success;
my @items = ();
# Where is "rank-something.pl"?
my $rank_something = "/cgi-bin/rank-something.pl";
# Create a new instance of CGI
my $query = new CGI;
# Send a MIME header to the user
print $query->header("text/html");
# Connect to the database
my $dbh = DBI->connect("DBI:mysql:test:localhost") ||
die qq{DBI error from connect: "$DBI::errstr"};
# ------------------------------------------------------------
# Get all of the categories, for future entries
$sql = "SELECT category_id, category_name ";
$sql .= "FROM RankCategories ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my %categories = ();
while (my $row = $sth->fetchrow_arrayref)
{
# Get the elements that we retrieved
my ($id, $name) = @$row;
# Put information about this item in a hash
$categories{$id} = $name;
}
$sth->finish;
# ------------------------------------------------------------
# If invoked with GET, print a form allowing users to choose a category
if ($query->request_method eq "GET")
{
print $query->start_html(-title => "Choose a category");
print h1("Choose a category");
print startform(-method => "POST",
-action => $query->url);
print p("Select a category to view:",
popup_menu(-name => 'category_id',
-values => [sort {$categories{$a} cmp $categories{$b}}
keys %categories],
-override => 1,
-labels => \%categories));
print submit(-value => 'View items in this category');
print endform;
$dbh->disconnect;
exit;
}
# ------------------------------------------------------------
# If invoked with POST, there are two possibilities: Either we need to
# produce a listing of items in the category, we need to produce a
# report on a particular item.
elsif ($query->request_method eq "POST")
{
# ------------------------------------------------------------
# If item_id is submitted, then the user wants to see a full
# report for a particular item
my $item_id = $query->param("item_id") || 0;
if ($item_id)
{
# Get (and print) basic information about this item
$sql = "SELECT C.category_name, I.item_name, ";
$sql .= " I.item_description, AVG(R.rank)";
$sql .= "FROM RankItems I, RankCategories C, ";
$sql .= " Rankings R ";
$sql .= "WHERE I.category_id = C.category_id ";
$sql .= "AND I.item_id = $item_id ";
$sql .= "AND I.item_id = R.item_id ";
$sql .= "GROUP BY I.item_id = R.item_id ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my $returned_row = $sth->fetchrow_arrayref;
$sth->finish;
# If we get something back, then get all of the rankings
# for this item after printing item information
if ($returned_row)
{
my ($category_name, $item_name, $item_description, $rank)
= @$returned_row;
print $query->start_html(-title => $item_name);
print h1($item_name);
print p("Category: $category_name");
print p(i($item_description));
print p(b("Average rank"), ":$rank");
print p(a({href =>
"$rank_something?existing_item_id=$item_id"},
"You can rank this item, too!"));
print hr, p(i("The following are in chronological order:"));
# Now retrieve all of the rankings
$sql = "SELECT ranker_name, email, comments, rank ";
$sql .= "FROM Rankings ";
$sql .= "WHERE item_id = $item_id ";
$sql .= "ORDER BY entry_datetime ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
print "\n";
# Iterate through (and print) each comment
while (my $row_ref = $sth->fetchrow_arrayref)
{
my ($name, $email, $comments, $rank) =
@$row_ref;
print p(dt(a({href => "mailto:$email"},
$name), "*" x $rank, " ($rank)"),
dd($comments));
}
print "
\n";
$sth->finish;
$dbh->disconnect;
exit;
}
else
{
print $query->start_html(-title => "No ranks for this item");
print p("No one has yet ranked this item.",
a({href =>
"$rank_something?existing_item_id=$item_id"},
"You can be the first!"));
$sth->finish;
$dbh->disconnect;
exit;
}
my %categories = ();
while (my $row = $sth->fetchrow_arrayref)
{
# Get the elements that we retrieved
my ($id, $name) = @$row;
# Put information about this item in a hash
$categories{$id} = $name;
}
}
# ------------------------------------------------------------
# Otherwise, allow the user to choose an item from this category
else
{
my $category_id = $query->param("category_id") || 0;
unless ($category_id)
{
print $query->start_html(-title => "Error: Missing information");
print h1("Error: Missing information");
print h1("Error: No item ID or category ID");
print p("POST without either item_id or category_id.");
$dbh->disconnect;
exit;
}
# Get a description of this category
$sql = "SELECT category_name, category_description ";
$sql .= "FROM RankCategories ";
$sql .= "WHERE category_id = $category_id ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my ($category_name, $category_description) =
$sth->fetchrow_array;
print $query->start_html(-title => "Choose an item");
print h1("Choose an item");
print p("Category:", b($category_name));
print p($category_description);
# List items in the selected category
$sql = "SELECT I.item_id, I.item_name ";
$sql .= "FROM RankItems I, Rankings R ";
$sql .= "WHERE category_id = $category_id ";
$sql .= "ORDER BY I.item_id ";
$sth = $dbh->prepare($sql)
|| die "Cannot prepare: $DBI::errstr";
$result = $sth->execute
|| die "Cannot execute: $DBI::errstr";
my %items = ();
while (my $row = $sth->fetchrow_arrayref)
{
# Get the elements that we retrieved
my ($id, $name, $count, $average) = @$row;
# Put information about this item in a hash
$items{$id} = $name;
}
if ($sth->rows == 0)
{
print p(i("No items have been entered into this category."));
}
else
{
print p(i("The following are in alphabetical order:"));
print startform(-method => "POST",
-action => $query->url);
print popup_menu(-name => "item_id",
-values => [(sort {$items{$a} cmp $items{$b}}
keys %items)],
-labels => {%items},
-override => 1);
print submit(-value => 'View this item');
print endform;
}
$sth->finish;
}
}
# Take care of odd, unknown request methods
else
{
print h1("Error: Unknown request method");
print p("This program must be invoked with GET or POST.");
}
$dbh->disconnect;
exit;