perl-modperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Brian Gaber" <Brian.Ga...@PWGSC.GC.CA>
Subject mod_perl2 newbie DBI question
Date Thu, 12 Jun 2008 18:09:00 GMT
I have a MySQL database application that is used and managed by cgi-bin
scripts (CGI.pm).  In development the performance was fine, but a
productin trial showed the performance to be unacceptable.  I am
attempting to fix the performance by using mod_perl2 which I have never
used.  I have successfully compiled and install mod_perl2 and have added
these entries into httpd.conf:

PerlModule Apache::DBI

PerlModule ModPerl::Registry
Alias /perl/ /usr/local/apache2/perl/
<Location /perl/>
    SetHandler perl-script
    PerlResponseHandler ModPerl::Registry
    PerlOptions +ParseHeaders
    Options +ExecCGI
    Order allow,deny
    Allow from all
</Location>

PerlModule ModPerl::PerlRun
Alias /perl-run/ /usr/local/apache2/perl-run/
<Location /perl-run/>
    SetHandler perl-script
    PerlResponseHandler ModPerl::PerlRun
    PerlOptions +ParseHeaders +GlobalRequest
    Options +ExecCGI
    Order allow,deny
    Allow from all
</Location>

	I have modified scripts to work in mod_perl2, but they don't
work reliably.  Sometimes they work and then they stop working and then
I have to stop and start Apache to get it working again.  I am hoping if
I supply one of my scripts someone can advise me what needs to be done
to make in work fast and reliably and then I can use this as an example
to fix my other scripts.  Here is the one script:

#!/usr/bin/perl -w

#use CGI qw/:standard :html3 :netscape/;
use CGI '-autoload';
use DBI();
use warnings;
use strict;

my $region = param('region');

my $JSCRIPT=<<JSEND;
   function changeTitle()
   {
      parent.document.title=document.title;
   }

   function validate(theForm)
   {
      theForm.submit();
   }
JSEND

my $LOCAL_STYLE=<<CSSEND;

   body {
      font-family:Verdana;
      font-size:12px;
   }

   .btn {
      font-family:Verdana;
      font-size:9px;
      color:black;
      border:1px solid #000000;
      margin-top:5px;
      background-color:white
   }

   table {
      font-family:Verdana;
      border:1px solid #000000;
      background-color:white
   }

   th {
      font-family:Verdana;
      font-size:12px;
      color:black;
   }

   td.right {
      font-family:Verdana;
      font-size:12px;
      color:black;
      text-align:right;
   }

   td {
      font-family:Verdana;
      font-size:12px;
      color:black;
      text-align:center;
   }

CSSEND

print header( -type => "text/html" );
print start_html( -title => "Title", -style=>{-code=>$LOCAL_STYLE},
-onLoad=>"changeTitle()", -script=>$JSCRIPT ),
      br({ -clear => 'all' }),
      "\n";

# Connect to the database.
my $dbh = DBI->connect("DBI:mysql:database=esnap;host=localhost",
                      "athena", "godess",
                      {'RaiseError' => 1});

# Determine MySQL locks table name
my $sth = $dbh->prepare("SELECT * FROM region_props WHERE region =
'$region'");
$sth->execute();
my $ref = $sth->fetchrow_hashref();
$sth->finish();
my $locks_table = $ref->{locks_table};

my @form_vars = param();

if ( @form_vars > 1 ) { # if required parameters were passed
   rm_lock();
}

print_form();           # Display the MySQL table

# Disconnect from the database.
$dbh->disconnect();

print end_html();

sub print_form {
   my $i = 0;
   my @clmnNames = ();
   my @rows = ();

   my $sth = $dbh->prepare("SELECT * FROM $locks_table");
   $sth->execute();

   while (my $ref = $sth->fetchrow_hashref()) {
      push(@rows, td({-class=>'centre'},checkbox(-name=>"ckbx_$i",
-value=>"$ref->{id}", -label=>'')).
                  td({-class=>'centre'},$ref->{id}).
                  td({-class=>'centre'},$ref->{rcd_opener}).
                  td({-class=>'centre'},$ref->{lock_date})
      );
      $i++;
   }
   $sth->finish();

   # Specified values for table column heading names
   $clmnNames[0] = "Select";
   $clmnNames[1] = "Id";
   $clmnNames[2] = "User Id";
   $clmnNames[3] = "Date";

   print start_form(),
      font({-face=>"Trebuchet MS, Arial", -size=>2},br(),
      center(strong("Delete Record Locks"),br(),br(),
      table({-class=>'bdr', -width=>'100%', -BgColor=>"white",
-border=>'0'},
      Tr([th(\@clmnNames)]),"\n",
      Tr([@rows])),"\n",
      button(-class=>"btn", -value=>"Delete selected record locks",
-onClick=>"validate(this.form)"),
      ));
      print hidden(-name=>'region', -value=>param('region')),"\n";
   print end_form();
}

sub rm_lock() {

   foreach ( param() ) {
      if ($_ =~ /^ckbx_\d+$/) {
         my $id2del = param($_);

         # Delete row from $locks_table
         $dbh->do("DELETE FROM $locks_table WHERE id='$id2del'");

         my $errno = $dbh->{mysql_errno};
         my $errTxt = $dbh->{mysql_error};
         if ( $errno > 0 ) {
            print center(font({-face=>"Trebuchet MS, Arial", -size=>2,
-color=>"red"}),b("Error deleting row from $locks_table,
",font({-color=>"black"},"MySQL Error Code: $errno -
$errTxt"))),"\n",p();
         }
      }
   }
}

Mime
View raw message