Solved

Data Upload

Posted on 2009-05-14
36
384 Views
Last Modified: 2012-05-07
On an online form i want to give my user the option to either copy-paste text into a text box... or have the option to upload a file from a directory on their computer.

So far i've mainly been dealing with text box:

# Feed in data from text box on web-form

$dna1 = $query->param('dna-textbox');

i'm just wondering.. at the front end of my script how i'd go about making it more versatile to also accept file upload.

$dna1 = $query->param('dna-textbox'); ELSE $query->param('fileupload')
0
Comment
Question by:StephenMcGowan
  • 18
  • 16
  • 2
36 Comments
 
LVL 8

Expert Comment

by:DocSeltsam
ID: 24383879
Hi there,

if (defined ($query->param('fileupload')))
{
  handle the upload;
}
else
{
  go on with  $query->param('dna-textbox');
}


--TheDoctor
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24384056
When you say front-end, I assume you mean in the HTML web form, not the Perl CGI script.

Try the HTML below.

However, also set some things in your Perl program, are you using the -T flag for taint checking, probably should.
Also set a max file upload size:

$CGI::POST_MAX = 2000000;  # Max 2 mb file

Then in your Perl script, you can access like your code above:  $query->param("fileupload");

Use $query->param("fileupload")  to get the filename
Use $query->upload("fileupload") to get the file handle so you can read the contents


<form action="/cgi-bin/action.pl" method="POST" enctype="multipart/form-data">
 

  <input type="text" name="dna-textbox" id="dna-textbox"/>
 

  File to upload:  <input type="file" id="fileupload" name="fileupload"/>
 

</form>

Open in new window

0
 

Author Comment

by:StephenMcGowan
ID: 24384178
On a HTML level... i've tried:

  <label>Enter a DNA Sequence:<br>
    <textarea name='dna-textbox' id='dna-textbox' cols='45' rows='5'></textarea><form id='form1' name='form1' method='post' action='ORFfinder.pl'>
  </label>
  <p>File to upload:</p>
<input type="file" id="fileupload" name="fileupload"/>

Which doesnt seem to have worked: Internal Server Error.

I was also talking about my perl script accepting two form options:

$dna1 = EITHER ACCEPT $query->param('dna-textbox'); OR ELSE ACCEPT $query->param('fileupload')

Thanks
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24384239
HTML by itself will not generate an internal server error, you must be embedding the HTML inside a Perl script? If so, please post the Perl script. I copied this from a working Perl script I have, so I know the approach works. It is just a syntax error on your side.

DrSeltsam already posted the if/then solution portion.
0
 

Author Comment

by:StephenMcGowan
ID: 24384331
Hi DocSeltsam,

so you're saying:

if (defined ($query->param('fileupload')))
{
$dna_filename = <STDIN>;
unless ( open(DNAFILE, $dna_filename) ) {
print "Cannot open file \"$dna_filename\"\n\n";
exit;
}
@dna = <DNAFILE>;
close DNAFILE;
$dna = join( ' ', @DNA);
$dna = ~ s/\s//g;
}
else
{
dna1 = $query->param('dna-textbox');
$dna = extract_string_sequence_from_fasta_data($dna1);
}

would this work?

0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24384402
You don't have to open an input file, its already provided, as I said use $query->upload('fileupload') to obtain the open file stream, don't use <STDIN>

Also, since this is Perl, you must pay attention to case sensitivity. Your variables are all mixed. In 1 place you say @dna, then you say @DNA

Try this way.
if (defined ($query->param('fileupload')))

{

   $dna_filename = $query->param('fileupload');

   $dna_file = $query->upload('fileupload');

   @dna = <$dna_file>;

   close $dna_file;

   $dna = join( ' ', @dna);

   $dna = ~ s/\s//g;

}

Open in new window

0
 
LVL 8

Expert Comment

by:DocSeltsam
ID: 24384583
Hi there,

there is nothing I could add to mrjoltcola i guess.
You might want to read the file different, but that depends on your use case.

--TheDoctor
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24384655
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24384696
Here is a full working sample, however it does not save the file, it just reads it in and prints it to the browser in response

#!/usr/bin/perl
 

use CGI qw/:standard/;
 

print header,

        start_html('A Simple Example'),

        h1('A Simple Example'),

        start_form,

        "What's your name? ",textfield('name'),p,

        "What's the combination?", p,

        checkbox_group(-name=>'words',

                       -values=>['eenie','meenie','minie','moe'],

                       -defaults=>['eenie','minie']), p,

        "What's your favorite color? ",

        popup_menu(-name=>'color',

                   -values=>['red','green','blue','chartreuse']),p,

        filefield(-name => 'fileupload'),

        submit,

        end_form,

        hr;
 

if (param()) {

       my $name      = param('name');

       my $keywords  = join ', ',param('words');

       my $color     = param('color');

       my $filename  = param('fileupload');
 

       if($filename) {

          my $uploadfh = upload("fileupload");

          while(<$uploadfh>) {

             $str .= $_;

          }

          close $uploadfh;

          print

             "Your file ($filename) was: " . $str,

             hr;

       }
 

       print "Your name is",em(escapeHTML($name)),p,

             "The keywords are: ",em(escapeHTML($keywords)),p,

             "Your favorite color is ",em(escapeHTML($color)),

             hr;
 

}
 

print end_html;

Open in new window

0
 

Author Comment

by:StephenMcGowan
ID: 24385648
for:

if (defined ($query->param('fileupload')))
{
   $dna_filename = $query->param('fileupload');
   $dna_file = $query->upload('fileupload');
   @dna = <$dna_file>;
   close $dna_file;
   $dna = join( ' ', @dna);
   $dna = ~ s/\s//g;
}

how should i initialise the variables $dna_file and @dna?
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24385933
You don't need to initialize them, they are intialized in the code above. Now, if using "strict", you should "declare" them in  your program, either globally, or local to the procedure, depending on where you need the variables.

my $dna_file;
my @dna;
0
 

Author Comment

by:StephenMcGowan
ID: 24386252
I've tried running the above script, but receive the error message:

Can't use an undefined value as a symbol reference

for the line: close $dna_file;
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24386352
Hi Stephen, I took your own script as a starting point. It is normally recommended for you, as the asker, to post either the full script, or an adequate portion to assist us in helping you.
0
 

Author Comment

by:StephenMcGowan
ID: 24386690
The way i've been shown to go about this using a file not uploaded using CGI is as follows:

########

#Read in the contents of the file "sample.dna"'
@file_data = get_file_data("sample.dna");

# Subroutine code:
# A subroutine to get data from a file given its filename

sub get_file_data {

    my($filename) = @_;

    use strict;
    use warnings;

    # Initialize variables
    my @filedata = (  );

    unless( open(GET_FILE_DATA, $filename) ) {
        print STDERR "Cannot open file \"$filename\"\n\n";
        exit;
    }

    @filedata = <GET_FILE_DATA>;

    close GET_FILE_DATA;

    return @filedata;
}



#Extract the sequence data from the contents of the file "sample.dna"
$dna = extract_sequence_from_fasta_data(@file_data);

#Subroutine code

# A subroutine to extract FASTA sequence data from an array

sub extract_sequence_from_fasta_data {

    my(@fasta_file_data) = @_;

    use strict;
    use warnings;

    # Declare and initialise variables
    my $sequence = '';

    foreach my $line (@fasta_file_data) {

        # discard blank line
        if ($line =~ /^\s*$/) {
            next;

        # discard comment line
        } elsif($line =~ /^\s*#/) {
            next;

        # discard fasta header line
        } elsif($line =~ /^>/) {
            next;

        # keep line, add to sequence string
        } else {
            $sequence .= $line;
        }
    }

    # remove non-sequence data (in this case, whitespace) from $sequence
    # string
    $sequence =~ s/\s//g;

    return $sequence;


########

print $dna;

The difference of what i'm trying to do is call pull the file from an online web-form and then run this through the subroutines shown above... (maybe not get_file_data... if it's not needed?)
0
 

Author Comment

by:StephenMcGowan
ID: 24386769
So i guess what i'm saying is, when a user uploads a file on the webform, it will be transferred over to a Perl script, converted into an array, and fed into:

# A subroutine to extract FASTA sequence data from an array

sub extract_sequence_from_fasta_data {

    my(@fasta_file_data) = @_;

    use strict;
    use warnings;

    # Declare and initialise variables
    my $sequence = '';

    foreach my $line (@fasta_file_data) {

        # discard blank line
        if ($line =~ /^\s*$/) {
            next;

        # discard comment line
        } elsif($line =~ /^\s*#/) {
            next;

        # discard fasta header line
        } elsif($line =~ /^>/) {
            next;

        # keep line, add to sequence string
        } else {
            $sequence .= $line;
        }
    }

    # remove non-sequence data (in this case, whitespace) from $sequence
    # string
    $sequence =~ s/\s//g;

    return $sequence;

returning a $sequence.
0
 

Author Comment

by:StephenMcGowan
ID: 24388593
Below is a picture of my front end HTML.

What i'm trying to do in a perl script is basically say:

#If a user copies/pastes into a text box, take this approach and make the file into an array called @dna

else

#If not, then use the file upload, upload the file and make the file into an array called @dna
Input.jpg
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24389097
Here is a rewrite. Try it out. I tested it but have no samples or DNA processing code, it just prints the contents of either the textarea, or the file upload.

If both are submitted, it ignores the file.

#!/usr/bin/perl
 

use strict;

use warnings;

use CGI qw/:standard/;
 

my $query = new CGI;
 

my $dna;
 

# If text box provided, take from that

if($query->param('dna-textbox')) {

   $dna = $query->param('dna-textbox');

}

# Else see if file upload

elsif($query->param('fileupload')) {

   # Retrieve the file from the web post instead of the filesystem

   my @file_data = get_file_data();
 

   #Extract the sequence data from the contents of the file "sample.dna"

   $dna = extract_sequence_from_fasta_data(@file_data);

}
 

print_output($dna);
 
 

# Subroutines go below:
 

# A subroutine to get data from a file given its filename

sub get_file_data {

    # Initialize variables

    my @filedata = ();

    if(defined $query->upload('fileupload')) {

       my $GET_FILE_DATA = $query->upload('fileupload');

       @filedata = <$GET_FILE_DATA>;

       close $GET_FILE_DATA;

    }

    return @filedata;

}
 
 

# A subroutine to extract FASTA sequence data from an array
 

sub extract_sequence_from_fasta_data {
 

    my(@fasta_file_data) = @_;
 

    # Declare and initialise variables

    my $sequence = '';
 

    foreach my $line (@fasta_file_data) {
 

        # discard blank line

        if ($line =~ /^\s*$/) {

            next;
 

        # discard comment line

        } elsif($line =~ /^\s*#/) {

            next;
 

        # discard fasta header line

        } elsif($line =~ /^>/) {

            next;
 

        # keep line, add to sequence string

        } else {

            $sequence .= $line;

        }

    }
 

    # remove non-sequence data (in this case, whitespace) from $sequence

    # string

    $sequence =~ s/\s//g;
 

    return $sequence;

}
 
 

sub print_output {

    my $dna = shift;
 

    print header,

        start_html('DNA Sample'),

        h1('DNA Sample'),

        start_form,

        "Please enter a Fasta DNA Sequence or upload a file:", p,

        textarea('dna-textbox', 'DNA Sequence Here', 5, 60 ), p,

        "Filename to upload", p,

        filefield('fileupload'), p,

        submit('Go'),

        end_form,

        hr;
 

    if($dna) {

        print "RESULTS:  $dna\n", p;

    }

}

Open in new window

0
 

Author Comment

by:StephenMcGowan
ID: 24389249
hey mrjoltcola,

thanks for the feedback.. i've had a go at puuting the code into my script, have gone to the form and tried uploading a file, but i'm hit with the error:
Internal Server Error
The server encountered an internal error or misconfiguration and was unable to complete your request.

This doesn't really give any hints to my error, and i'm using

 use CGI::Carp 'fatalsToBrowser';

aswell.. is there anyway i can find out what's wrong?
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24389391
Try running my script standalone and see if it works, because I tested it before sending it.

Otherwise, try running it from the command line, you can run Perl CGI's like this.

./dna.pl dna-textbox=AABB
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24389407
The ./ is optional in most environments

dna.pl should work by itself

Make sure it is executable, if on UNIX do: chmod +x dna.pl

0
 

Author Comment

by:StephenMcGowan
ID: 24389771
ok.. i copy pasted your code into a file i called inputmethod.pl

I've had a play with it, if you type in random code into the textbox it comes up in results, but if you try to upload a file... like the one i've attached, it errors.
New-Text-Document.txt
0
 

Author Comment

by:StephenMcGowan
ID: 24390481
Been looking into this further... The code below seems to be working fine for textbox when it's all implemented into my main script, it's just the upload a file option which seems to be falling over.

At lines:    # Else see if file upload
                 elsif($query->param('fileupload'))  {

                  #  Retrieve the file from the web post instead of the filesystem
                  @file_data = get_file_data();

does there need to be a $query->upload('fileupload') in there somewhere?

it just seems the code starts off trying to generate @file_data by feeding () into the sub-routine "get_file_data". Does this retrieve from the web-post 'fileupload'? because at the moment i don't think the information is being passed from form to perl. Not sure how to test it with "print" though.

These are my thoughts anyway.
   # If a text box provided, take from that

if ($query->param('dna-textbox')) {

   $dna1 = $query->param('dna-textbox');

   $dna = extract_string_sequence_from_fasta_data($dna1);

}

   # Else see if file upload

elsif($query->param('fileupload'))  {
 

   #  Retrieve the file from the web post instead of the filesystem

   @file_data = get_file_data();
 

   #Extract the sequence from the contents of the file

   $dna = extract_sequence_from_fasta_data(@file_data);

}

Open in new window

0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24390507
>> does there need to be a $query->upload('fileupload') in there somewhere?

There is, I put it inside get_file_data().
0
 

Author Comment

by:StephenMcGowan
ID: 24390559
I get the error message: Can't call method "upload" on an undefined value at ReadingFrameModules.pm line 10.

in the subroutine at:

if(defined $query->upload('fileupload')) {

Do i need to call CGI for the subroutine? use CGI;?
0
 

Author Comment

by:StephenMcGowan
ID: 24390582
hmmm would seem not....

error message is still kicking in, with "use CGI;" in the sub-routine. :o/
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24391625
It is hard to help you when you don't post your modifications.

Also, in the other thread you opened, your posted code sample is a mish-mosh of valid and invalid Perl code, mixed with HTML.
0
 

Author Comment

by:StephenMcGowan
ID: 24394070
Sorry, here is all of my code that i'm using.. i'll clarify that i'm having problems with the file upload part of the online HTML form and how it is transferred into the Perl Script.

I hope this helps alot more than the snippets of code i've been giving.

Thanks.

form.txt
ORFfinder.txt
ReadingFrameModules.txt
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24398503
It might be simpler if we put all of this into a single Perl script, then work like that, and you can modularize it later when it is working. What do you think?
0
 

Author Comment

by:StephenMcGowan
ID: 24398535
that will be alot clearer, yeah... i can then go through it and modularise it later... i have updated my scripts since we last chatted so i will submit these on this thread in 2 seconds.
0
 

Author Comment

by:StephenMcGowan
ID: 24398589
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24398773
Attached DNALib.pm (ORFfinder.pl follows)
# Module DNALib.pm

#
 

use strict;
 

# A subroutine to extract FASTA sequence data from a string (for use 

# with text box data entry).
 

sub extract_string_sequence_from_fasta_data {

   local $_ = join'',@_;

   s/^>.*//gm;

   s/^\s*#.*//gm;

   s/\s+//g;

   return $_;

}
 

# A subroutine to extract FASTA sequence data from an array
 

sub extract_sequence_from_fasta_data {
 

    my(@fasta_file_data) = @_;
 

    # Declare and initialise variables

    my $sequence = '';
 

    foreach my $line (@fasta_file_data) {
 

        # discard blank line

        if ($line =~ /^\s*$/) {

            next;
 

        # discard comment line

        } elsif($line =~ /^\s*#/) {

            next;
 

        # discard fasta header line

        } elsif($line =~ /^>/) {

            next;
 

        # keep line, add to sequence string

        } else {

            $sequence .= $line;

        }

    }
 

    # remove non-sequence data (in this case, whitespace) from $sequence

    # string

    $sequence =~ s/\s//g;
 

    return $sequence;

}
 

# A subroutine to find the longest open reading frame (ORF) for a sequence
 

sub open_reading_frame {
 

    my($dna) = @_;
 

    #Declare and initialise variables

    my $longest_str ='';

    my $longest_len = 0;
 

    local $_ = $dna;

    s/\s+//g;
 

    # longest of the shortest sequences ending with TAA|TAG|TGA

#    while( /ATG(?=((?:...)*?(?:TAA|TAG|TGA)))/ig ){

     while( /\G(?:...)*?ATG(?=((?:...)*?(?:TAA|TAG|TGA)))/ig ){

        if( length $1 >$longest_len ){

             $longest_str=$1;

             $longest_len=length $1;

          }

      }
 

    return $longest_str;

}
 

# revcom

#

# A subroutine to compute the reverse complement of DNA sequence
 

sub revcom {
 

    my($dna) = @_;
 

    # First reverse the sequence

    my $revcom = reverse $dna;
 

    # Next, complement the sequence, dealing with upper and lower case

    # A->T, T->A, C->G, G->C

    $revcom =~ tr/ACGTacgt/TGCAtgca/;
 

    return $revcom;

}
 

# codon2aa

#

# A subroutine to translate a DNA 3-character codon to an amino acid

# Using hash lookup
 

sub codon2aa {

    my($codon) = @_;
 

    $codon = uc $codon;
 

    my(%genetic_code) = (
 

    'TCA' => 'S',    # Serine

    'TCC' => 'S',    # Serine

    'TCG' => 'S',    # Serine

    'TCT' => 'S',    # Serine

    'TTC' => 'F',    # Phenylalanine

    'TTT' => 'F',    # Phenylalanine

    'TTA' => 'L',    # Leucine

    'TTG' => 'L',    # Leucine

    'TAC' => 'Y',    # Tyrosine

    'TAT' => 'Y',    # Tyrosine

    'TAA' => '_',    # Stop

    'TAG' => '_',    # Stop

    'TGC' => 'C',    # Cysteine

    'TGT' => 'C',    # Cysteine

    'TGA' => '_',    # Stop

    'TGG' => 'W',    # Tryptophan

    'CTA' => 'L',    # Leucine

    'CTC' => 'L',    # Leucine

    'CTG' => 'L',    # Leucine

    'CTT' => 'L',    # Leucine

    'CCA' => 'P',    # Proline

    'CCC' => 'P',    # Proline

    'CCG' => 'P',    # Proline

    'CCT' => 'P',    # Proline

    'CAC' => 'H',    # Histidine

    'CAT' => 'H',    # Histidine

    'CAA' => 'Q',    # Glutamine

    'CAG' => 'Q',    # Glutamine

    'CGA' => 'R',    # Arginine

    'CGC' => 'R',    # Arginine

    'CGG' => 'R',    # Arginine

    'CGT' => 'R',    # Arginine

    'ATA' => 'I',    # Isoleucine

    'ATC' => 'I',    # Isoleucine

    'ATT' => 'I',    # Isoleucine

    'ATG' => 'M',    # Methionine

    'ACA' => 'T',    # Threonine

    'ACC' => 'T',    # Threonine

    'ACG' => 'T',    # Threonine

    'ACT' => 'T',    # Threonine

    'AAC' => 'N',    # Asparagine

    'AAT' => 'N',    # Asparagine

    'AAA' => 'K',    # Lysine

    'AAG' => 'K',    # Lysine

    'AGC' => 'S',    # Serine

    'AGT' => 'S',    # Serine

    'AGA' => 'R',    # Arginine

    'AGG' => 'R',    # Arginine

    'GTA' => 'V',    # Valine

    'GTC' => 'V',    # Valine

    'GTG' => 'V',    # Valine

    'GTT' => 'V',    # Valine

    'GCA' => 'A',    # Alanine

    'GCC' => 'A',    # Alanine

    'GCG' => 'A',    # Alanine

    'GCT' => 'A',    # Alanine

    'GAC' => 'D',    # Aspartic Acid

    'GAT' => 'D',    # Aspartic Acid

    'GAA' => 'E',    # Glutamic Acid

    'GAG' => 'E',    # Glutamic Acid

    'GGA' => 'G',    # Glycine

    'GGC' => 'G',    # Glycine

    'GGG' => 'G',    # Glycine

    'GGT' => 'G',    # Glycine

    );
 

    if(exists $genetic_code{$codon}) {

        return $genetic_code{$codon};

    }else{
 

            print STDERR "Bad codon \"$codon\"!!\n";

            exit;

    }

}
 

1;

Open in new window

0
 
LVL 40

Accepted Solution

by:
mrjoltcola earned 500 total points
ID: 24398779
ORFfinder.pl

#!/usr/bin/perl -w

# ORFfinder.pl

#

# Perl programme to read in FastA format to find all possible open

# reading frames (ORFS) beginning with ATG and ending with a stop codon,

# TGA, TAA, TAG)

use CGI qw/:standard/;

use CGI::Carp 'fatalsToBrowser';

use strict;

use warnings;
 

use DNALib;
 
 

# Analyse all six open reading frames and predict ORFS in all six. Only

# longest ORF will be used.
 
 

my $query = new CGI;
 
 

# First see if program called without params, if so, just display the initial form

if(!$query->param()) {

   print header;

   print <<ENDOFHTML;

<form id='form1' name='form1' method='post' action='ORFfinder.pl' enctype="multipart/form-data">

  <label>Please enter a Fasta DNA Sequence:<br>

    <textarea name='dna-textbox' id='dna-textbox' 'DNA sequence here:' cols='45' rows='5'></textarea><form id='form1' name='form1' method='post' 

action='ORFfinder.pl'>

 <p>Or upload a DNA Fasta sequence file: <input type='file' name='fileupload'/></p> </label>
 

  <p>Please select an enzyme to digest sequence:</p>

  <p>

    <label>

      <input type='radio' name='enzyme' value='TRYPSIN' id='TRYPSIN' />

      Trypsin</label>

    <br />

    <label>

      <input type='radio' name='enzyme' value='ENDOPROTL' id='ENDOPROTL' />

      Endoproteinase Lys-C</label>

    <br />

    <label>

      <input type='radio' name='enzyme' value='ENDOPROTA' id='ENDOPROTA' />

      Endoproteinase Arg-C</label>

    <br />

    <label>

      <input type='radio' name='enzyme' value='V8PROT' id='V8PROT' />

      V8 proteinase (Glu-C)</label><br>

  </p>

  <p>

    <input type='submit' name='button' id='button' value='Submit' />

     <input type='reset' name='Reset' id='Reset' value='Reset' />

       <input type='button' name='Help' id='Help' value='Help' />

       <input type='button' name='Upload' id='Upload' value='Upload' />

    <br />

  </p>

</form>

ENDOFHTML
 

   exit;

}
 
 
 

# Initialise variables

my ($dna, $dna1, $dna2, $dna3, $dna5, $dna6, $revcom, $revcom1, $revcom2);

my ($longorf1, $longorf2, $longorf3, $longorf4, $longorf5, $longorf6, $dna_filename);

$dna=$dna1=$dna2=$dna3=$dna5=$dna6=$revcom=$revcom1=$revcom2=$longorf1=$longorf2=$longorf3=$longorf4=$longorf5=$longorf6=$dna_filename='';

my $dna_file;

my @filedata;
 

#HTML OUTPUT header here so we can print debug info to page as we go

print $query->header;
 
 

# If a text box provided, take from that

if($query->param('dna-textbox') ne '') {

   $dna1 = $query->param('dna-textbox');

   print "Using DNA sequence from textbox [$dna1]\n";

   $dna = extract_string_sequence_from_fasta_data($dna1);

}

# Else see if file upload

elsif($query->param('fileupload'))  {

   my $filename = $query->param('fileupload');

   print "Using DNA sequence from file [$filename]\n";

   # Retrieve the file from the web post instead of the filesystem

   if($query->upload('fileupload')) {

      my $GET_FILE_DATA = $query->upload('fileupload');

      @filedata = <$GET_FILE_DATA>;

      close $GET_FILE_DATA;

   }

   else {

      print "Error reading file upload\n";

      exit;

   }
 

   print "File upload was: ", @filedata;
 

   #Extract the sequence from the contents of the file

   $dna = extract_sequence_from_fasta_data(@filedata);

}
 

# feed the dna data into open_reading_frame to return the longest ORF
 

$longorf1 = open_reading_frame($dna);
 

# remove first base from sequence

$dna2 = substr $dna, 1;

$longorf2 = open_reading_frame($dna2);
 

# remove first base from $dna2

$dna3 = substr $dna2, 1;

$longorf3 = open_reading_frame($dna3);
 

#Reverse compliment the DNA sequence

$revcom = revcom($dna);

$longorf4 = open_reading_frame($revcom);
 
 

#remove first base from sequence

$dna5 = substr $revcom, 1;

$longorf5 = open_reading_frame($dna5);
 

#remove a further base from the sequence

$dna6 = substr $dna5, 1;

$longorf6 = open_reading_frame($dna6);
 

# SECOND HALF OF THE PROGRAM - THIS WAS ORIGINALLY TO BE SENT TO A SECOND SCRIPT

# FOR TASK 2 BUT HAD PROBLEMS WITH THE CGI IMPLEMENTING TWO SCRIPTS ON ONE HTML FORM
 

# my($longorf1,$longorf2,$longorf3,$longorf4,$longorf5,$longorf6)=@ARGV;
 

#Transfer Open Reading Frames over to ProteinDigest

# system './proteindigest.pl', $longorf1,$longorf2,$longorf3,$longorf4,$longorf5,$longorf6;
 

# Initialise second program variables

my $orfprotein1 = '';

my $orfprotein2 = '';

my $orfprotein3 = '';

my $orfprotein4 = '';

my $orfprotein5 = '';

my $orfprotein6 = '';

my $codon;
 

# Convert DNA sequence to Protein sequence - Translate each three base

# codon into an amino acid, and append to the protein
 

for(my $i=0; $i < (length($longorf1) -2) ; $i += 3) {

$codon = substr($longorf1,$i,3);

$orfprotein1 .= codon2aa($codon);

}
 

for(my $i=0; $i < (length($longorf2) -2) ; $i += 3) {

$codon = substr($longorf2,$i,3);

$orfprotein2 .= codon2aa($codon);

}
 

for(my $i=0; $i < (length($longorf3) -2) ; $i += 3) {

$codon = substr($longorf3,$i,3);

$orfprotein3 .= codon2aa($codon);

}
 

for(my $i=0; $i < (length($longorf4) -2) ; $i += 3) {

$codon = substr($longorf4,$i,3);

$orfprotein4 .= codon2aa($codon);

}
 

for(my $i=0; $i < (length($longorf5) -2) ; $i += 3) {

$codon = substr($longorf5,$i,3);

$orfprotein5 .= codon2aa($codon);

}
 

for(my $i=0; $i < (length($longorf6) -2) ; $i += 3) {

$codon = substr($longorf6,$i,3);

$orfprotein6 .= codon2aa($codon);

}
 

my $enzyme = $query->param('enzyme');
 

# Select an enzyme from the radio buttons on form

my $re;

if   ($enzyme eq   'TRYPSIN') { $re=qr/(?<=[KR])(?!P)/; }

elsif($enzyme eq 'ENDOPROTL') { $re=qr/(?<=K)(?!P)/; }

elsif($enzyme eq 'ENDOPROTA') { $re=qr/(?<=R)(?!P)/; }

elsif($enzyme eq    'V8PROT') { $re=qr/(?<=E)(?!P)/; }

else {die "Unknown enzyme selection '$enzyme'\n";}
 
 

# To cleave all proteins, and put then in the same array

my @parts;

foreach my $seq ($orfprotein1,$orfprotein2,$orfprotein3,$orfprotein4,$orfprotein5,$orfprotein6) {

    push @parts, split($re, $seq);

}
 

# Now, @parts contains everything
 
 
 

print "<html><body>\n";

print "Reading Frame1:$orfprotein1;<br>\n";

print "Reading Frame2:$orfprotein2;<br>\n";

print "Reading Frame3:$orfprotein3;<br>\n";

print "Reading Frame4:$orfprotein4;<br>\n";

print "Reading Frame5:$orfprotein5;<br>\n";

print "Reading Frame6:$orfprotein6;<br><br><br>\n";

print "List of protein cleavage fragments, cleaved with the enzyme $enzyme;<br><br><br>\n";

print join("<br>\n", @parts) . "<br>\n";

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

Open in new window

0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24398783
See above, I combined into 2 files and tested with upload file as well as textbox. You must save the 1st file under DNALib.pm in the same directory.
0
 

Author Comment

by:StephenMcGowan
ID: 24399000
Thanks mrjoltcola! it works a charm! how was I with my perl programming? this is my first real encounter with perl, so i'm really just starting out!
Was there much work involved in patching up the original script? what exactly was wrong with it?

Thanks alot again for all of your time, effort and mainly patience!

Thanks!
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24399038
You are welcome.

Since you asked, a few of things I found.

1) There were re-defined variables in one pl module that were already defined in the main module (example :  my $query = new CGI;)
2) There was a typo, in 1 place there was @file_data and other place @filedata (misname)

3) Also, there is no need to "use strict, .etc" inside each function just do it once at the top of the script.

But the main problem, with the form upload, was the lack of the enctype in the form tab (multipart/form-data)

<form id='form1' name='form1' method='post' action='ORFfinder.pl' enctype="multipart/form-data">


Other than that, not bad for a beginner. I hope I wasn't too hard on you :)
0
 
LVL 40

Expert Comment

by:mrjoltcola
ID: 24399045
I meant "form tag"
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now