Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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.

In reply to Re^2: The execution of my CGI opens a new navigator window by ofornes
in thread The execution of my CGI opens a new navigator window by ofornes

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others lurking in the Monastery: (6)
    As of 2014-09-02 06:44 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite cookbook is:










      Results (20 votes), past polls