1 package Maasha::BGB::Track;
3 # Copyright (C) 2009 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # Routines for creating Biopieces Browser tracks.
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
39 use Maasha::Biopieces;
41 use Maasha::BGB::Wiggle;
43 use vars qw( @ISA @EXPORT );
45 @ISA = qw( Exporter );
62 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
67 # Martin A. Hansen, March 2010.
69 # Create a grid of vertical lines for the browser image.
71 my ( $cookie, # browser cookie
78 for ( $i = 0; $i < $cookie->{ 'IMG_WIDTH' }; $i += 20 )
83 color => [ 0.82, 0.89, 1 ],
87 y2 => $cookie->{ 'TRACK_OFFSET' },
91 return wantarray ? @grid : \@grid;
97 # Martin A. Hansen, November 2009.
99 # Create a track with a ruler of tics and positions for
100 # the browser window.
102 my ( $cookie, # browser cookie
107 my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
109 $beg = $cookie->{ 'NAV_START' };
110 $end = $cookie->{ 'NAV_END' };
111 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
115 while ( ( $end - $beg ) / $step > 20 ) {
121 while ( $i <= $beg ) {
127 $txt = "|" . Maasha::Calc::commify( $i );
128 $x = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
130 if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
135 font_size => $cookie->{ 'RULER_FONT_SIZE' },
136 color => $cookie->{ 'RULER_COLOR' },
138 y1 => $cookie->{ 'TRACK_OFFSET' },
145 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
147 return wantarray ? @ruler : \@ruler;
153 # Martin A. Hansen, November 2009.
155 # Create a sequence track by extracting the appropriate
156 # stretch of sequence from the sequence file.
158 my ( $cookie, # browser cookie
163 my ( $file, $fh, $seq, @chars, $factor, $x_offset, $i, @seq_list );
165 if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) # only add sequence if less than or equal to 220.
167 $file = path_seq( $cookie );
168 $fh = Maasha::Filesys::file_read_open( $file );
169 $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
172 @chars = split //, $seq;
174 $factor = $cookie->{ 'IMG_WIDTH' } / @chars;
176 $x_offset = sprintf( "%.0f", ( $factor / 2 ) - ( $cookie->{ 'SEQ_FONT_SIZE' } / 2 ) );
177 $x_offset = 0 if $x_offset < 0;
179 for ( $i = 0; $i < @chars; $i++ )
184 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
185 color => $cookie->{ 'SEQ_COLOR' },
186 x1 => sprintf( "%.0f", $x_offset + $i * $factor ),
187 y1 => $cookie->{ 'TRACK_OFFSET' },
191 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
193 return wantarray ? @seq_list : \@seq_list;
204 # Martin A. Hansen, November 2009.
206 my ( $track, # path to track data
207 $cookie, # cookie hash
212 my ( $data_wig, $data_kiss, $track_pretty, $track_name, $features, $color );
214 $track_name = ( split "/", $track )[ -1 ];
216 $track_pretty = $track_name;
217 $track_pretty =~ s/^\d+_//;
218 $track_pretty =~ s/_/ /g;
220 if ( track_hide( $cookie, $track_name ) ) {
221 $color = [ 0.6, 0.6, 0.6 ];
223 $color = $cookie->{ 'SEQ_COLOR' };
226 push @{ $features }, {
227 type => 'track_name',
228 track => $track_name,
229 txt => $track_pretty,
230 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
233 y1 => $cookie->{ 'TRACK_OFFSET' },
236 $cookie->{ 'TRACK_OFFSET' } += 10;
238 if ( not track_hide( $cookie, $track_name ) )
240 if ( -f "$track/track_data.wig" )
242 $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
244 push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
246 elsif ( -f "$track/track_data.kiss" )
248 $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
250 push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
254 Maasha::Common::error( "Unknown track data type" );
258 return wantarray ? @{ $features } : $features;
264 # Martin A. Hansen, February 2010.
266 # Create a wiggle track.
268 my ( $cookie, # hashref with image draw metrics
269 $beg, # base window beg
270 $end, # base window end
271 $vals, # wiggle values
276 my ( $i, $max_val, $min_val, $factor, $factor_height, $x1, $y1, $x2, $y2, $block_max, $mean, @features );
278 $cookie->{ 'TRACK_OFFSET' } += 10;
280 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
282 ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
284 if ( $max_val == 0 ) {
285 $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / 1;
287 $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / $max_val;
293 $y1 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
295 for ( $i = 0; $i < scalar @{ $vals }; $i++ )
297 $block_max = Maasha::Calc::max( $block_max, $vals->[ $i ] );
299 $x2 = int( $i * $factor );
303 $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' } - sprintf( "%.0f", $block_max * $factor_height );
307 color => $cookie->{ 'FEAT_COLOR' },
322 $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
326 color => $cookie->{ 'FEAT_COLOR' },
336 txt => " min: " . Maasha::Calc::commify( $min_val ) . " max: " . Maasha::Calc::commify( $max_val ),
337 font_size => $cookie->{ 'SEQ_FONT_SIZE' } - 2,
338 color => $cookie->{ 'SEQ_COLOR' },
340 y1 => $cookie->{ 'TRACK_OFFSET' } - 5,
343 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'WIGGLE_HEIGHT' } + $cookie->{ 'TRACK_SPACE' };
345 return wantarray ? @features : \@features;
351 # Martin A. Hansen, November 2009.
353 # Create a linear feature track where the granularity depends
354 # on the lenght of the features and the browser window width.
356 my ( $cookie, # hashref with image draw metrics
357 $beg, # base window beg
358 $end, # base window end
359 $entries, # list of unsorted KISS entries
364 my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
366 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
370 foreach $entry ( @{ $entries } )
372 $w = sprintf( "%.0f", ( $entry->[ S_END ] - $entry->[ S_BEG ] + 1 ) * $factor );
376 $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor );
379 $x2 = $cookie->{ 'IMG_WIDTH' } if $x2 > $cookie->{ 'IMG_WIDTH' };
381 for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
382 last if $x1 >= $ladder[ $y_step ] + 1;
385 $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
386 $y2 = $y1 + $cookie->{ 'FEAT_WIDTH' };
389 line_width => $cookie->{ 'FEAT_WIDTH' },
390 color => $cookie->{ 'FEAT_COLOR' },
391 title => "Q_ID: $entry->[ Q_ID ] S_BEG: $entry->[ S_BEG ] S_END: $entry->[ S_END ]",
392 q_id => $entry->[ Q_ID ],
393 s_beg => $entry->[ S_BEG ],
394 s_end => $entry->[ S_END ],
395 strand => $entry->[ STRAND ],
402 if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
403 $feature->{ 'type' } = 'arrow';
405 $feature->{ 'type' } = 'rect';
408 push @features, $feature;
410 $y_max = Maasha::Calc::max( $y_max, $y_step * ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) );
412 push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';
414 # $ladder[ $y_step ] = $x1 + $w;
415 $ladder[ $y_step ] = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor ) + $w;
419 $cookie->{ 'TRACK_OFFSET' } += $y_max + $cookie->{ 'TRACK_SPACE' };
421 return wantarray ? @features : \@features;
427 # Martin A. Hansen, November 2009.
429 # Add to feature track alignment info if the granularity is
431 # TODO: The printing of chars is imprecise.
433 my ( $entry, # Partial KISS entry
434 $beg, # base window beg
435 $y_offset, # y axis draw offset
436 $factor, # scale factor
437 $feat_height, # hight of feature in pixels
442 my ( $w, $align, $pos, $nt_before, $nt_after, $x1, @features );
444 $w = sprintf( "%.0f", 1 * $factor );
448 foreach $align ( split /,/, $entry->[ ALIGN ] )
450 if ( $align =~ /(\d+):([ATCGRYKMSWBDHVN-])>([ATCGRYKMSWBDHVN-])/ )
458 Maasha::Common::error( qq(BAD align descriptor: "$align") );
461 $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] + $pos - $beg ) * $factor );
465 line_width => $feat_height,
466 color => [ 1, 0, 0 ],
471 y2 => $y_offset + $feat_height,
474 if ( $w > $feat_height )
478 font_size => $feat_height + 2,
479 color => [ 0, 0, 0 ],
481 x1 => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
482 y1 => $y_offset + $feat_height,
488 return wantarray ? @features : \@features;
492 sub track_feature_histogram
494 # Martin A. Hansen, November 2009.
496 # Create a feature track as a histogram using information
497 # from the index only thus avoiding to load features from the
500 my ( $cookie, # hashref with image draw metrics
501 $min, # minimum base position
502 $max, # maximum base position
503 $blocks, # list of blocks
508 my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
510 return if $max <= $min;
512 $hist_height = 100; # pixels
514 $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
515 $factor = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min );
517 $min_bucket = 999999999;
520 foreach $block ( @{ $blocks } )
522 $bucket_beg = int( $block->{ 'BEG' } * $factor );
523 $bucket_end = int( $block->{ 'END' } * $factor );
525 $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
527 for ( $i = $bucket_beg; $i < $bucket_end; $i++ )
529 $buckets[ $i ] += $block->{ 'COUNT' };
531 $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
535 if ( $max_height > 0 )
537 $factor_heigth = $hist_height / $max_height;
541 for ( $i = $min_bucket; $i < @buckets; $i++ )
543 if ( defined $buckets[ $i ] )
545 $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );
551 line_width => $bucket_width,
552 color => $cookie->{ 'FEAT_COLOR' },
553 title => "Features: $buckets[ $i ]",
555 y1 => $cookie->{ 'TRACK_OFFSET' } + $hist_height,
557 y2 => $cookie->{ 'TRACK_OFFSET' } + $hist_height - $h,
566 $cookie->{ 'TRACK_OFFSET' } += $hist_height + $cookie->{ 'TRACK_SPACE' };
568 return wantarray ? @hist : \@hist;
574 # Martin A. Hansen, November 2009.
576 # Returns the sequence from the contig in the beg/end interval
577 # contained in the cookie.
579 my ( $cookie, # cookie hash
584 my ( $path, $fh, $beg, $end, $len, $dna );
586 $path = path_seq( $cookie );
588 $beg = $cookie->{ 'S_BEG' };
589 $end = $cookie->{ 'S_END' };
592 $len = $end - $beg + 1;
595 $fh = Maasha::Filesys::file_read_open( $path );
597 $dna = Maasha::Filesys::file_read( $fh, $beg, $len );
599 $dna = Maasha::Seq::dna_revcomp( $dna ) if $cookie->{ 'STRAND' } eq '-';
601 Maasha::Seq::wrap( \$dna, 100 );
611 # Martin A. Hansen, November 2009.
613 # Returns the path to the sequence file for a specified
614 # contig as written in the cookie.
616 my ( $cookie, # cookie hash
623 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
624 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
625 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
626 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
627 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
630 $cookie->{ 'DATA_DIR' },
633 $cookie->{ 'CLADE' },
634 $cookie->{ 'GENOME' },
635 $cookie->{ 'ASSEMBLY' },
636 $cookie->{ 'CONTIG' },
641 die qq(ERROR: no such file: "$path".\n) if not -e $path;
649 # Martin A. Hansen, December 2009.
651 # Uses grep to search all tracks in all contigs
652 # for a given pattern and return a list of KISS entries.
654 my ( $cookie, # cookie hash
659 my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries, $track_name );
661 if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
666 $search_track =~ tr/ /_/;
670 $search_term = $cookie->{ 'SEARCH' };
673 foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
675 $cookie->{ 'CONTIG' } = $contig;
677 push @tracks, list_track_dir( $cookie->{ 'USER' }, $cookie->{ 'CLADE' }, $cookie->{ 'GENOME' }, $cookie->{ 'ASSEMBLY' }, $cookie->{ 'CONTIG' } );
680 foreach $track ( @tracks )
684 $track_name = ( split "/", $track )[ -1 ];
686 next if $track_name !~ /$search_track/i;
689 $file = "$track/track_data.kiss";
693 $fh = Maasha::Filesys::file_read_open( $file );
695 while ( $line = <$fh> )
699 if ( $line =~ /$search_term/i )
701 $entry = Maasha::KISS::kiss_entry_parse( $line );
702 $entry = Maasha::KISS::kiss2biopiece( $entry );
703 push @entries, $entry;
711 return wantarray ? @entries : \@entries;
717 # Martin A. Hansen, December 2009.
719 # List all users directories in the ~/Data/Users
720 # directory with full path.
724 my ( @dirs, @users );
726 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
728 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users" );
730 @users = grep { $_ !~ /\/\.\.?$/ } @dirs;
732 return wantarray ? @users : \@users;
738 # Martin A. Hansen, December 2009.
740 # List all users in ~/Data/Users
744 my ( @dirs, $dir, @users );
746 @dirs = list_user_dir();
748 foreach $dir ( @dirs ) {
749 push @users, ( split "/", $dir )[ -1 ];
752 return wantarray ? @users : \@users;
758 # Martin A. Hansen, December 2009.
760 # List all clades for a given user in ~/Data/Users
762 my ( $user, # user for which to return clades
767 my ( @dirs, @clades );
769 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
771 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user" );
773 @clades = grep { $_ !~ /\/\.\.?$/ } @dirs;
775 return wantarray ? @clades : \@clades;
781 # Martin A. Hansen, December 2009.
783 # List all clades for a given user in ~/Data/Users
785 my ( $user, # user for which to return clades
790 my ( @dirs, $dir, @clades );
792 @dirs = list_clade_dir( $user );
794 foreach $dir ( @dirs ) {
795 push @clades, ( split "/", $dir )[ -1 ];
798 return wantarray ? @clades : \@clades;
804 # Martin A. Hansen, December 2009.
806 # List all genomes for a given user and clade in ~/Data/Users
808 my ( $user, # user for which to return genomes
809 $clade, # clade for which to return genomes
814 my ( @dirs, @genomes );
816 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
818 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade" );
820 @genomes = grep { $_ !~ /\/\.\.?$/ } @dirs;
822 return wantarray ? @genomes : \@genomes;
828 # Martin A. Hansen, December 2009.
830 # List all genomes for a given user and clade in ~/Data/Users
832 my ( $user, # user for which to return genomes
833 $clade, # clade for which to return genomes
838 my ( @dirs, $dir, @genomes );
840 @dirs = list_genome_dir( $user, $clade );
842 foreach $dir ( @dirs ) {
843 push @genomes, ( split "/", $dir )[ -1 ];
846 return wantarray ? @genomes : \@genomes;
850 sub list_assembly_dir
852 # Martin A. Hansen, December 2009.
854 # List all assemblies for a given user and clade and genome in ~/Data/Users
856 my ( $user, # user for which to return assemblies
857 $clade, # clade for which to return assemblies
858 $genome, # genome for which to return assemblies
863 my ( @dirs, @assemblies );
865 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
867 if ( $user and $clade and $genome ) {
868 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
871 @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
873 return wantarray ? @assemblies : \@assemblies;
879 # Martin A. Hansen, December 2009.
881 # List all assemblies for a given user and clade and genome in ~/Data/Users
883 my ( $user, # user for which to return assemblies
884 $clade, # clade for which to return assemblies
885 $genome, # genome for which to return assemblies
890 my ( @dirs, $dir, @assemblies );
892 @dirs = list_assembly_dir( $user, $clade, $genome );
894 foreach $dir ( @dirs ) {
895 push @assemblies, ( split "/", $dir )[ -1 ];
898 return wantarray ? @assemblies : \@assemblies;
904 # Martin A. Hansen, December 2009.
906 # List all assemblies for a given user->clade->genome->assembly in ~/Data/Users
908 my ( $user, # user for which to return contigs
909 $clade, # clade for which to return contigs
910 $genome, # genome for which to return contigs
911 $assembly, # assembly for which to return contigs
916 my ( @dirs, @contigs );
918 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
920 if ( $user and $clade and $genome and $assembly ) {
921 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
924 @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
926 return wantarray ? @contigs : \@contigs;
932 # Martin A. Hansen, December 2009.
934 # List all contigs for a given user->clade->genome->assembly in ~/Data/Users
936 my ( $user, # user for which to return contigs
937 $clade, # clade for which to return contigs
938 $genome, # genome for which to return contigs
939 $assembly, # assembly for which to return contigs
944 my ( @dirs, $dir, @contigs );
946 @dirs = list_contig_dir( $user, $clade, $genome, $assembly );
948 foreach $dir ( @dirs ) {
949 push @contigs, ( split "/", $dir )[ -1 ];
952 return wantarray ? @contigs : \@contigs;
958 # Martin A. Hansen, December 2009.
960 # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
962 my ( $user, # user for which to return tracks
963 $clade, # clade for which to return tracks
964 $genome, # genome for which to return tracks
965 $assembly, # assembly for which to return tracks
966 $contig, # contig for which to return tracks
971 my ( @dirs, @tracks );
973 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
975 if ( -d "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" ) {
976 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" );
979 @tracks = grep { $_ !~ /\/\.\.?$/ } @dirs;
981 return wantarray ? @tracks : \@tracks;
987 # Martin A. Hansen, December 2009.
989 # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
991 my ( $user, # user for which to return tracks
992 $clade, # clade for which to return tracks
993 $genome, # genome for which to return tracks
994 $assembly, # assembly for which to return tracks
995 $contig, # contig for which to return tracks
1000 my ( @dirs, $dir, @tracks );
1002 @dirs = list_track_dir( $user, $clade, $genome, $assembly, $contig );
1004 foreach $dir ( @dirs ) {
1005 push @tracks, ( split "/", $dir )[ -1 ];
1008 return wantarray ? @tracks : \@tracks;
1014 # Martin A. Hansen, December 2009.
1016 # Traverses all contigs for a given user->clade->genome->assembly and
1017 # returns the maximum track's prefix value eg. 20 for 20_Genbank.
1025 # Returns an integer
1027 my ( @contigs, $contig, @tracks, $max );
1029 @contigs = list_contigs( $user, $clade, $genome, $assembly );
1031 foreach $contig ( @contigs ) {
1032 push @tracks, list_tracks( $user, $clade, $genome, $assembly, $contig );
1035 @tracks = sort @tracks;
1037 if ( scalar @tracks > 0 and $tracks[ -1 ] =~ /^(\d+)/ ) {
1049 # Martin A. Hansen, March 2010.
1051 # Check cookie information to see if a given track
1052 # should be hidden or not.
1054 my ( $cookie, # cookie hash
1055 $track, # track name
1060 my ( $clade, $genome, $assembly );
1062 $clade = $cookie->{ 'CLADE' };
1063 $genome = $cookie->{ 'GENOME' };
1064 $assembly = $cookie->{ 'ASSEMBLY' };
1066 if ( exists $cookie->{ 'TRACK_STATUS' }->{ $clade }->{ $genome }->{ $assembly }->{ $track } and
1067 $cookie->{ 'TRACK_STATUS' }->{ $clade }->{ $genome }->{ $assembly }->{ $track } )
1076 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1083 sub search_tracks_nc
1085 # Martin A. Hansen, December 2009.
1087 # Uses grep to search all tracks in all contigs
1088 # for a given pattern and return a list of KISS entries.
1090 my ( $cookie, # cookie hash
1095 my ( $search_track, $search_term, $contig, @tracks, $track, $file, @features, $track_name, $nc_list );
1097 if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
1102 $search_track =~ tr/ /_/;
1106 $search_term = $cookie->{ 'SEARCH' };
1109 foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
1111 $cookie->{ 'CONTIG' } = $contig;
1113 push @tracks, list_track_dir( $cookie->{ 'USER' }, $cookie->{ 'CLADE' }, $cookie->{ 'GENOME' }, $cookie->{ 'ASSEMBLY' }, $cookie->{ 'CONTIG' } );
1116 foreach $track ( @tracks )
1118 if ( $search_track )
1120 $track_name = ( split "/", $track )[ -1 ];
1122 next if $track_name !~ /$search_track/i;
1125 $file = "$track/track_data.kiss.json";
1129 $nc_list = Maasha::NClist::nc_list_retrieve( $file );
1130 push @features, Maasha::NClist::nc_list_search( $nc_list, $search_term, 12 );
1134 return wantarray ? @features : \@features;
1141 # Martin A. Hansen, November 2009.
1143 # Create a track with features. If there are more than $cookie->FEAT_MAX
1144 # features the track created will be a histogram, else linear.
1146 my ( $track, # path to kiss file with track data
1147 $cookie, # cookie hash
1152 my ( $index, $count, $track_name, $start, $end, $entries, $features );
1154 $start = $cookie->{ 'NAV_START' };
1155 $end = $cookie->{ 'NAV_END' };
1157 $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
1158 $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
1160 $track_name = ( split "/", $track )[ -1 ];
1161 $track_name =~ s/^\d+_//;
1162 $track_name =~ s/_/ /g;
1167 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
1168 color => $cookie->{ 'SEQ_COLOR' },
1170 y1 => $cookie->{ 'TRACK_OFFSET' },
1173 $cookie->{ 'TRACK_OFFSET' } += 10;
1175 if ( $count > $cookie->{ 'FEAT_MAX' } )
1177 $entries = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
1178 push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
1182 $entries = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
1183 push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
1186 return wantarray ? @{ $features } : $features;
1190 my $t0 = Time::HiRes::gettimeofday();
1191 my $t1 = Time::HiRes::gettimeofday(); print STDERR "Time: " . ( $t1 - $t0 ) . "\n";