First of, maybe I am not the cleanest guy programming perl... I didn't want to disturb you with all my code, but since it was stated that the code is needed to solve my problem, here it goes:
#!/usr/bin/perl -Tw
use strict;
use CGI qw(:all delete_all escapeHTML);
$|=1;
######################################################################
# Ensure all fatals go to browser during debugging and set-up. #
# This must be comment out on production code for security. #
######################################################################
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
######################################################################
# Untaint the path & Use CGI.pm. #
######################################################################
$ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/
+sbin";
######################################################################
# Create new CGI. #
######################################################################
my $cgi = new CGI;
######################################################################
# Untaint & Check the CGI. #
######################################################################
my ($error,$line);
# Argument 1: $session contains the process id #######################
my $session = get_session_id(); # C
+ombination of local time and process
# Argument 2: $query contains query sequence #########################
my @query_info = ();
my $query = "/tmp/query.$session"; # F
+ile containing the query sequence
my $query_box = $cgi->param("query_box");
+ # Server box where the query was pasted
my $query_file = $cgi->upload("query_file");
+ # Server upload file content containing the query
#######################################
# 1. Extraction of the query sequence #
#######################################
# If the user pasted the query in the query box... #
if ($query_box ne "") {
# Read the query sequence #
@query_info = split(/\n/, $query_box);
# If the user upload the query in a file... #
} else {
# Read the query sequence #
while (<$query_file>) {
chomp $_;
push (@query_info, $_);
}
}
########################################################
# 2. Checking if the query sequence is in FASTA format #
########################################################
# Get the query tag & sequence #
(my @query) = @{extract_sequences(\@query_info)};
# If more than 1 query was submitted... #
if (scalar (@query) != 2) {
# Error message #
$error = "The query sequence is not in FASTA format or more than 1
+ query is submitted.\n";
# Erase temp files #
unlink ($query);
# Print error page #
print_error_page($error);
# Exit the CGI #
exit 0;
}
################################
# 3. Saving the query sequence #
################################
# Open file or give error message and exit the CGI #
open (FILE, ">$query") or ($error = "ModLink+ encountered an error: Ca
+nnot create the file to write the query sequence ($query). Do please
+notify this error by sending an e-mail to the server administrator (o
+fornes\@imim.es). We will contact you once the error is solved. Thank
+s for your patience.\n" and unlink ($query) and print_error_page($err
+or) and exit 0);
# Foreach line of the file... #
foreach $line (@query) {
# Print the line #
print FILE $line."\n";
}
close (FILE);
# Argument 5: $databases contains databases ##########################
my $databases = "";
# If defined job title #
foreach my $database ($cgi->param("databases")) {
if ($database =~ /1-7/) {
$databases .= $database;
}
}
# Argument 3: $extrapolation contains SCOP codes extrapolation choice
my $extrapolation = "none"; # S
+tring containing the SCOP codes extrapolation choice
if ($cgi->param("expansion") eq "by family") {
$extrapolation = "fa";
} elsif ($cgi->param("expansion") eq "by superfamily") {
$extrapolation = "sf";
} elsif ($cgi->param("expansion") eq "by fold") {
$extrapolation = "cf";
}
# Argument 4: $MK_hub contains cut-off limit on the acceptance of hubs
my $MK_hub = ""; # I
+nteger containining the cut-off limit on the acceptance of hubs
if ($cgi->param("hubs") =~ /(\d+)/) {
$MK_hub = $1;
} else {
$MK_hub = "none";
}
# Argument 5: $EVTE contains evalue threshold on extrapolation (EVTE)
my $EVTE = ""; # I
+nteger containing the EVTE
if ($cgi->param("evte") =~ /(\d+)/) {
$EVTE = $1;
} else {
$EVTE = 1e-12;
}
# Argument 6: $EVTH contains evalue threshold on sequence homologs (EV
+TH)
my $EVTH = ""; # I
+nteger containing the EVTH
if ($cgi->param("evth") =~ /(\d+)/) {
$EVTH = $1;
} else {
$EVTH = 1e-70;
}
# Argument 7: $interactor contains query sequence ###################
my @interactors_info = ();
my $interactor = "/tmp/interactor.$session"; # F
+ile containing the interactor sequences
my $interactor_num = $cgi->param("interactor_num"); # I
+nteger containing the number of interactor sequences
my $interactor_box = $cgi->param("interactor_box"); # S
+erver box where the interactors were pasted
my $interactor_file = $cgi->upload("interactor_file"); # S
+erver upload file content containing the interactors
if ($interactor_box ne "" and $interactor_file ne "") {
#############################################
# 1. Extraction of the interactor sequences #
#############################################
# If the user pasted the interactors in the interactor box... #
if ($interactor_box ne "") {
# Read the interactor sequences #
@interactors_info = split(/\n/, $interactor_box);
# If the user upload the interactor in a file... #
} else {
# Read the interactor sequence #
while (<$interactor_file>) {
chomp $_;
push (@interactors_info, $_);
}
}
###############################################################
# 2. Checking if the interactor sequences are in FASTA format #
###############################################################
# Get the interactor tags & sequences #
(my @interactors) = @{extract_sequences(\@interactors_info)};
# If more than 1 query was submitted... #
if (scalar (@interactors) != ($interactor_num*2)) {
# Error message #
$error = "The interactor sequences are not in FASTA format or
+number of interactors submited does not correspond with the number yo
+u selected.\n";
# Erase temp files #
unlink ($query);
unlink ($interactor);
# Print error page #
print_error_page($error);
# Exit the CGI #
exit 0;
}
######################################
# 3. Saving the interactor sequences #
######################################
# Open file or give error message and exit the CGI #
open (FILE, ">$query") or ($error = "ModLink+ encountered an error
+: Cannot create the file to write the interactor sequences ($interact
+or). Do please notify this error by sending an e-mail to the server a
+dministrator (ofornes\@imim.es). We will contact you once the error i
+s solved. Thanks for your patience.\n" and unlink ($query) and unlink
+ ($interactor) and print_error_page($error) and exit 0);
foreach $line (@interactors) {
# Print the line #
print FILE $line."\n";
}
close (FILE);
# Not interactors submited #
} else {
$interactor = "none";
}
1;
# Sub-routines from here #############################################
+#############
sub print_error_page {
######################################################################
# This function prints the error html head and body (error message #
# every single place where enters this function). #
######################################################################
# Input #
my $error = $_[0];
# Print the errors page #
print start_html('-title' => "Secrets of the Pyramids",
'-author' => 'ofornes@imim.es',
'-base' => "true",
'-target' => "_blank",
'-style' => { '-src' => "/styles/modlink.css"
+ },
'-script' => { '-type' => 'JavaScript',
'-src' => "/javascript/modlink.
+js" }),
table({'-border' => "0", '-cellspacing' => 0},
Tr({'-background' => "blue"},
td({'-class' => "banner"},
[print_server_title_and_logos()]))),
h2("Request not processed"),
strong($error),
end_html();
sub print_server_title_and_logos {
table({'-border' => "0", '-cellspacing' => 10},
Tr(
td({'-class' => "program_name"},
["ModLink+<br />".print_server_options()]),
td({'-class' => "grib",
'-align' => "right"},
img{src => "/img/grib_logo.gif"}),
td({'-class' => "sbi",
'-align' => "right",
'-valign' => "center"},
img {src => "/img/sbi_logo.gif"})));
}
sub print_server_options {
table({'-border' => "0", '-cellspacing' => 0},
Tr({'-valign' => "bottom"},
td({'-class' => "options",
'-onMouseOut' => "style.color='white';",
'-onMouseOver' => "style.cursor='pointer';style.color='bl
+ack';"},
["<a onClick=\"index.html\">Home</a>"]),
td({'-class' => "options",
'-onMouseOver' => "style.cursor='pointer';style.color='bl
+ack';",
'-onMouseOut' => "style.color='white';"},
["Recent Results"]),
td({'-class' => "options",
'-onMouseOver' => "style.cursor='pointer';style.color='bl
+ack';",
'-onMouseOut' => "style.color='white';"},
["Help"])));
}
}
sub extract_sequences {
######################################################################
# This function goes through the sequence data extracting lines that #
# contains sequence or tags. #
######################################################################
my ($line);
# Initialize #
my $sequence = "";
my @sequences = ();
# Input #
my @extracted_data = @{$_[0]};
# Foreach line of sequence... #
foreach $line (@extracted_data) {
chomp $line;
# Skip lines containing info... #
if ($line =~ /^\s*$/) {
next;
} elsif ($line =~ /^\s*#/) {
next;
# Get the line with tag identifier #
} elsif ($line =~ /^>/) {
push (@sequences, $line);
# Get the line with sequence and join it to the main sequence #
} else {
# If previous item saved is a tag identifier... #
if ($sequences[scalar (@sequences) -1] =~ /^>/) {
# Push the line with sequence to @sequences #
push (@sequences, $line);
# If previous item saved is a sequence... #
} else {
# Join the sequence to the main sequence #
if (defined $sequences[scalar (@sequences) -1]) {
$sequences[scalar (@sequences) -1] .= $line;
} else {
push (@sequences, $line);
}
}
}
}
# Foreach position in @sequences #
for (my $pos = 0; $pos < scalar (@sequences); $pos++) {
# If item saved is sequence... #
if (!($sequences[$pos] =~ /^>/)) {
# Clean up the sequence #
$sequences[$pos] =~ s/\n//mg; # make one line
$sequences[$pos] =~ s/\r//mg; # make one line
$sequences[$pos] =~ s/\W+//g; # eliminate non-word char
$sequences[$pos] =~ s/_+//g; # eliminate underscore, since
+ not covered by \W
$sequences[$pos] =~ s/\d+//g; # eliminate numbers
$sequences[$pos] =~ s/\*//; # eliminate *'s
$sequences[$pos] =~ s/\s+//g; # eliminate spaces
$sequences[$pos] =~ tr/a-z/A-Z/; # convert to uppercase
}
}
return (\@sequences);
}
sub get_session_id {
######################################################################
# Defines self session id.
+ #
######################################################################
require Digest::MD5;
Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$));
}
I don't know how to check my navigator configuration (I read maybe the problem was in the navigator). I am using Firefox version 1.5.0.7. |