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

hi, well, a problem, as usual. as i'm no expert in CGI and web applications i'am stuck on the following: this script for some reason doesn't work: 
#!/usr/bin/perl

use strict;
my ($buffer, @pairs, $pair, @data, $name, $value, %FORM, %keyhash, $da
+tabase);
# Read in text
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "POST"){
  read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
else {
  $buffer = $ENV{'QUERY_STRING'};
}

# Split information into name/value pairs

@pairs = split(/&/, $buffer);
foreach $pair (@pairs){
  ($name, $value) = split(/=/, $pair);
  $value =~ tr/+/ /;
  $value =~ s/%(..)/pack("C", hex($1))/eg;
  $FORM{$value} = $name;
  $database = $name;
}

# HTTP Header
print "Content-type:text/html\r\n\r\n";
print "<html>";
print "<head>";
print "<title>Checkbox - Third CGI Program</title>";
print "</head>";
print "<body>";
print "It stops here";   #######################################

#retrieve sata from the database
my @arraydata =();
foreach my $request (keys %FORM){
  my @array =split('!-!',$request);
  $keyhash{$array[0]}=1;
  push (@arraydata, $array[0]);

}

open (IN, "<", "./seqdb/$database") || die "$!";

my ($seq,$header,$lock) = ('','',0);
while (<IN>){
  chomp;
  if (/>/){
    my @array =split(' ',$_);
    $array[0]=~s/>//;
    push(@data,"<p>$header\n$seq\n<p>") if $lock == 1;
    if ($keyhash{$array[0]}){
      $header = $_;
      $lock = 1;
    }
    else{
      $lock = 0;
    }
  }
  elsif ($lock == 1){
    $seq .=$_;
  }
}

close IN;


foreach (@data){
  print $_;
}

print "</body>";
print "</html>";

[download]
so the idea is, once the user marks the checkboxes in other cgi script this data is passed to this script and then this script quickly looks in a file and extracts all relevant data and prints it. well, it does everything but printing. the last thing that is printed in my browser is "It stops here" (you can find it in a script). the results that are found : 
foreach (@data){
  print $_;
}

[download]
are not printed. but when i remove the 'open' and 'close' lines or just 'open', script more or less is working, it gets to the end. now my question is why? what am i doing wrong. i tried the same thing in a smaller test script 
#!/usr/bin/perl
use strict;
use Data::Dumper;


my @data = ();
open (IN, "<", "./seqdb/db454_hvir_celera_v01") || die "$!";
my %keyhash = ();
$keyhash{'db454_hvir_celera_v01_8887'} = 1;
my ($seq,$header,$lock) = ('','',0);
while (<IN>){
  chomp;
  if (/>/){
    my @array =split(' ',$_);
    $array[0]=~s/>//;
    #print Dumper(\%keyhash);
    push(@data,"$header\n$seq\n") if $lock == 1;
    if ($keyhash{$array[0]}){
      $header = $_;
      $lock = 1;
    }
    else{
      $lock = 0;
    }
  }
  elsif ($lock == 1){
    $seq .=$_;
  }
}

close IN;
print "Content-type:text/html\r\n\r\n";
print "<html>";
print "<head>";
print "<title>Checkbox - Third CGI Program</title>";
print "</head>";
print "<body>";
foreach (@data){
  print $_;
}


print "</body>";
print "</html>";

[download]
and this does not cause any problems, script is interpreted all the way... (i mean here you do not have any data passed from any other scripts). so, i'm confused .... am i suffuring from some sort of buffering or ... where could the problem be?

Thanx

Replies are listed 'Best First'.
Re: Problem with CGI script
by marto (Cardinal) on Nov 12, 2010 at 18:52 UTC
[reply]
Re: Problem with CGI script
by Illuminatus (Curate) on Nov 12, 2010 at 17:09 UTC
    Well, it seems most likely that the open is failing. There are 2 likely scenarios:
    1. $database is not what you think it is. I notice you are setting it on each iteration of the parsing of QUERY_STRING. Is the database guaranteed to be the last element?
    2. The applications cwd is not what you think it is. If you tested using root or your own user-id, and the web server runs the application as a different user, then the working dir may be wrong

    fnord

[reply]
Re: Problem with CGI script
by Anonymous Monk on Nov 12, 2010 at 17:38 UTC
[reply]

Back to Seekers of Perl Wisdom