Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

passing to query 3

Status
Not open for further replies.

JohnLucania

Programmer
Oct 10, 2005
96
0
0
US
I have a form:

<form name="SearchSeq" method="post" action="SearchSeqResult.cgi">
<p><b>GENE NAME:</b>
<select name="GENE_NAME">
<option>BRC2_HUMAN</option>
bla.....
</select>
</p>
<p><b>ORGANISM NAME:</b>
<select name="ORGANISM_NAME">
<option>ARCHAEA</option>
bla.....
</select>
</p>
<p><b>EXPRESSION LEVEL:</b>
<select name="EXPRESSION_LEVEL">
<option>1</option>
bla.....
</select>
</p>
<p><b>TISSUE NAME:</b>
<select name="TISSUE_NAME">
<option>Class A</option>
bla.....
</select>
</p>
<input type="submit" name="Submit" value="Submit">
</form>

How do you pass the values from the dropdowns to the result.cgi?

#! /usr/bin/perl

use warnings;
use strict;

use CGI ( ':standard' );

my $title = 'Sequence Search';
my $seq = param( 'Seq' );

print header,
start_html( $title ),
h1( $title ),<<"PrintTag",end_html;

use DBI;

my $dbh = DBI->connect( "DBI:mysql:host=localhost;database=seqdb","seqdb" , "************",
{ PrintError => 0 , RaiseError => 1 } );

my $st = "SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSION_LEVEL";
$st .= " FROM GENE, ORGANISM, MRNA";
$st .= " WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.MRNA_ORGANISM AND
GENE.GENE_NAME =???? AND ORGANISM.ORGANISM_NAME = ????
AND MRNA.MRNA_EXPRESSION_LEVEL =???? ";

my $sth = $dbh->prepare( $st );
$sth->execute();

while( my @row = $sth->fetchrow_array() ) {
print "Gene: '$row[0]', Organism: '$row[1]', Expression Level: '$row[2]'\n";
}

PrintTag
 
Hi

Not sure, but I think you need the [tt]value[/tt] attribute :
Code:
<option [red]value="brc2_human_s_code_to_be_transmitted_with_form_data"[/red]>BRC2_HUMAN</option>

Feherke.
 
the value= attribute in the <option> tag is not mandatory. If there is no value= attribute the content of the <option> tag will be used. What he wants is to use the value of the select tag name to populate his queries:

my $gene_name = param('GENE_NAME');
etc
etc
etc
 
Why is this error shwoing up?

String found where operator expected at line 65, near "$obj->p ( {-class=>'"
(Might be a runaway multi-line '' string starting on line 63)
(Missing semicolon on previous line?)
syntax error at line 65, near "$obj->p ( {-class=>'"
Bad name after box' at line 65.


#!/usr/local/bin/perl

use CGI;
use DBI;
use strict;

my $obj = new CGI;

my $test = 0;

my $GENE_NAME = '';
my $ORGANISM_NAME = '';
my $EXPRESSION_LEVEL = '';
my $TISSUE_NAME = '';


# form stuff

my $name = 'search';
my $method = 'post';
my $action = 'SearchSeqResult.cgi';
my $title = 'Sequence Search';
my $result = ' Results';

if ( lc $ENV{'REQUEST_METHOD'} eq 'post' )
{
$test = 1;

# put some form validation here

$GENE_NAME = $obj->param ( 'GENE_NAME' );
$ORGANISM_NAME = $obj->param ( 'ORGANISM_NAME' );
$EXPRESSION_LEVEL = $obj->param ( 'EXPRESSION_LEVEL' );
$TISSUE_NAME = $obj->param ( 'TISSUE_NAME' );
}


print $obj->header ( 'text/html' ),

$obj->start_html ( $title ),

# header / title

$obj->h1 ( {-class=>'header'}, $title ),

# start the form...

$obj->start_form ( -name=>$name, -method=>$method, -action=>$action ),

# select boxes enclosed in <p>

$obj->p ( {-class=>'box'},
$obj->b ( 'GENE NAME: ' ),
$obj->popup_menu ( -name=>'GENE_NAME', -class=>'sbox',
-values => ['BRC2_HUMAN','BRC2_HUMAN', 'KAP0_RAT','KAPB_MOUSE','P2X1_HUMAN','P2Y4_HUMAN',
'TPMT_HUMAN', 'UNCULTURED CRENARCHAEOTE'], -default=>$GENE_NAME )),
$obj->p ( {-class=>'box'},
$obj->b ( 'ORGANISM NAME: ' ),
$obj->popup_menu ( -name=>'ORGANISM_NAME', -class=>'sbox', -values => ['ARCHAEA','BACTERIA','EUKARYOTA','OTHER'],
-default=>$ORGANISM_NAME )),
$obj->p ( {-class=>'box'},
$obj->b ( 'EXPRESSION LEVEL: ' ),
$obj->popup_menu( -name=>'EXPRESSION_LEVEL', -class=>'sbox', -values => ['1','2', '3', '4', 5'],
-default=>$EXPRESSION_LEVEL)),
$obj->p ( {-class=>'box'},
$obj->b ( 'TISSUE NAME: ' ),
$obj->popup_menu ( -name=>'TISSUE_NAME', -class=>'sbox',
-values => ['Class A','Class B', 'Class C', 'Class D', 'Class E', 'Class H'],
-default=>$TISSUE_NAME )),

# submit button

$obj->submit ( -name=>'submit', -value=>'Search!' ),

# end the form

$obj->endform (),

$obj->div ( {-class=>'ecell'}, '&nbsp;' ),
$obj->div ( {-class=>'ecell'}, '&nbsp;' );

if ( $test == 1 )
{
my $dc = DBI->connect ( "DBI:mysql:host=localhost;database=seqdb", "seqdb", "********",
{ PrintError => 0 , RaiseError => 1 } );

my $qs = 'SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSION_LEVEL';
$qs .= ' FROM GENE, ORGANISM, MRNA';
$qs .= ' WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.MRNA_ORGANISM AND';
$qs .= ' GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'
AND MRNA.MRNA_EXPRESSION_LEVEL = $EXPRESSION_LEVEL ';

my $qe = $dc->prepare ( $qs );
$qe->execute;

if ( $qe->rows > 0 )
{
while ( my $cr = $qe->fetchrow_hashref () )
{
print $obj->div ( {-class=>'result'}, "Gene: " . $cr->{'GENE_NAME'} . ",
Organism: " . $cr->{'ORGANISM_NAME'}. ",
Expression Level: " . $cr->{'MRNA_EXPRESSION_LEVEL'} . "\n" );
}
}

$qe->finish;
$dc->disconnect ();
}

print $obj->end_html;

exit ( 0 );
PrintTag
 
hmmm... this is just simple debugging John, look for syntax errors first:

-values => ['1','2', '3', '4', 5'],

note there is no ' before 5 in the above line.

Then you have single quoted strings with single quotes in them:

$qs .= ' GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'

since the single quotes are used to delimit the strings you have to escape the ones inside the beginning and end quote other wise the line gets broken and throws off the rest of the script:

$qs .= ' GENE.GENE_NAME =\'$GENE_NAME\' AND ORGANISM.ORGANISM_NAME = \'$ORGANISM_NAME\'

but you can't use variable interpolation inside of single quoted strings, so $GENE_NAME will be treated literally like it's written, not as if it were a variable, you have to use double-quoted strings for that, and easier to use the qq operator to avoid escaping double-quotes inside double-quoted strings (even though here you have no embedded double-quotes):

Code:
     $qs   .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'
           AND MRNA.MRNA_EXPRESSION_LEVEL = $EXPRESSION_LEVEL ~;

and what's this at the end of the script:

PrintTag
 
That is great. I got the part working..

#!/usr/local/bin/perl

use CGI;
use strict;
use DBI;

my $q=new CGI;
my $obj = new CGI;
my $GENE_NAME=$q->param('GENE_NAME') || 'unknown';
my $ORGANISM_NAME=$q->param('ORGANISM_NAME') || 'unknown';
my $EXPRESSION_LEVEL=$q->param('EXPRESSION_LEVEL') || 'unknown';
my $TISSUE_NAME=$q->param('TISSUE_NAME') || 'unknown';

my $dc = DBI->connect ( "DBI:mysql:host=localhost;database=seqdb", "seqdb", "*******",
{ PrintError => 0 , RaiseError => 1 } );
my $qs = 'SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSION_LEVEL, TISSUE.TISSUE_NAME ';
$qs .= ' FROM GENE, ORGANISM, MRNA, TISSUE';
$qs .= ' WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.MRNA_ORGANISM AND';
$qs .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'
AND MRNA.MRNA_EXPRESSION_LEVEL = '$EXPRESSION_LEVEL' AND TISSUE.TISSUE_NAME = $TISSUE_NAME ~;
my $qe = $dc->prepare ( $qs );
$qe->execute;

if ( $qe->rows > 0 )
{
while ( my $cr = $qe->fetchrow_hashref () )
{
print $obj->div ( {-class=>'result'}, "Gene: " . $cr->{'GENE_NAME'} . ",
Organism: " . $cr->{'ORGANISM_NAME'}. ",
Expression Level: " . $cr->{'MRNA_EXPRESSION_LEVEL'}",
Tissue Name: " . $cr->{'TISSUE_NAME'} . )" \n";
}
}
$qe->finish;
$dc->disconnect ();

Is this a correct way of bringing up the display page?

Why am I getting this error?

./SearchSeqResult.cgi > /dev/null
String found where operator expected at ./SearchSeqResult.cgi line 31, near "Tissue Name: ""
(Might be a runaway multi-line "" string starting on line 30)
(Missing semicolon on previous line?)
String found where operator expected at ./SearchSeqResult.cgi line 31, near ")" \n""
(Missing operator before " \n"?)
syntax error at ./SearchSeqResult.cgi line 31, near "Tissue Name: ""
syntax error at ./SearchSeqResult.cgi line 33, near "}"

Thanks,

jl
 
look at this block of code:

Code:
print $obj->div ( {-class=>'result'}, "Gene: " . $cr->{'GENE_NAME'} . ",
Organism: " . $cr->{'ORGANISM_NAME'}. ",
Expression Level: " . $cr->{'MRNA_EXPRESSION_LEVEL'}",
Tissue Name: " . $cr->{'TISSUE_NAME'} . )" \n";

pay close attention to the double-quotes in the block, see any problems? Maybe this is what you want to do (but I'm not sure):

Code:
print $obj->div (
   {-class=>'result'}, 
      qq~ Gene: $cr->{'GENE_NAME'},
          Organism: $cr->{'ORGANISM_NAME'},
          Expression Level: $cr->{'MRNA_EXPRESSION_LEVEL'},
          Tissue Name: $cr->{'TISSUE_NAME'}~
   ),
   "\n";
 
./SearchSeqResult.cgi > /dev/null returns no error, but when I run the cgi pages, I get:

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Why is that?

Thanks,

jl
 
KevinADC,
yes, that part works well.
Thanks a bunch!!

jl

 
CGI scripts should always print a header even if the page is going to be blank.
 
Thank for the tip.

This give no errors, but no result (blank page) shows up on the result cgi page.
Why is that?

#!/usr/local/bin/perl

use CGI;
use strict;
use DBI;

my $q=new CGI;
my $obj = new CGI;
my $name = 'Search mRNA';
my $method = 'post';
my $action = 'SearchSeqResult.cgi';
my $title = 'Search mRNA';

print $obj->header ( 'text/html' );
$obj->start_html ( $title );
$obj->h1 ( {-class=>'header'}, $title );

my $GENE_NAME=$q->param('GENE_NAME');
my $ORGANISM_NAME=$q->param('ORGANISM_NAME');
my $EXPRESSION_LEVEL=$q->param('EXPRESSION_LEVEL');
my $TISSUE_NAME=$q->param('TISSUE_NAME');

my $dc = DBI->connect ( "DBI:mysql:host=localhost;database=seqdb", "seqdb", "**********",
{ PrintError => 0 , RaiseError => 1 } );
my $qs = 'SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSION_LEVEL, TISSUE.TISSUE_NAME ';
$qs .= ' FROM GENE, ORGANISM, MRNA, TISSUE';
$qs .= ' WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.MRNA_ORGANISM AND TISSUE.TISSUE_ID = MRNA.MRNA_TISSUE AND ';
$qs .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'
AND MRNA.MRNA_EXPRESSION_LEVEL = '$EXPRESSION_LEVEL' AND TISSUE.TISSUE_NAME = '$TISSUE_NAME' ~;
my $qe = $dc->prepare ( $qs );
$qe->execute;

if ( $qe->rows > 0 )
{
while ( my $cr = $qe->fetchrow_hashref () )
{
print $obj->div (
{-class=>'result'},
qq~ Gene: $cr->{'GENE_NAME'},
Organism: $cr->{'ORGANISM_NAME'},
Expression Level: $cr->{'MRNA_EXPRESSION_LEVEL'},
Tissue Name: $cr->{'TISSUE_NAME'}~
),
"\n";
}
}
$qe->finish;
$dc->disconnect ();


print $obj->end_html;
exit ( 0 );
 
I removed these extra:

my $method = 'post';
my $action = 'SearchSeqResult.cgi';
 
Why is that?
Maybe the parameters you're entering don't match anything in the database, or your query isn't coming out as it should? For debugging purposes at least, I'd do this:
Code:
     if ( $qe->rows > 0 )
     {
          while ( my $cr = $qe->fetchrow_hashref () )
          {
                print $obj->div (
                        {-class=>'result'},
                        qq~ Gene: $cr->{'GENE_NAME'},
                        Organism: $cr->{'ORGANISM_NAME'},
                        Expression Level: $cr->{'MRNA_EXPRESSION_LEVEL'},
                        Tissue Name: $cr->{'TISSUE_NAME'}~
                        ),
                "\n";
          }
     }[red] else {
        print "No results found for $qs\n";
     }[/red]
Obviously you could tidy up (or remove) the "no results found" message when you go live.

-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd
 
bla...

$qe->finish;
$dc->disconnect ();

// I am trying to populate the form right below the result display so that you can run the query right on the page w/o going back to the previous page.

// ./SearchSeqResult.cgi >/dev/null retruns no error, but no form shows up on the result page.

Am I missing something?


#form start

my $method = 'post';
my $action = 'SearchSeqResult.cgi';
my $result = 'Results';
my $test = 0;

if ( lc $ENV{'REQUEST_METHOD'} eq 'post' )
{
$test = 1;

$GENE_NAME = $obj->param ( 'GENE_NAME' );
$ORGANISM_NAME = $obj->param ( 'ORGANISM_NAME' );
$EXPRESSION_LEVEL = $obj->param ( 'EXPRESSION_LEVEL' );
$TISSUE_NAME = $obj->param ( 'TISSUE_NAME' );
}


$obj->start_form ( -name=>$name, -method=>$method, -action=>$action ),

$obj->p ( {-class=>'box'},
$obj->b ( 'GENE NAME: ' ),
$obj->popup_menu ( -name=>'GENE_NAME', -class=>'sbox',
-values => ['BRC2_HUMAN','BRC2_HUMAN', 'KAP0_RAT','KAPB_MOUSE','
P2X1_HUMAN','P2Y4_HUMAN',
'TPMT_HUMAN', 'UNCULTURED CRENARCHAEOTE'], -default=>$GENE_NAME)
),
$obj->p ( {-class=>'box'},
$obj->b ( 'ORGANISM NAME: ' ),
$obj->popup_menu ( -name=>'ORGANISM_NAME', -class=>'sbox', -values =>[
'ARCHAEA','BACTERIA','EUKARYOTA','OTHER'],
-default=>$ORGANISM_NAME )),
$obj->p ( {-class=>'box'},
$obj->b ( 'EXPRESSION LEVEL: ' ),
$obj->popup_menu( -name=>'EXPRESSION_LEVEL', -class=>'sbox', -values =
> [1..5],
-default=>$EXPRESSION_LEVEL)),
$obj->p ( {-class=>'box'},
$obj->b ( 'TISSUE NAME: ' ),
$obj->popup_menu ( -name=>'TISSUE_NAME', -class=>'sbox',
-values => ['Class A','Class B', 'Class C', 'Class D', 'Class E'
, 'Class H'],
-default=>$TISSUE_NAME )),

$obj->submit ( -name=>'submit', -value=>'Search' ),

#form end

print $obj->end_html;
exit ( 0 );
 
This is what I have:

#!/usr/local/bin/perl

use CGI;
use strict;
use DBI;

my $q=new CGI;
my $obj = new CGI;
my $name = 'Search mRNA';
my $title = 'Search mRNA';

print $obj->header ( 'text/html' );
$obj->start_html ( $title );
$obj->h1 ( {-class=>'header'}, $title );

my $GENE_NAME=$q->param('GENE_NAME');
my $ORGANISM_NAME=$q->param('ORGANISM_NAME');
my $EXPRESSION_LEVEL=$q->param('EXPRESSION_LEVEL');
my $TISSUE_NAME=$q->param('TISSUE_NAME');

my $dc = DBI->connect ( "DBI:mysql:host=localhost;database=seqdb", "seqdb", "*******",
{ PrintError => 0 , RaiseError => 1 } );
my $qs = 'SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSI
ON_LEVEL, TISSUE.TISSUE_NAME, MRNA.MRNA_SEQUENCE ';
$qs .= ' FROM GENE, ORGANISM, MRNA, TISSUE';
$qs .= ' WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.
MRNA_ORGANISM AND TISSUE.TISSUE_ID = MRNA.MRNA_TISSUE AND ';
$qs .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$OR
GANISM_NAME'
AND MRNA.MRNA_EXPRESSION_LEVEL = '$EXPRESSION_LEVEL' AND TISSU
E.TISSUE_NAME = '$TISSUE_NAME' ~;
my $qe = $dc->prepare ( $qs );
$qe->execute;

if ( $qe->rows > 0 )
{
while ( my $cr = $qe->fetchrow_hashref () )
{
print $obj->div (
{-class=>'result'},
qq~ Gene: $cr->{'GENE_NAME'},
Organism: $cr->{'ORGANISM_NAME'},
Expression Level: $cr->{'MRNA_EXPRESSION_LEVEL'},
Tissue Name: $cr->{'TISSUE_NAME'}
Sequence: $cr->{'MRNA_SEQUENCE'}~
),
"\n";
}
}
else {
print "No mRNA results found for the query: \n";
print "$qs\n";
print "\n";
print "try with: \n";
print "UNCULTURED CRENARCHAEOTE: Archaea: 3: Class E \n";
print "\n";
print "TPMT_HUMAN: Bacteria: 5: Class C \n";
print "\n";
print "P2X1_HUMAN: Eukaryota: 2: Class A \n";
}
$qe->finish;
$dc->disconnect ();

#form start

my $method = 'post';
my $action = 'SearchSeqResult.cgi';
my $result = 'Results';
my $test = 0;

if ( lc $ENV{'REQUEST_METHOD'} eq 'post' )
{
$test = 1;

$GENE_NAME = $obj->param ( 'GENE_NAME' );
$ORGANISM_NAME = $obj->param ( 'ORGANISM_NAME' );
$EXPRESSION_LEVEL = $obj->param ( 'EXPRESSION_LEVEL' );
$TISSUE_NAME = $obj->param ( 'TISSUE_NAME' );
}


$obj->start_form ( -name=>$name, -method=>$method, -action=>$action ),

$obj->p ( {-class=>'box'},
$obj->b ( 'GENE NAME: ' ),
$obj->popup_menu ( -name=>'GENE_NAME', -class=>'sbox',
-values => ['BRC2_HUMAN','BRC2_HUMAN', 'KAP0_RAT','KAPB_MOUSE','
P2X1_HUMAN','P2Y4_HUMAN',
'TPMT_HUMAN', 'UNCULTURED CRENARCHAEOTE'], -default=>$GENE_NAME)
),
$obj->p ( {-class=>'box'},
$obj->b ( 'ORGANISM NAME: ' ),
$obj->popup_menu ( -name=>'ORGANISM_NAME', -class=>'sbox', -values =>[
'ARCHAEA','BACTERIA','EUKARYOTA','OTHER'],
-default=>$ORGANISM_NAME )),
$obj->p ( {-class=>'box'},
$obj->b ( 'EXPRESSION LEVEL: ' ),
$obj->popup_menu( -name=>'EXPRESSION_LEVEL', -class=>'sbox', -values =
> [1..5],
-default=>$EXPRESSION_LEVEL)),
$obj->p ( {-class=>'box'},
$obj->b ( 'TISSUE NAME: ' ),
$obj->popup_menu ( -name=>'TISSUE_NAME', -class=>'sbox',
-values => ['Class A','Class B', 'Class C', 'Class D', 'Class E'
, 'Class H'],
-default=>$TISSUE_NAME )),

$obj->submit ( -name=>'submit', -value=>'Search' ),

#form end

print $obj->end_html;
exit ( 0 );
 
John,

please start using the code tags to post your code:

[ignore]
Code:
your code here
[/ignore]

It makes it considerably easier to look at large blocks of code.

I'm not sure if your script is really like this or the forum has reformatted some of the code, but you have:

Code:
     $qs   .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '[b][COLOR=#ff0000]$OR[/color][/b]
GANISM_NAME'

Perl thinks it's just $OR because the scalar is split over two lines.

here an operator is split over two lines:

Code:
          $obj->popup_menu( -name=>'EXPRESSION_LEVEL', -class=>'sbox', -values [COLOR=#ff0000]=
>[/color] [1..5],

the "=>" has to be together on the same line.

add this line to your code at the beginning:

Code:
[b]use CGI::Carp qw/fatalsToBrowser/;[/b]
use CGI;
use strict;
use DBI;


it will print the fatal errors back to the screen. Such as the ones above I posted for you. After you go live with the script comment out or remove the line. Fix the above if it needs fixing and retry the script.
 
You are right. They are wrapped..

Code:
#!/usr/local/bin/perl

use CGI::Carp qw/fatalsToBrowser/;
use CGI;
use strict;
use DBI;

my $q=new CGI;
my $obj = new CGI;
my $name    = 'Search Seq';
my $title   = 'Search Seq';

print $obj->header ( 'text/html' );
$obj->start_html ( $title );
$obj->h1 ( {-class=>'header'}, $title );

my $GENE_NAME=$q->param('GENE_NAME');
my $ORGANISM_NAME=$q->param('ORGANISM_NAME');
my $EXPRESSION_LEVEL=$q->param('EXPRESSION_LEVEL');
my $TISSUE_NAME=$q->param('TISSUE_NAME');

     my $dc = DBI->connect ( "DBI:mysql:host=localhost;database=seqdb", "seqdb", "*********",
                        { PrintError => 0 , RaiseError => 1 } );
     my $qs = 'SELECT GENE.GENE_NAME, ORGANISM.ORGANISM_NAME, MRNA.MRNA_EXPRESSION_LEVEL, TISSUE.TISSUE_NAME, 	MRNA.MRNA_SEQUENCE ';
     $qs   .= ' FROM GENE, ORGANISM, MRNA, TISSUE';
     $qs   .= ' WHERE GENE.GENE_ID = MRNA.MRNA_GENE_NAME AND ORGANISM_ID = MRNA.MRNA_ORGANISM AND TISSUE.TISSUE_ID = MRNA.MRNA_TISSUE AND ';
     $qs   .= qq~ GENE.GENE_NAME ='$GENE_NAME' AND ORGANISM.ORGANISM_NAME = '$ORGANISM_NAME'
                  AND MRNA.MRNA_EXPRESSION_LEVEL = '$EXPRESSION_LEVEL' AND TISSUE.TISSUE_NAME = '$TISSUE_NAME'  ~;
     my $qe = $dc->prepare ( $qs );
     $qe->execute;

     if ( $qe->rows > 0 )
     {
          while ( my $cr = $qe->fetchrow_hashref () )
          {
                print $obj->div (
                        {-class=>'result'},
                        qq~ Gene: $cr->{'GENE_NAME'},
                        Organism: $cr->{'ORGANISM_NAME'},
                        Expression Level: $cr->{'MRNA_EXPRESSION_LEVEL'},
                        Tissue Name: $cr->{'TISSUE_NAME'}
                        Sequence: $cr->{'MRNA_SEQUENCE'}~
                        ),
                "\n";
          }
     }
     else {
        print "No mRNA results found for the query: \n";
        print "$qs\n";
        print "\n";
        print "try with: \n";
        print "UNCULTURED CRENARCHAEOTE: Archaea: 3: Class E \n";
        print "\n";
        print "TPMT_HUMAN: Bacteria: 5: Class C \n";
        print "\n";
        print "P2X1_HUMAN: Eukaryota: 2: Class A \n";
     }
     $qe->finish;
     $dc->disconnect ();

#form start

my $method  = 'post';
my $action  = 'SearchSeqResult.cgi';
my $result  = 'Results';
my $test = 0;

if ( lc $ENV{'REQUEST_METHOD'} eq 'post' )
{
     $test = 1;

     $GENE_NAME = $obj->param ( 'GENE_NAME' );
     $ORGANISM_NAME = $obj->param ( 'ORGANISM_NAME' );
     $EXPRESSION_LEVEL = $obj->param ( 'EXPRESSION_LEVEL' );
     $TISSUE_NAME = $obj->param ( 'TISSUE_NAME' );
}


$obj->start_form ( -name=>$name, -method=>$method, -action=>$action ),

$obj->p ( {-class=>'box'},
          $obj->b ( 'GENE NAME: ' ),
          $obj->popup_menu ( -name=>'GENE_NAME', -class=>'sbox',
                -values => ['BRC2_HUMAN','BRC2_HUMAN', 'KAP0_RAT','KAPB_MOUSE','P2X1_HUMAN','P2Y4_HUMAN',                 'TPMT_HUMAN', 'UNCULTURED CRENARCHAEOTE'], -default=>$GENE_NAME)),
$obj->p ( {-class=>'box'},
          $obj->b ( 'ORGANISM NAME: ' ),
          $obj->popup_menu ( -name=>'ORGANISM_NAME', -class=>'sbox', -values =>['ARCHAEA','BACTERIA','EUKARYOTA','OTHER'],
                -default=>$ORGANISM_NAME )),
$obj->p ( {-class=>'box'},
          $obj->b ( 'EXPRESSION LEVEL: ' ),
          $obj->popup_menu( -name=>'EXPRESSION_LEVEL', -class=>'sbox', -values => [1..5],
                -default=>$EXPRESSION_LEVEL)),
$obj->p ( {-class=>'box'},
          $obj->b ( 'TISSUE NAME: ' ),
          $obj->popup_menu ( -name=>'TISSUE_NAME', -class=>'sbox',
                -values => ['Class A','Class B', 'Class C', 'Class D', 'Class E', 'Class H'],
                -default=>$TISSUE_NAME )),

$obj->submit ( -name=>'submit', -value=>'Search' ),

#form end

print $obj->end_html;
exit ( 0 );
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top