Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi monks, I could really do with some help! I have created a mysql database and am writing perl CGI/DBI script to query it from the web. My scripts to search the database work fine on their own, however, I want to add a 'log in' feature whereby only people with allowed access can search the database. I created a CGI script that contains username and password boxes which then submits these to the simple search page. The username/password are then used to log onto the database from the search page. This is where it goes wrong! The error message i get is: 
DBI->connect(host=myhost;database=my_db) failed: Access denied for use
+r: 'maisey@myhost' (Using password: NO) at frontpage.cgi line 25

[download]
To me this suggests that my script doesn't connect the database, however, it definately does because I added in a simple select statement to select all from a table and print it to screen - and it does this fine. However, actually submitting a value on the search form is when the error appears. I would very much appreciate it if someone could look over the code below and point out any obvious mistakes. Maisie ;-) 
# THE LOGIN PAGE ***********************
#***************************************

#!/biol/programs/perl/bin/perl -w


use strict;
use DBI;
use CGI qw(:standard);

print "Content-type:text/html\n\n";

my ($cgi);

$cgi = new CGI;
use CGI::Carp qw(fatalsToBrowser);

print "Content-type:text/html\n\n";
print <<EOF;
<HTML>
<HEAD><TITLE>Database</TITLE></HEAD>
<BODY BGCOLOR="white">

<h2>database</h2><BR>

<TABLE border=0 cellspacing=0 cellpadding=0>
<TR>
<TD><FONT COLOR="#CCCCFF"></FONT></TD>
</TR></FONT>
</TABLE>


<TABLE>
<FORM METHOD="post" ACTION="http://localhost/~maisie/cgi-bin/database/
+frontpage.cgi">

        <TR VALIGN="baseline"><TD VALIGN="baseline"><h3>Enter user nam
+e</h3></TD>
        <TD><INPUT TYPE="TEXT" NAME="username_box" SIZE="10"></TD></TR
+>

        <TR VALIGN="baseline"><TD VALIGN="baseline"><h3>Enter password
+</h3></TD>        <TD><INPUT TYPE="password" NAME="password_box" SIZE
+="10"></TD></TR>

        <TD><INPUT TYPE="SUBMIT" value="Log in"></TABLE>

        </FORM>



</BODY>
</HTML>
EOF

[download]
The next script connects to the database and searches it; 

#!/biol/programs/perl/bin/perl -w
use strict;
use DBI;
use CGI qw(:standard);

print "Content-type:text/html\n\n";

my $cgi;

$cgi = new CGI;
use CGI::Carp qw(fatalsToBrowser);

my $username = $cgi->param('username_box');
my $password = $cgi->param('password_box');


my $dbh;


$dbh = DBI->connect("DBI:mysql:host=localhost;database=db_name", "$use
+rname","$password", {PrintError =>0, RaiseError => 1}) || die "Databa
+se connection not made";


my $plate = $cgi->param("plate");


print $cgi->start_form (-method => "POST");
print $cgi->textfield (-name => "plate",
                                                -value => $plate,
                                                -size => 40);
print $cgi->submit (-name => "button", -value=>"search");
print $cgi->end_form ();


search_members ($plate) if $plate;

my $sth;
my $sth2;

my $sql = qq{select * from plate};

$sth = $dbh->prepare ($sql);
$sth->execute();

while (my $row = $sth->fetchrow_arrayref)     {


# this prints the values in the plate table so program is definately
# connecting to database.

     print join ("\t", @$row), "<P>";




 }


# finish the statement


#  $sth->finish();
#  $sth2->finish();

$dbh->disconnect();


print $cgi->end_html ();





sub search_members



my ($plate) = shift;
my ( $sth2, $count, $count2);

print "<table width=100% bgcolor=#ffff99><tr><td>Search results for ke
+yword:<b><i><font color=red> $plate</font></i></b> </td><tr></table>\
+n",
#               $cgi->escapeHTML ($plate);
                $cgi->escapeHTML;


      $sth2 = $dbh->prepare (qq{
                              SELECT * FROM plate WHERE plate_id LIKE 
+?
                                OR genomic_dna_id LIKE ?
                                OR sybr_green_id LIKE ?
                                OR rox_id LIKE ?
                                OR genomic_production_id LIKE ?
                                OR template_id LIKE ?
                                OR barcode_id LIKE  ?
                                OR expiry_date LIKE ?
                                OR incubation_time LIKE ?

                      });



          $sth2->execute("%" . $plate . "%","%" . $plate . "%","%" . $
+plate . "%","%" . $plate . "%","%" . $plate . "%","%" . $plate . "%",
+"%" . $plate . "%", "%" .  $plate . "%","%" . $plate . "%" );


        $count = 0;
        $count2 = 0;
        # fetchrow_hashref returns a reference to a hash containing co
+lumn values for the next row of the result set


        while (my $hash_ref = $sth->fetchrow_hashref ())
        {
                format_plate_entry ($hash_ref);
                ++$count;
        }

        if ($count > 1)     {

        #print $cgi->p ("$count entries found<P><HR>");
        print "<table width=400 bgcolor=#ffcc66><tr><td><b>$count</b> 
+entries found in table PLATE<P></td></tr></table><hr>";
      }


        elsif ($count == 1)   {

            print "<table width=400 bgcolor=#ffcc66><tr><td><b>$count<
+/b> entry found in table PLATE<P></td></tr></table><hr>";
      }


}


sub format_plate_entry
{
my ($entry_ref) = shift;
my ($address);

        # encode characters that are special in HTML
        foreach my $key (keys (%{$entry_ref}))
        {
                $entry_ref->{$key} = $cgi->escapeHTML ($entry_ref->{$k
+ey});
        }



  print "<P><table width=400 bgcolor=#ffff99><tr><td><STRONG>Table nam
+e: Plate</STRONG><BR></td></tr></table>\n";

        print "<table width=400 bgcolor=#ffffcc><tr><td><B>Plate_id:</
+b> $entry_ref->{plate_id}<br></td></tr></table>\n" if $entry_ref->{pl
+ate_id};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Sybr_green_
+id:</b> $entry_ref->{sybr_green_id}<br></td></tr></table>\n" if $entr
+y_ref->{sybr_green_id};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Rox_id:</b>
+ $entry_ref->{rox_id}<br></td></tr></table>\n" if $entry_ref->{rox_id
+};
        print "<table width=400 bgcolor=ffffcc><tr><td><b>Genomic_prod
+uction_id:</b> $entry_ref->{genomic_production_id}<br></td></tr></tab
+le>\n" if $entry_ref->{genomic_production_id};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Template_id
+:</b> $entry_ref->{template_id}<br></td></tr></table>\n" if $entry_re
+f->{template_id};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Genomic_dna
+_id:</b> $entry_ref->{genomic_dna_id}<br></td></tr></table>\n" if $en
+try_ref->{genomic_dna_id};

        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Expiry date
+:</b> $entry_ref->{expiry_date}<BR></td></tr></table>\n" if $entry_re
+f->{expiry_date};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Barcode_ID:
+ </b>$entry_ref->{barcode_id}<BR></td></tr></table>\n" if $entry_ref-
+>{barcode_id};
        print "<table width=400 bgcolor=#ffffcc><tr><td><b>Incubation 
+Time:</b> $entry_ref->{incubation_time}<BR></td></tr></table>\n" if $
+entry_ref->{incubation_time};
        print "<BR>\n";


}

[download]

Replies are listed 'Best First'.
Re: perl/CGI/DBI + odd behaviour
by dws (Chancellor) on Feb 19, 2003 at 18:32 UTC
    I'm a bit confused by your post. In the error message you provide, 
      DBI->connect(host=myhost;database=my_db) failed: Access denied for u
+ser: 'maisey@myhost' (Using password: NO) at frontpage.cgi line 25

    [download]
    the host and database don't correspond to the code you posted 
      DBI->connect("DBI:mysql:host=localhost;database=db_name", ...

    [download]
    This leads me to believe that the error might be coming from somewhere else.

    Suggestion: Strip this down to a small example that demonstrates the problem. You don't need to show us your table formatting code, just a snippet that exhibits this error message, but still permits a query to be executed without error. I'm betting you can do this in less than 20 lines. If you haven't spotted the problem yourself along the way, a small snippet increases the odds that someone here will spot the problem.

[reply]
[d/l]
[select]
      ok, here's a condensed version of the code. also the error message having a different host name to that in the script was just a typo. cheers, maisie x 
       

#THE LOGIN PAGE ***********************
  
   #!/biol/programs/perl/bin/perl -w


   use strict;
   use DBI;
   use CGI qw(:standard);
   my $cgi = new CGI;
   use CGI::Carp qw(fatalsToBrowser);

   print "Content-type:text/html\n\n";
   print <<EOF;
   <h2>database</h2><BR>
   <FORM METHOD="post" ACTION="http://myhost/~maisie/cgi-bin/database/
   +frontpage.cgi">
   <h3>Enter user name</h3>
   <INPUT TYPE="TEXT" NAME="username_box" SIZE="10">
   <h3>Enter password</h3><INPUT TYPE="password" NAME="password_box" S
+IZE
   +="10">   <INPUT TYPE="SUBMIT" value="Log in">
   </FORM> </BODY></HTML>
   EOF

      [download]
      The next script connects to the database and searches it; 
      
   #!/biol/programs/perl/bin/perl -w
   use strict;
   use DBI;
   use CGI qw(:standard);

   my $cgi = new CGI;
   my $username = $cgi->param('username_box');
   my $password = $cgi->param('password_box');
   my ($sth, $sth2);
   my $dbh = DBI->connect("DBI:mysql:host=myhost;database=my_db", "$us
+e
   +rname","$password", {PrintError =>0, RaiseError => 1}) || die "Dat
+aba
   +se connection not made";

   my $plate = $cgi->param("plate");

   print $cgi->start_form (-method => "POST");
   print $cgi->textfield (-name => "plate", -value => $plate,-size => 
+40);
   print $cgi->submit (-name => "button", -value=>"search");
   print $cgi->end_form ();

   
print "Search results for keyword: $plate \n",
$cgi->escapeHTML;

         $sth2 = $dbh->prepare (qq{
                                 SELECT * FROM plate WHERE plate_id LI
+KE 
   +? });

  $sth2->execute("%" . $plate . "%" );
   my $sql = qq{select * from plate};

   $sth = $dbh->prepare ($sql);
   $sth->execute();

   while (my $row = $sth->fetchrow_arrayref)     {
         print join ("\t", @$row), "<P>";
    }

   $dbh->disconnect();
   print $cgi->end_html ();

      [download]
[reply]
[d/l]
[select]
Re: perl/CGI/DBI + odd behaviour
by robartes (Priest) on Feb 19, 2003 at 18:43 UTC
    I got thrown off track by the same thing as dws initially, but I think the reason that the error messages differ is that the script never reaches the programmer's die, but it dies in DBI.pm because RaiseError is set. That said, try printing out $password in the second script to see that it actually contains what you expect it to contain.

    CU
    Robartes-

[reply]

Back to Seekers of Perl Wisdom