Hi,
Is there a good web site where I can get tips of potential modPerl
problems, particularly relating to CGI?
Also, I'm getting a modPerl problem with my script:
I keep finding that $param{form}{type} has the wrong value in it.
Any help would be greatly appreciated.
Bye
Elwyn
#!/usr/bin/perl
use strict;
use CGI;
use DBI;
use lib '.';
my $HOST = 'localhost';
my $DATABASE = 'shopping';
my $DEBUG = 1;
my $MAINTAINER_EMAIL = '[EMAIL PROTECTED]';
my @EQUIPMENT_LIST =
('cpu','memory','modem','storage_disk','mainboard','graphics_card','monitor','IDE_controller','firewire','hard_disk','CD_ROM','DVD_ROM','CD_writer','keyboard','mouse','networking','case','zip','floppy_drive','sound_card','speakers','printer','scanner');
my @PARAM_TO_EXTRACT = ("id", "type", "brand", "description", "price");
my $cgi;
$cgi = new CGI;
my $Sdb = DBI->connect("DBI:mysql:database=$DATABASE;host=$HOST", 'root', 'password')
|| &error("Database couldn't connect: $DBI::errstr", {});
my %p = ();
#-------------------------------------------------------------------------------
&main();
exit 1;
#-------------------------------------------------------------------------------
sub main {
my %param;
%param = &get_param();
my $body;
$body = "";
$body .= $cgi->header;
$body .= $cgi->start_html(-title=>"Equipment Editor",
-style=>{-src=>"../style/stylesheet.css"});
print "Type: " . $param{form}{type} ."<br />";
if ($cgi->param('style') eq 'add_save') {
$body .=&save_add_item(\%param);
} elsif ($cgi->param('style') eq 'add_item') {
$body .= &add_item(\%param);
} elsif ($cgi->param('style') eq 'show_items') {
$body .= "<!--- Device Type: $param{form}{type} --->\n";
$body .= &show_items(\%param);
} elsif ($cgi->param('style') eq 'Edit Selected Items') {
$body .= &edit_items(\%param);
} elsif ($cgi->param('style') eq 'Delete Selected Items') {
$body .= &delete_items(\%param);
} elsif ($cgi->param('style') eq 'Return to Menu') {
$body .= &show_menu(\%param);
} else {
$body .= &show_menu(\%param);
}
$body .= $cgi->end_html;
print $body;
}
#-------------------------------------------------------------------------------
sub get_param {
my %param;
%param = undef;
my $to_ex;
foreach $to_ex (@PARAM_TO_EXTRACT) {
$param{form}{$to_ex} = "";
}
foreach $to_ex (@PARAM_TO_EXTRACT) {
$param{form}{$to_ex} = $cgi->param("$to_ex");
}
print "<h1>Here it is: " .$param{form}{type} ."</h1>";
return %param;
}
#-------------------------------------------------------------------------------
# Print an 'I'm sorry' message, mail an error report to the maintainer
# and quit (using exit, not die; die was making mod_perl lock up
# sometimes, I don't know why.) Pass it the message and a ref to the
# parameters hash
sub error {
my ( $message, $p ) = @_;
my $body = <<EOHTML;
EOHTML
if ($DEBUG) {
$body .= "<p class='content'>[$message]</p>\n";
} elsif ($message =~ /Too many connections/) {
$body .= "<p class='content'>There are currently too many connections to the
database, please try again later.</p>\n";
}
$p{title_sem} = '';
# write_output($body, $p);
if( !$DEBUG && open(SENDMAIL, "| /usr/lib/sendmail -t -n -oi") ) {
print SENDMAIL <<EOMAIL;
From: nobody\@it.uts.edu.au
To: $MAINTAINER_EMAIL
Subject: [www-trouble] $ENV{SCRIPT_NAME}
#The mod_perl script $ENV{SCRIPT_NAME} had a fatal error.
<< $message >>
Its environment was:
EOMAIL
foreach ( sort keys %ENV ) {
print SENDMAIL "$_: $ENV{$_}\n";
}
close SENDMAIL;
}
warn($message);
&display_html($body, \%p);
exit;
}
#-------------------------------------------------------------------------------
# Wrapper function for simple DBI queries (ie ones without
# placeholders). Returns a results handle.
#
sub db_query {
my $sql = shift;
#print "SQL: $sql<hr />";
my $sth = $Sdb->prepare($sql) || &error($Sdb->errstr . " [$sql]", {});
$sth->execute || &error($Sdb->errstr . " [$sql]", {});
$sth;
}
#-------------------------------------------------------------------------------
sub display_html {
my ($body, $temp) = @_;
my %p = %{$temp};
print "<h1>An error occurred</h1>$body";
}
#-------------------------------------------------------------------------------
sub some_upcase {
my $str = shift;
my @bits = split(/_/, $str);
my $output = "";
foreach my $bit (@bits) {
$bit =~ /^(.)(.+)$/;
$output .= uc($1) . $2;
}
return $output;
}
#-------------------------------------------------------------------------------
sub adjust_decimal_price {
my $price = shift;
$price = sprintf("%.2f", $price) if ($price != int($price));
return $price;
}
#-------------------------------------------------------------------------------
sub add_item {
my $tmp = shift;
my %param = %{$tmp};
my $body = "";
$body .= $cgi->start_form(-method=>"get", -action=>$ENV{SCRIPT_NAME});
my %labels = map{ $_ => some_upcase($_) } @EQUIPMENT_LIST;
my $type_popup_menu = $cgi->popup_menu(-name=>"type", -values=>\@EQUIPMENT_LIST,
-labels=>\%labels);
$body .=<<EO_HTML;
<input type="hidden" name="style" value="add_save">
<table>
<tr bgcolor="#eeeeee">
<th>Equipment Type:</th>
<td class='content'>$param{errors}{type} $type_popup_menu</td>
</tr>
<tr>
<th>Brand:</th>
<td class='content'>$param{errors}{brand}<input type="text" name="brand"
maxlength="40" size="20" value="$param{form}{brand}">
</tr>
<tr bgcolor="#eeeeee">
<th>Description:</th>
<td class='content'>$param{errors}{description} <input type="text"
name="description" maxlength="40" size="20" value="$param{form}{description}">
</tr>
<tr bgcolor="#ffffff">
<th>Price:</th>
<td class='content'>$param{errors}{price} <input type="text" name="price"
maxlength="40" size="20" value="$param{form}{price}">
</tr>
<tr bgcolor="#eeeeee">
<td class='content' colspan="2" align="center">
<input type="submit" name="submit" value="Submit">
<input type="reset" value="Reset">
</td>
</table>
EO_HTML
$body .= $cgi->end_form;
}
#-------------------------------------------------------------------------------
sub save_add_item {
my $tmp = shift;
my %param = %{$tmp};
%param = &check_add_item_type(\%param);
%param = &check_add_item_price(\%param);
unless (defined($param{errors})){
&db_query("insert into shopping.equipment (type, brand, description, price)
values ('$param{form}{type}', '$param{form}{brand}', '$param{form}{description}',
$param{form}{price} )");
return "<h1>Items added successfully</h1>";
} else {
return &add_item(\%param);
}
}
#-------------------------------------------------------------------------------
sub check_add_item_id {
my $tmp = shift;
my %param = %{$tmp};
unless ($param{form}{id} =~ /^(\d+)$/) {
$param{errors}{id} = "<p class='content'><font color='red'>The ID must be all
digits.</font></p>";
}
return %param;
}
#-------------------------------------------------------------------------------
sub check_add_item_type {
my $tmp = shift;
my %param = %{$tmp};
unless (grep (/^$param{form}{type}$/, @EQUIPMENT_LIST)) {
$param{errors}{type} = "<p class='content'><font color='red'>".
&some_upcase($param{form}{type}) . " is not in the acceptable equipment
list.</font></p>";
}
return %param;
}
#-------------------------------------------------------------------------------
sub check_add_item_price {
my $tmp = shift;
my %param = %{$tmp};
if ($param{form}{price} =~ /^\$?(\d+)(\.\d{2})?$/) {
$param{form}{price} = $1. $2;
} else {
$param{errors}{price} = "<p class='content'><font
color='red'>'$param{form}{price}' is not an acceptable value.</font></p>";
}
return %param;
}
#-------------------------------------------------------------------------------
sub show_menu {
my $body = "<h1>Select the sort of items you wish to view, edit or delete</h1>";
$body .= $cgi->start_form(-method=>"get", -action=>$ENV{SCRIPT_NAME});
my %labels = map{ $_ => some_upcase($_) } @EQUIPMENT_LIST;
my $type_popup_menu = $cgi->popup_menu(-name=>"type", -values=>\@EQUIPMENT_LIST,
-labels=>\%labels);
$body .=<<EO_HTML;
<table border="0" cellpadding="4" cellspacing="0">
<tr>
<td class='content'>$type_popup_menu</td>
<td class='content'><input type="submit" name="style" value="show_items"></td>
<td class='content'><strong>OR</strong></td>
<td class='content'><input type="submit" name="style" value="add_item"></td>
</tr>
</table>
EO_HTML
$body .= $cgi->end_form();
}
#-------------------------------------------------------------------------------
sub show_items {
my $tmp;
$tmp = shift;
my %param;
%param = %{$tmp};
my $sth = &db_query("select id, brand, description, type, price from
shopping.equipment where type='$param{form}{type}' order by type");
my $temp_type = &some_upcase($param{form}{type});
if ($temp_type eq "Cpu") {
$temp_type = "CPUs";
} elsif ($temp_type eq "Memory") {
$temp_type = "Memory Chips";
} elsif ($temp_type eq "Mouse") {
$temp_type = "Mice";
} else {
$temp_type .= "s";
}
my $body = "<h1>List of ".$temp_type ." available</h1>";
$body .= $cgi->start_form(-method=>"get", -action=>$ENV{SCRIPT_NAME});
$body.=<<EO_HTML;
<table border="0" cellspacing="4" cellpadding="0">
<tr bgcolor="#eeeeee">
<th>Brand<th>
<th>Description</th>
<th>Price</th>
<th>Edit/Delete</th>
</tr>
EO_HTML
my $line = 0;
while (my($id, $brand, $desc, $type, $price) = $sth->fetchrow) {
my $bgcolor = ($line++ % 2) ? "#eeeeee" : "#ffffff";
$type = &some_upcase($type);
$price = "\$" . &adjust_decimal_price($price);
$body.=<<EO_HTML;
<tr bgcolor="$bgcolor">
<td class='content'>$brand</td>
<td class='content'>$desc</td>
<td class='content'>$type</td>
<td class='content'>$price</td>
<td class='content'><input type="checkbox" name="change_id" value="$id"></td>
</tr>
EO_HTML
}
my $bgcolor = ($line++ % 2) ? "#eeeeee" : "#ffffff";
$body.=<<EO_HTML;
<tr bgcolor="$bgcolor">
<td class='content'><input type="submit" name="style" value="Edit Selected
Items"></td>
<td class='content'> </td>
<td class='content'><input type="submit" name="style" value="Delete Selected
Items"></td>
<td class='content'> </td>
<td class='content'><input type="submit" name="style" value="Return to Menu"></td>
</tr>
EO_HTML
$body .= $cgi->end_form();
return $body;
}
#-------------------------------------------------------------------------------
sub delete_items {
my $tmp = shift;
my %param = %{$tmp};
my $body = "";
my @items = $cgi->param('change_id');
return "<p><font color='red'>You must select at least one item to
delete.</font></p>" if (@items == 0);
my $query = "delete from shopping.equipment where (" . join(" or ", map("id=$_",
@items)) . ")";
&db_query($query);
$body .= "The items were successfully deleted.";
return $body;
}
#-------------------------------------------------------------------------------
sub edit_items {
my $tmp = shift;
my %param = %{$tmp};
if ($cgi->param('section') eq "Save Changes") {
return &edit_items_save(\%param);
} else {
return &edit_items_form(\%param);
}
}
#-------------------------------------------------------------------------------
sub edit_items_form {
my $tmp = shift;
my %param = %{$tmp};
my $body = "<h1>Editing Selected Items</h1>";
my @items = $cgi->param('change_id');
return "<p><font color='red'>You must select at least one item to edit.</font></p>"
if (@items == 0);
my $query = "select id, brand, description, type, price from shopping.equipment
where (" . join(" or ", map("id=$_", @items)) . ")";
my $sth = &db_query($query);
$body .= $cgi->start_form(-method=>"get", -action=>$ENV{SCRIPT_NAME});
$body .=<<EO_HTML;
<table>
<tr bgcolor="#eeeeee">
<th>Type</th>
<th>Brand</th>
<th>Description</th>
<th>Price</th>
</tr>
EO_HTML
my $count = 0;
while (my ($id, $brand, $description, $type, $price) = $sth->fetchrow()) {
my $bgcolor = ($count++ % 2) ? "#eeeeee" : "#ffffff";
$body.=<<EO_HTML;
<tr bgcolor="$bgcolor">
<td class='content'>
<input type="hidden" name="change_id" value="$id">
<input type="hidden" name="type_$id" value="$type">
$type
</td>
<td class='content'><input type="text" maxlength="10" name="brand_$id"
value="$brand">
<td class='content'><input type="text" maxlength="40" name="description_$id"
value="$description">
<td class='content'><input type="text" maxlength="10" name="price_$id"
value="$price">
</tr>
EO_HTML
}
my $bgcolor = ($count++ % 2) ? "#eeeeee" : "#ffffff";
$body.=<<EO_HTML;
<tr bgcolor="$bgcolor">
<td class='content' colspan="4" align="center">
<input type="hidden" name="style" value="Edit Selected Items">
<input type="submit" name="section" value="Save Changes">
<input type="reset" value="Reset">
</td>
</tr>
</table>
EO_HTML
return $body;
}
#-------------------------------------------------------------------------------
sub edit_items_save {
my $tmp = shift;
my %param = %{$tmp};
my $body = "Saving Changes To Items Information";
my @items = $cgi->param('change_id');
foreach my $id (@items) {
my $type = $cgi->param('type_' .$id);
my $brand = $cgi->param('brand_' .$id);
my $desc = $cgi->param('description_' .$id);
my $price = $cgi->param('price_'.$id);
&db_query("update shopping.equipment set shopping.equipment.brand='$brand',
shopping.equipment.description='$desc', shopping.equipment.price='$price' where
id=$id");
}
$body .=" <p class='content'>Changes made successfully. You may click back twice
then refresh to see the refreshed list.</p>";
return $body;
}
#-------------------------------------------------------------------------------
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
