added dna export to browser

git-svn-id: http://biopieces.googlecode.com/svn/trunk@782 74ccb610-7750-0410-82ae-013aeee3265d

diff --git a/code_perl/Maasha/BBrowser/Track.pm b/code_perl/Maasha/BBrowser/Track.pm
index 2d5afed482aa55da873781a2fccf0db48f12c8cb..d572854d2567085cc549fcfbae780b62652f32be 100644 (file)
--- a/code_perl/Maasha/BBrowser/Track.pm
+++ b/code_perl/Maasha/BBrowser/Track.pm
@@ -35,6 +35,7 @@ use Maasha::Common;
 use Maasha::Calc;
 use Maasha::Filesys;
 use Maasha::KISS;
+use Maasha::Seq;
 
 use vars qw( @ISA @EXPORT );
 
@@ -235,7 +236,10 @@ sub track_feature_linear
                 line_width => $cookie->{ 'FEAT_WIDTH' },
                 color      => $cookie->{ 'FEAT_COLOR' },
                 title      => "Q_ID: $entry->{ 'Q_ID' } S_BEG: $entry->{ 'S_BEG' } S_END: $entry->{ 'S_END' } STRAND: $entry->{ 'STRAND' }",
-                id         => $entry->{ 'Q_ID' },
+                q_id       => $entry->{ 'Q_ID' },
+                s_beg      => $entry->{ 'S_BEG' },
+                s_end      => $entry->{ 'S_END' },
+                strand     => $entry->{ 'STRAND' },
                 x1         => $x1,
                 y1         => $y1,
                 x2         => $x1 + $w,
@@ -403,6 +407,43 @@ sub track_feature_histogram
 }
 
 
+sub dna_get
+{
+    # Martin A. Hansen, November 2009.
+
+    # Returns the sequence from the contig in the beg/end interval
+    # contained in the cookie.
+
+    my ( $cookie,   # cookie hash
+       ) = @_;
+
+    # Returns a string.
+
+    my ( $path, $fh, $beg, $end, $len, $dna );
+
+    $path = path_seq( $cookie );
+
+    $beg = $cookie->{ 'S_BEG' };
+    $end = $cookie->{ 'S_END' };
+    $beg =~ tr/,//d;
+    $end =~ tr/,//d;
+    $len = $end - $beg + 1;
+
+
+    $fh = Maasha::Filesys::file_read_open( $path );
+
+    $dna = Maasha::Filesys::file_read( $fh, $beg, $len );
+
+    $dna = Maasha::Seq::dna_revcomp( $dna ) if $cookie->{ 'STRAND' } eq '-';
+    
+    Maasha::Seq::wrap( \$dna, 100 );
+
+    close $fh;
+
+    return $dna;
+}
+
+
 sub path_seq
 {
     # Martin A. Hansen, November 2009.

diff --git a/www/index.cgi b/www/index.cgi
index 38957c3761bd51aba0e3dc4cf186cb64d1dc2a66..038d311a87cad28ff912cd7259d3c97c5f25f852 100755 (executable)
--- a/www/index.cgi
+++ b/www/index.cgi
@@ -59,8 +59,8 @@ push @html, Maasha::XHTML::form_end;
 push @html, Maasha::XHTML::body_end;
 push @html, Maasha::XHTML::html_end;
 
-# push @html, Maasha::XHTML::hdump( $cgi->param );  # DEBUG
-# push @html, Maasha::XHTML::hdump( $cookie );      # DEBUG
+# push @html, Maasha::XHTML::hdump( [ $cgi->Vars ] );  # DEBUG
+# push @html, Maasha::XHTML::hdump( $cookie );     # DEBUG
 
 print "$_\n" foreach @html;
 
@@ -95,6 +95,10 @@ sub cookie_default
     $cookie->{ 'GENOME' }          = $cgi->param( 'genome' )   || '';
     $cookie->{ 'ASSEMBLY' }        = $cgi->param( 'assembly' ) || '';
     $cookie->{ 'CONTIG' }          = $cgi->param( 'contig' )   || '';
+    $cookie->{ 'Q_ID' }            = $cgi->param( 'q_id' );
+    $cookie->{ 'S_BEG' }           = $cgi->param( 's_beg' );
+    $cookie->{ 'S_END' }           = $cgi->param( 's_end' );
+    $cookie->{ 'STRAND' }          = $cgi->param( 'strand' );
     $cookie->{ 'NAV_START' }       = $cgi->param( 'nav_start' );
     $cookie->{ 'NAV_END' }         = $cgi->param( 'nav_end' );
     $cookie->{ 'ZOOM_IN1' }        = $cgi->param( 'zoom_in1' );
@@ -150,6 +154,8 @@ sub cookie_default
         cookie_move( $cookie );
     }
 
+    $cookie->{ 'STRAND' } = '+' if $cookie->{ 'STRAND' } eq ' ';
+
     return wantarray ? %{ $cookie } : $cookie;
 }
 
@@ -373,6 +379,8 @@ sub page
         push @html, page_export( $cookie );
     } elsif ( $cookie->{ 'PAGE' } eq 'browse' ) {
         push @html, page_browse( $cookie );
+    } elsif ( $cookie->{ 'PAGE' } eq 'dna' ) {
+        push @html, page_dna( $cookie );
     } else {
         push @html, page_taxonomy( $cookie );
     }
@@ -422,6 +430,26 @@ sub page_browse
 }
 
 
+sub page_dna
+{
+    # Martin A. Hansen, November 2009.
+    
+    # Renders the DNA page.
+
+    my ( $cookie,
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @html );
+
+    push @html, section_taxonomy_table( $cookie );
+    push @html, section_dna( $cookie );
+
+    return wantarray ? @html : \@html;
+}
+
+
 sub page_taxonomy
 {
     # Martin A. Hansen, November 2009.
@@ -473,7 +501,7 @@ sub section_taxonomy_table
     }
 
     push @html, Maasha::XHTML::table_beg( summary => "Taxonomy table", align => 'center', cellpadding => '5px' );
-    push @html, Maasha::XHTML::table_row_simple( tr => [ join( " ", @row ) ], align => 'center' );
+    push @html, Maasha::XHTML::table_row_simple( tr => [ join( "\n", @row ) ], align => 'center' );
     push @html, Maasha::XHTML::table_end;
 
     return wantarray ? @html : \@html;
@@ -498,7 +526,7 @@ sub section_taxonomy_select
 
     push @html, Maasha::XHTML::h2( txt => "Select $cookie->{ 'PAGE' }", class => 'center' );
 
-    push @html, Maasha::XHTML::table_beg( summary => "Select table", align => 'center', cellpadding => '5px' );
+    push @html, Maasha::XHTML::table_beg( summary => "Taxonomy select table", align => 'center', cellpadding => '5px' );
 
     foreach $item ( @{ $cookie->{ $list } } )
     {
@@ -531,9 +559,9 @@ sub section_navigate
     push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
     push @html, Maasha::XHTML::table_row_simple( tr => [
         "Start:",
-        Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 20 ),
+        Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 15 ),
         "End:",
-        Maasha::XHTML::text( name => "nav_end",   value => Maasha::Calc::commify( $cookie->{ 'NAV_END' } ),   size => 20 ), 
+        Maasha::XHTML::text( name => "nav_end",   value => Maasha::Calc::commify( $cookie->{ 'NAV_END' } ),   size => 15 ), 
         Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ),
     ] );
     push @html, Maasha::XHTML::table_end;
@@ -622,8 +650,10 @@ sub section_browse
         {
             next if $elem->{ 'type' } eq 'text';
 
+            #$elem->{ 'strand' } = '&#43' if $elem->{ 'strand' } eq '+';
+
             push @img, Maasha::XHTML::area(
-                href   => cookie_href( $cookie, "export" ) . "&Q_ID=$elem->{ 'id' }",
+                href   => cookie_href( $cookie, "export" ) . "&q_id=$elem->{ 'q_id' }&s_beg=$elem->{ 's_beg' }&s_end=$elem->{ 's_end' }&strand=$elem->{ 'strand' }",
                 shape  => "rect",
                 coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }",
             );
@@ -651,9 +681,56 @@ sub section_export
 
     # Returns a list.
 
-    my ( @html );
+    my ( @row_dna_contig, @html );
+
+    push @row_dna_contig, Maasha::XHTML::p( txt => qq(Export Feature: "$cookie->{ 'Q_ID' }" DNA from Contig: ), class => 'inline' );
+    push @row_dna_contig, Maasha::XHTML::p( txt  => "$cookie->{ 'CONTIG' } Start: ", class => 'inline' );
+    push @row_dna_contig, Maasha::XHTML::text( name => "s_beg", value => Maasha::Calc::commify( $cookie->{ 'S_BEG' } ), size => 15 );
+    push @row_dna_contig, Maasha::XHTML::p( txt => "End: ", class => 'inline' );
+    push @row_dna_contig, Maasha::XHTML::text( name => "s_end", value => Maasha::Calc::commify( $cookie->{ 'S_END' } ), size => 15 );
+    push @row_dna_contig, Maasha::XHTML::p( txt => "Strand: ", class => 'inline' );
+    push @row_dna_contig, Maasha::XHTML::menu( name => "strand", options => [ qw( + - ) ], selected => $cookie->{ 'STRAND' } );
+    push @row_dna_contig, Maasha::XHTML::submit( name => "export", value => "Export", title => "Fetch DNA from this region" );
+
+    push @html, Maasha::XHTML::h2( txt => "Export", class => 'center' );
+    push @html, Maasha::XHTML::table_beg( summary => "Taxonomy select table", align => 'center' );
+    push @html, Maasha::XHTML::table_row_simple( tr => \@row_dna_contig );
+    push @html, Maasha::XHTML::table_end;
+
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "page", value => "dna" ) );
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "user",     value => "$cookie->{ 'USER' }" ) );
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "clade",    value => "$cookie->{ 'CLADE' }" ) );
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "genome",   value => "$cookie->{ 'GENOME' }" ) );
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "assembly", value => "$cookie->{ 'ASSEMBLY' }" ) );
+    push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "contig",   value => "$cookie->{ 'CONTIG' }" ) );
+
+    return wantarray ? @html : \@html;
+}
+
+
+sub section_dna
+{
+    # Martin A. Hansen, November 2009.
+
+    # Returns a HTML section with extracted DNA.
+
+    my ( $cookie,   # cookie hash
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @html, $beg, $end, $seq );
+    
+    $beg = $cookie->{ 'S_BEG' };
+    $end = $cookie->{ 'S_END' };
+    $beg =~ tr/,//d;
+    $end =~ tr/,//d;
+
+    $seq = ">$cookie->{ 'CONTIG' }_$beg" . "_$end" . "_$cookie->{ 'STRAND' }\n";
+    $seq .= Maasha::BBrowser::Track::dna_get( $cookie );
 
-    push @html, Maasha::XHTML::h2( txt => "Export", class => 'center' );   # TODO section_export!
+    push @html, Maasha::XHTML::h2( txt => "DNA", class => 'center' );
+    push @html, Maasha::XHTML::pre( txt => $seq );
 
     return wantarray ? @html : \@html;
 }