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'>&nbsp;</td>
   <td class='content'><input type="submit" name="style" value="Delete Selected 
Items"></td>
   <td class='content'>&nbsp;</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]

Reply via email to