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]