mod_perl2 newbie DBI question

Return-Path: Delivered-To: apmail-perl-modperl-archive@www.apache.org Received: (qmail 70932 invoked from network); 12 Jun 2008 18:11:47 -0000 Received: from hermes.apache.org (HELO mail.apache.org) (140.211.11.2) by minotaur.apache.org with SMTP; 12 Jun 2008 18:11:47 -0000 Received: (qmail 42105 invoked by uid 500); 12 Jun 2008 18:11:42 -0000 Delivered-To: apmail-perl-modperl-archive@perl.apache.org Received: (qmail 42090 invoked by uid 500); 12 Jun 2008 18:11:42 -0000 Mailing-List: contact modperl-help@perl.apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: List-Post: List-Id: Delivered-To: mailing list modperl@perl.apache.org Received: (qmail 42079 invoked by uid 99); 12 Jun 2008 18:11:42 -0000 Received: from athena.apache.org (HELO athena.apache.org) (140.211.11.136) by apache.org (qpsmtpd/0.29) with ESMTP; Thu, 12 Jun 2008 11:11:42 -0700 X-ASF-Spam-Status: No, hits=-2.0 required=10.0 tests=HTML_MESSAGE,RCVD_IN_DNSWL_MED,SPF_PASS X-Spam-Check-By: apache.org Received-SPF: pass (athena.apache.org: local policy) Received: from [205.194.19.87] (HELO scmze003.ssan.egs-seg.gc.ca) (205.194.19.87) by apache.org (qpsmtpd/0.29) with ESMTP; Thu, 12 Jun 2008 18:10:52 +0000 X-SBRS: 3.6 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AnoBAPsCUUjGZ6cUiGdsb2JhbACBW2YyjyoBAQEPIJw3 X-IronPort-AV: E=Sophos;i="4.27,632,1204502400"; d="scan'208,217";a="418660206" Received: from humpty.pwgsc.gc.ca (HELO mh-ncr-010.ad.pwgsc-tpsgc.gc.ca) ([198.103.167.20]) by scmze000.ssan.egs-seg.gc.ca with ESMTP; 12 Jun 2008 18:09:10 +0000 Received: from mb-ncr-028.ad.pwgsc-tpsgc.gc.ca ([10.20.19.169]) by mh-ncr-010.ad.pwgsc-tpsgc.gc.ca with Microsoft SMTPSVC(6.0.3790.3959); Thu, 12 Jun 2008 14:09:01 -0400 X-MIMEOLE: Produced By Microsoft Exchange V6.5 Content-class: urn:content-classes:message MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="----_=_NextPart_001_01C8CCB7.63C07F87" Subject: mod_perl2 newbie DBI question Date: Thu, 12 Jun 2008 14:09:00 -0400 Message-ID: <1C37FBE46418C54F86B1B0157246EFB203170B45@mb-ncr-028.ad.pwgsc-tpsgc.gc.ca> X-MS-Has-Attach: X-MS-TNEF-Correlator: Thread-Topic: mod_perl2 newbie DBI question Thread-index: AcjMt2GN4gn0eX1XQuuHw/uXQ5UGJQ== From: "Brian Gaber" To: X-OriginalArrivalTime: 12 Jun 2008 18:09:01.0837 (UTC) FILETIME=[649113D0:01C8CCB7] X-Virus-Checked: Checked by ClamAV on apache.org This is a multi-part message in MIME format. ------_=_NextPart_001_01C8CCB7.63C07F87 Content-Type: text/plain; charset="US-ASCII" Content-Transfer-Encoding: quoted-printable 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/ SetHandler perl-script PerlResponseHandler ModPerl::Registry PerlOptions +ParseHeaders Options +ExecCGI Order allow,deny Allow from all PerlModule ModPerl::PerlRun Alias /perl-run/ /usr/local/apache2/perl-run/ SetHandler perl-script PerlResponseHandler ModPerl::PerlRun PerlOptions +ParseHeaders +GlobalRequest Options +ExecCGI Order allow,deny Allow from all 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 =3D param('region'); my $JSCRIPT=3D< "text/html" ); print start_html( -title =3D> "Title", = -style=3D>{-code=3D>$LOCAL_STYLE}, -onLoad=3D>"changeTitle()", -script=3D>$JSCRIPT ), br({ -clear =3D> 'all' }), "\n"; # Connect to the database. my $dbh =3D DBI->connect("DBI:mysql:database=3Desnap;host=3Dlocalhost", "athena", "godess", {'RaiseError' =3D> 1}); # Determine MySQL locks table name my $sth =3D $dbh->prepare("SELECT * FROM region_props WHERE region =3D '$region'"); $sth->execute(); my $ref =3D $sth->fetchrow_hashref(); $sth->finish(); my $locks_table =3D $ref->{locks_table}; my @form_vars =3D 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 =3D 0; my @clmnNames =3D (); my @rows =3D (); my $sth =3D $dbh->prepare("SELECT * FROM $locks_table"); $sth->execute(); while (my $ref =3D $sth->fetchrow_hashref()) { push(@rows, td({-class=3D>'centre'},checkbox(-name=3D>"ckbx_$i", -value=3D>"$ref->{id}", -label=3D>'')). td({-class=3D>'centre'},$ref->{id}). td({-class=3D>'centre'},$ref->{rcd_opener}). td({-class=3D>'centre'},$ref->{lock_date}) ); $i++; } $sth->finish(); # Specified values for table column heading names $clmnNames[0] =3D "Select"; $clmnNames[1] =3D "Id"; $clmnNames[2] =3D "User Id"; $clmnNames[3] =3D "Date"; print start_form(), font({-face=3D>"Trebuchet MS, Arial", -size=3D>2},br(), center(strong("Delete Record Locks"),br(),br(), table({-class=3D>'bdr', -width=3D>'100%', -BgColor=3D>"white", -border=3D>'0'}, Tr([th(\@clmnNames)]),"\n", Tr([@rows])),"\n", button(-class=3D>"btn", -value=3D>"Delete selected record locks", -onClick=3D>"validate(this.form)"), )); print hidden(-name=3D>'region', -value=3D>param('region')),"\n"; print end_form(); } sub rm_lock() { foreach ( param() ) { if ($_ =3D~ /^ckbx_\d+$/) { my $id2del =3D param($_); # Delete row from $locks_table $dbh->do("DELETE FROM $locks_table WHERE id=3D'$id2del'"); my $errno =3D $dbh->{mysql_errno}; my $errTxt =3D $dbh->{mysql_error}; if ( $errno > 0 ) { print center(font({-face=3D>"Trebuchet MS, Arial", = -size=3D>2, -color=3D>"red"}),b("Error deleting row from $locks_table, ",font({-color=3D>"black"},"MySQL Error Code: $errno - $errTxt"))),"\n",p(); } } } } ------_=_NextPart_001_01C8CCB7.63C07F87 Content-Type: text/html; charset="US-ASCII" Content-Transfer-Encoding: quoted-printable mod_perl2 newbie DBI question

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 =3D param('region');

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

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

my = $LOCAL_STYLE=3D<<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 =3D> = "text/html" );
print start_html( -title =3D> = "Title", -style=3D>{-code=3D>$LOCAL_STYLE}, = -onLoad=3D>"changeTitle()", -script=3D>$JSCRIPT = ),
br({ = -clear =3D> 'all' }),
= "\n";

# Connect to the database.
my $dbh =3D = DBI->connect("DBI:mysql:database=3Desnap;host=3Dlocalhost",<= /FONT>
&nbs= p; = "athena", "godess",
&nbs= p; = {'RaiseError' =3D> 1});

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

my @form_vars =3D param();

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

print_form(); &nb= sp; # Display the MySQL table

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

print end_html();

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

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

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

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

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

sub rm_lock() {

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

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

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

         }
      = }
   }
}

------_=_NextPart_001_01C8CCB7.63C07F87--