]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/BGB/Track.pm
layout of wiggle improved
[biopieces.git] / code_perl / Maasha / BGB / Track.pm
index 071c284a32d838962dad531f43a788fa95b787b6..5322636b7980faa62c12bc11f46c43d8179821fd 100644 (file)
@@ -37,11 +37,26 @@ use Maasha::Filesys;
 use Maasha::KISS;
 use Maasha::Biopieces;
 use Maasha::Seq;
+use Maasha::BGB::Wiggle;
 
 use vars qw( @ISA @EXPORT );
 
 @ISA = qw( Exporter );
 
+use constant {
+    S_ID             => 0,
+    S_BEG            => 1,
+    S_END            => 2,
+    Q_ID             => 3,
+    SCORE            => 4,
+    STRAND           => 5,
+    HITS             => 6,
+    ALIGN            => 7,
+    BLOCK_COUNT      => 8,
+    BLOCK_BEGS       => 9,
+    BLOCK_LENS       => 10,
+    BLOCK_TYPE       => 11,
+};
 
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
@@ -62,7 +77,7 @@ sub track_ruler
 
     $beg    = $cookie->{ 'NAV_START' };
     $end    = $cookie->{ 'NAV_END' };
-    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
     
     $step = 10;
 
@@ -152,54 +167,138 @@ sub track_feature
 {
     # Martin A. Hansen, November 2009.
 
-    # Create a track with features. If there are more than $cookie->FEAT_MAX 
-    # features the track created will be a histogram, else linear.
-
-    my ( $track,    # path to kiss file with track data
+    my ( $track,    # path to track data
          $cookie,   # cookie hash
        ) = @_;
 
     # Returns a list.
 
-    my ( $index, $count, $track_name, $start, $end, $entries, $features );
-
-    $start = $cookie->{ 'NAV_START' };
-    $end   = $cookie->{ 'NAV_END' };
-
-    $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
-    $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
+    my ( $data_wig, $data_kiss, $track_name, $features );
 
     $track_name = ( split "/", $track )[ -1 ];
     $track_name =~ s/^\d+_//;
     $track_name =~ s/_/ /g;
 
-    $features = [ {
+    push @{ $features }, {
         type      => 'text',
         txt       => $track_name,
         font_size => $cookie->{ 'SEQ_FONT_SIZE' },
         color     => $cookie->{ 'SEQ_COLOR' },
         x1        => 0,
         y1        => $cookie->{ 'TRACK_OFFSET' },
-    } ];
+    };
 
     $cookie->{ 'TRACK_OFFSET' } += 10;
 
-    if ( $count > $cookie->{ 'FEAT_MAX' } )
+    if ( -f "$track/track_data.wig" )
     {
-        $entries  = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
-        push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
-    }  
+        $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } ); 
+
+        push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
+    }
+    elsif ( -f "$track/track_data.kiss" )
+    {
+        $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
+
+        push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
+    }
     else
     {
-        $entries  = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
-        push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
-    }  
+        Maasha::Common::error( "Unknown track data type" );
+    }
 
     return wantarray ? @{ $features } : $features;
 }
 
 
-sub track_feature_linear
+sub track_wiggle
+{
+    # Martin A. Hansen, February 2010.
+
+    # Create a wiggle track.
+
+    my ( $cookie,    # hashref with image draw metrics
+         $beg,       # base window beg
+         $end,       # base window end
+         $vals,      # wiggle values
+       ) = @_;
+
+    # Returns a list.
+
+    my ( $i, $max_val, $min_val, $factor, $factor_height, $x1, $y1, $x2, $y2, $block_max, $mean, @features );
+
+    $cookie->{ 'TRACK_OFFSET' } += 10;
+
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
+
+    ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
+
+    if ( $max_val == 0 ) {
+        $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / 1;
+    } else {
+        $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / $max_val;
+    }
+
+    $block_max = 0;
+
+    $x1 = 0;
+    $y1 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
+
+    for ( $i = 0; $i < scalar @{ $vals }; $i++ )
+    {
+        $block_max = Maasha::Calc::max( $block_max, $vals->[ $i ] );
+
+        $x2 = int( $i * $factor );
+
+        if ( $x2 > $x1 )
+        {
+            $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' } - sprintf( "%.0f", $block_max * $factor_height );
+
+            push @features, {
+                type       => 'wiggle',
+                color      => $cookie->{ 'FEAT_COLOR' },
+                line_width => 1,
+                x1         => $x1,
+                y1         => $y1,
+                x2         => $x2,
+                y2         => $y2,
+            };
+
+            $x1 = $x2;
+            $y1 = $y2;
+
+            $block_max = 0;
+        }
+    }
+
+    $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
+
+    push @features, {
+        type       => 'wiggle',
+        color      => $cookie->{ 'FEAT_COLOR' },
+        line_width => 1,
+        x1         => $x1,
+        y1         => $y1,
+        x2         => $x2,
+        y2         => $y2,
+    };
+
+    unshift @features, {
+        type      => 'text',
+        txt       => "  min: " . Maasha::Calc::commify( $min_val ) . " max: " . Maasha::Calc::commify( $max_val ),
+        font_size => $cookie->{ 'SEQ_FONT_SIZE' } - 2,
+        color     => $cookie->{ 'SEQ_COLOR' },
+        x1        => 0,
+        y1        => $cookie->{ 'TRACK_OFFSET' } - 5,
+    };
+
+    $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'WIGGLE_HEIGHT' } + $cookie->{ 'TRACK_SPACE' };
+
+    return wantarray ? @features : \@features;
+}
+
+
+sub track_linear
 {
     # Martin A. Hansen, November 2009.
 
@@ -214,46 +313,51 @@ sub track_feature_linear
 
     # Returns a list.
     
-    my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
+    my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
 
-    @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $b->{ 'S_END' } <=> $a->{ 'S_END' } } @{ $entries };
-
-    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
     $y_step = 0;
     $y_max  = 0;
 
     foreach $entry ( @{ $entries } )
     {
-        $w = sprintf( "%.0f", ( $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1 ) * $factor );
+        $w = sprintf( "%.0f", ( $entry->[ S_END ] - $entry->[ S_BEG ] + 1 ) * $factor );
 
         if ( $w >= 1 )
         {
-            $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
+            $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor );
 
             for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
                 last if $x1 >= $ladder[ $y_step ] + 1; 
             }
 
-            $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
+            $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
 
-            push @features, {
-                type       => 'rect',
+            $feature = {
                 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' }",
-                q_id       => $entry->{ 'Q_ID' },
-                s_beg      => $entry->{ 'S_BEG' },
-                s_end      => $entry->{ 'S_END' },
-                strand     => $entry->{ 'STRAND' },
+                title      => "Q_ID: $entry->[ Q_ID ] S_BEG: $entry->[ S_BEG ] S_END: $entry->[ S_END ]",
+                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,
                 y2         => $y1 + $cookie->{ 'FEAT_WIDTH' },
             };
 
-            $y_max = Maasha::Calc::max( $y_max, $y_step * ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) );
+            if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
+                $feature->{ 'type' } = 'arrow';
+            } else {
+                $feature->{ 'type' } = 'rect';
+            }
+
+            push @features, $feature;
+
+            $y_max = Maasha::Calc::max( $y_max, $y_step * ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) );
 
-            push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.';
+            push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';
 
             $ladder[ $y_step ] = $x1 + $w;
         }
@@ -288,7 +392,7 @@ sub feature_align
 
     if ( $w >= 1 )
     {
-        foreach $align ( split /,/, $entry->{ 'ALIGN' } )
+        foreach $align ( split /,/, $entry->[ ALIGN ] )
         {
             if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
             {
@@ -301,7 +405,7 @@ sub feature_align
                 Maasha::Common::error( qq(BAD align descriptor: "$align") );
             }
 
-            $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } + $pos - $beg ) * $factor );
+            $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] + $pos - $beg ) * $factor );
 
             push @features, {
                 type       => 'rect',
@@ -355,7 +459,7 @@ sub track_feature_histogram
     $hist_height  = 100;   # pixels
     $bucket_width = 5;
     $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
-    $factor       = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
+    $factor       = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min );
 
     $min_bucket = 999999999;
     $max_height = 0;
@@ -545,7 +649,7 @@ sub search_tracks
 
     # Returns a list.
 
-    my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries );
+    my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries, $track_name );
 
     if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
     {
@@ -566,10 +670,15 @@ sub search_tracks
         push @tracks, path_tracks( $cookie );
     }
 
-    @tracks = grep /$search_track/i, @tracks if $search_track;
-
     foreach $track ( @tracks )
     {
+        if ( $search_track )
+        {
+            $track_name = ( split "/", $track )[ -1 ];
+
+            next if $track_name !~ /$search_track/i;
+        }
+
         $file = "$track/track_data.kiss";
       
         if ( -f $file )
@@ -583,7 +692,7 @@ sub search_tracks
                 if ( $line =~ /$search_term/i )
                 {
                     $entry = Maasha::KISS::kiss_entry_parse( $line );
-
+                    $entry = Maasha::KISS::kiss2biopiece( $entry );
                     push @entries, $entry;
                 }
             }
@@ -596,7 +705,443 @@ sub search_tracks
 }
 
 
+sub list_user_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all users directories in the ~/Data/Users
+    # directory with full path.
+
+    # Returns a list.
+
+    my ( @dirs, @users );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users" );
+
+    @users = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @users : \@users;
+}
+
+
+sub list_users
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all users in ~/Data/Users
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @users );
+
+    @dirs = list_user_dir();
+
+    foreach $dir ( @dirs ) {
+        push @users, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @users : \@users;
+}
+
+
+sub list_clade_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all clades for a given user in ~/Data/Users
+
+    my ( $user,   # user for which to return clades
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @dirs, @clades );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user" );
+
+    @clades = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @clades : \@clades;
+}
+
+
+sub list_clades
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all clades for a given user in ~/Data/Users
+
+    my ( $user,   # user for which to return clades
+       ) = @_;
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @clades );
+
+    @dirs = list_clade_dir( $user );
+
+    foreach $dir ( @dirs ) {
+        push @clades, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @clades : \@clades;
+}
+
+
+sub list_genome_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all genomes for a given user and clade in ~/Data/Users
+
+    my ( $user,    # user for which to return genomes
+         $clade,   # clade for which to return genomes
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @dirs, @genomes );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade" );
+
+    @genomes = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @genomes : \@genomes;
+}
+
+
+sub list_genomes
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all genomes for a given user and clade in ~/Data/Users
+
+    my ( $user,    # user for which to return genomes
+         $clade,   # clade for which to return genomes
+       ) = @_;
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @genomes );
+
+    @dirs = list_genome_dir( $user, $clade );
+
+    foreach $dir ( @dirs ) {
+        push @genomes, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @genomes : \@genomes;
+}
+
+
+sub list_assembly_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all assemblies for a given user and clade and genome in ~/Data/Users
+
+    my ( $user,     # user for which to return assemblies
+         $clade,    # clade for which to return assemblies
+         $genome,   # genome for which to return assemblies
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @dirs, @assemblies );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
+
+    @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @assemblies : \@assemblies;
+}
+
+
+sub list_assemblies
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all assemblies for a given user and clade and genome in ~/Data/Users
+
+    my ( $user,     # user for which to return assemblies
+         $clade,    # clade for which to return assemblies
+         $genome,   # genome for which to return assemblies
+       ) = @_;
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @assemblies );
+
+    @dirs = list_assembly_dir( $user, $clade, $genome );
+
+    foreach $dir ( @dirs ) {
+        push @assemblies, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @assemblies : \@assemblies;
+}
+
+
+sub list_contig_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all assemblies for a given user->clade->genome->assembly in ~/Data/Users
+
+    my ( $user,       # user for which to return contigs
+         $clade,      # clade for which to return contigs
+         $genome,     # genome for which to return contigs
+         $assembly,   # assembly for which to return contigs
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @dirs, @contigs );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
+
+    @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @contigs : \@contigs;
+}
+
+
+sub list_contigs
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all contigs for a given user->clade->genome->assembly in ~/Data/Users
+
+    my ( $user,       # user for which to return contigs
+         $clade,      # clade for which to return contigs
+         $genome,     # genome for which to return contigs
+         $assembly,   # assembly for which to return contigs
+       ) = @_;
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @contigs );
+
+    @dirs = list_contig_dir( $user, $clade, $genome, $assembly );
+
+    foreach $dir ( @dirs ) {
+        push @contigs, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @contigs : \@contigs;
+}
+
+
+sub list_track_dir
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
+
+    my ( $user,       # user for which to return tracks
+         $clade,      # clade for which to return tracks
+         $genome,     # genome for which to return tracks
+         $assembly,   # assembly for which to return tracks
+         $contig,     # contig for which to return tracks
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @dirs, @tracks );
+
+    Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
+
+    if ( -d "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" ) {
+        @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" );
+    }
+
+    @tracks = grep { $_ !~ /\/\.\.?$/ } @dirs;
+
+    return wantarray ? @tracks : \@tracks;
+}
+
+
+sub list_tracks
+{
+    # Martin A. Hansen, December 2009.
+
+    # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
+
+    my ( $user,       # user for which to return tracks
+         $clade,      # clade for which to return tracks
+         $genome,     # genome for which to return tracks
+         $assembly,   # assembly for which to return tracks
+         $contig,     # contig for which to return tracks
+       ) = @_;
+
+    # Returns a list.
+    
+    my ( @dirs, $dir, @tracks );
+
+    @dirs = list_track_dir( $user, $clade, $genome, $assembly, $contig );
+
+    foreach $dir ( @dirs ) {
+        push @tracks, ( split "/", $dir )[ -1 ];
+    }
+
+    return wantarray ? @tracks : \@tracks;
+}
+
+
+sub max_track
+{
+    # Martin A. Hansen, December 2009.
+    
+    # Traverses all contigs for a given user->clade->genome->assembly and
+    # returns the maximum track's prefix value eg. 20 for 20_Genbank.
+
+    my ( $user,
+         $clade,
+         $genome,
+         $assembly
+       ) = @_;
+
+    # Returns an integer
+    
+    my ( @contigs, $contig, @tracks, $max );
+
+    @contigs = list_contigs( $user, $clade, $genome, $assembly );
+
+    foreach $contig ( @contigs ) {
+        push @tracks, list_tracks( $user, $clade, $genome, $assembly, $contig );
+    }
+
+    @tracks = sort @tracks;
+
+    if ( scalar @tracks > 0 and $tracks[ -1 ] =~ /^(\d+)/ ) {
+        $max = $1;
+    } else {
+        $max = 0;
+    }
+
+    return $max;
+}
+
+
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 1;
 
+__END__
+
+
+sub search_tracks_nc
+{
+    # Martin A. Hansen, December 2009.
+
+    # Uses grep to search all tracks in all contigs
+    # for a given pattern and return a list of KISS entries.
+
+    my ( $cookie,   # cookie hash
+       ) = @_;
+
+    # Returns a list.
+
+    my ( $search_track, $search_term, $contig, @tracks, $track, $file, @features, $track_name, $nc_list );
+
+    if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
+    {
+        $search_term  = $1;
+        $search_track = $2;
+
+        $search_track =~ tr/ /_/;
+    }
+    else
+    {
+        $search_term = $cookie->{ 'SEARCH' };
+    }
+
+    foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
+    {
+        $cookie->{ 'CONTIG' } = $contig;
+
+        push @tracks, path_tracks( $cookie );
+    }
+
+    foreach $track ( @tracks )
+    {
+        if ( $search_track )
+        {
+            $track_name = ( split "/", $track )[ -1 ];
+
+            next if $track_name !~ /$search_track/i;
+        }
+
+        $file = "$track/track_data.kiss.json";
+      
+        if ( -f $file )
+        {
+            $nc_list  = Maasha::NClist::nc_list_retrieve( $file );
+            push @features, Maasha::NClist::nc_list_search( $nc_list, $search_term, 12 );
+        }
+    }
+
+    return wantarray ? @features : \@features;
+}
+
+
+
+sub track_feature
+{
+    # Martin A. Hansen, November 2009.
+
+    # Create a track with features. If there are more than $cookie->FEAT_MAX 
+    # features the track created will be a histogram, else linear.
+
+    my ( $track,    # path to kiss file with track data
+         $cookie,   # cookie hash
+       ) = @_;
+
+    # Returns a list.
+
+    my ( $index, $count, $track_name, $start, $end, $entries, $features );
+
+    $start = $cookie->{ 'NAV_START' };
+    $end   = $cookie->{ 'NAV_END' };
+
+    $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
+    $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
+
+    $track_name = ( split "/", $track )[ -1 ];
+    $track_name =~ s/^\d+_//;
+    $track_name =~ s/_/ /g;
+
+    $features = [ {
+        type      => 'text',
+        txt       => $track_name,
+        font_size => $cookie->{ 'SEQ_FONT_SIZE' },
+        color     => $cookie->{ 'SEQ_COLOR' },
+        x1        => 0,
+        y1        => $cookie->{ 'TRACK_OFFSET' },
+    } ];
+
+    $cookie->{ 'TRACK_OFFSET' } += 10;
+
+    if ( $count > $cookie->{ 'FEAT_MAX' } )
+    {
+        $entries  = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
+        push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
+    }  
+    else
+    {
+        $entries  = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
+        push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
+    }  
+
+    return wantarray ? @{ $features } : $features;
+}