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 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
38 use Maasha::Biopieces;
40 use Maasha::BGB::Wiggle;
42 use vars qw( @ISA @EXPORT );
44 @ISA = qw( Exporter );
61 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
66 # Martin A. Hansen, November 2009.
68 # Create a track with a ruler of tics and positions for
71 my ( $cookie, # browser cookie
76 my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
78 $beg = $cookie->{ 'NAV_START' };
79 $end = $cookie->{ 'NAV_END' };
80 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
84 while ( ( $end - $beg ) / $step > 20 ) {
88 for ( $i = $beg; $i < $end; $i++ )
90 if ( ( $i % $step ) == 0 )
92 $txt = "|" . Maasha::Calc::commify( $i );
93 $x = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
95 if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
100 font_size => $cookie->{ 'RULER_FONT_SIZE' },
101 color => $cookie->{ 'RULER_COLOR' },
103 y1 => $cookie->{ 'TRACK_OFFSET' },
109 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
111 return wantarray ? @ruler : \@ruler;
117 # Martin A. Hansen, November 2009.
119 # Create a sequence track by extracting the appropriate
120 # stretch of sequence from the sequence file.
122 my ( $cookie, # browser cookie
127 my ( $file, $fh, $seq, @chars, $factor, $x_offset, $i, @seq_list );
129 if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) # only add sequence if less than or equal to 220.
131 $file = path_seq( $cookie );
132 $fh = Maasha::Filesys::file_read_open( $file );
133 $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
136 @chars = split //, $seq;
138 $factor = $cookie->{ 'IMG_WIDTH' } / @chars;
140 $x_offset = sprintf( "%.0f", ( $factor / 2 ) - ( $cookie->{ 'SEQ_FONT_SIZE' } / 2 ) );
141 $x_offset = 0 if $x_offset < 0;
143 for ( $i = 0; $i < @chars; $i++ )
148 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
149 color => $cookie->{ 'SEQ_COLOR' },
150 x1 => sprintf( "%.0f", $x_offset + $i * $factor ),
151 y1 => $cookie->{ 'TRACK_OFFSET' },
155 $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
157 return wantarray ? @seq_list : \@seq_list;
168 # Martin A. Hansen, November 2009.
170 my ( $track, # path to track data
171 $cookie, # cookie hash
176 my ( $data_wig, $data_kiss, $track_name, $features );
178 $track_name = ( split "/", $track )[ -1 ];
179 $track_name =~ s/^\d+_//;
180 $track_name =~ s/_/ /g;
182 push @{ $features }, {
185 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
186 color => $cookie->{ 'SEQ_COLOR' },
188 y1 => $cookie->{ 'TRACK_OFFSET' },
191 $cookie->{ 'TRACK_OFFSET' } += 10;
193 if ( -f "$track/track_data.wig" )
195 $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
197 push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
199 elsif ( -f "$track/track_data.kiss" )
201 $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
203 push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
207 Maasha::Common::error( "Unknown track data type" );
210 return wantarray ? @{ $features } : $features;
216 # Martin A. Hansen, February 2010.
218 # Create a wiggle track.
220 my ( $cookie, # hashref with image draw metrics
221 $beg, # base window beg
222 $end, # base window end
223 $vals, # wiggle values
228 my ( $i, $height, $max_val, $min_val, $max, $factor, $x1, $y1, $x2, $y2, @features );
230 $height = 75; # pixels
232 ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
234 $vals = Maasha::BGB::Wiggle::wiggle_normalize( $vals, $cookie->{ 'IMG_WIDTH' } );
236 $max = Maasha::Calc::list_max( $vals );
238 $factor = $height / $max;
241 $y1 = $cookie->{ 'TRACK_OFFSET' } + $height;
243 for ( $i = 0; $i < scalar @{ $vals }; $i++ )
246 $y2 = $cookie->{ 'TRACK_OFFSET' } + $height - sprintf( "%.0f", $vals->[ $i ] * $factor );
250 color => $cookie->{ 'FEAT_COLOR' },
263 $y2 = $cookie->{ 'TRACK_OFFSET' } + $height;
267 color => $cookie->{ 'FEAT_COLOR' },
277 txt => " min: " . Maasha::Calc::commify( $min_val ) . " max: " . Maasha::Calc::commify( $max_val ),
278 font_size => $cookie->{ 'SEQ_FONT_SIZE' } - 2,
279 color => $cookie->{ 'SEQ_COLOR' },
281 y1 => $cookie->{ 'TRACK_OFFSET' },
284 $cookie->{ 'TRACK_OFFSET' } += $height + $cookie->{ 'TRACK_SPACE' };
286 return wantarray ? @features : \@features;
292 # Martin A. Hansen, November 2009.
294 # Create a linear feature track where the granularity depends
295 # on the lenght of the features and the browser window width.
297 my ( $cookie, # hashref with image draw metrics
298 $beg, # base window beg
299 $end, # base window end
300 $entries, # list of unsorted KISS entries
305 my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
307 $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
311 foreach $entry ( @{ $entries } )
313 $w = sprintf( "%.0f", ( $entry->[ S_END ] - $entry->[ S_BEG ] + 1 ) * $factor );
317 $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor );
319 for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
320 last if $x1 >= $ladder[ $y_step ] + 1;
323 $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
326 line_width => $cookie->{ 'FEAT_WIDTH' },
327 color => $cookie->{ 'FEAT_COLOR' },
328 title => "Q_ID: $entry->[ Q_ID ] S_BEG: $entry->[ S_BEG ] S_END: $entry->[ S_END ]",
329 q_id => $entry->[ Q_ID ],
330 s_beg => $entry->[ S_BEG ],
331 s_end => $entry->[ S_END ],
332 strand => $entry->[ STRAND ],
336 y2 => $y1 + $cookie->{ 'FEAT_WIDTH' },
339 if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
340 $feature->{ 'type' } = 'arrow';
342 $feature->{ 'type' } = 'rect';
345 push @features, $feature;
347 $y_max = Maasha::Calc::max( $y_max, $y_step * ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) );
349 push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';
351 $ladder[ $y_step ] = $x1 + $w;
355 $cookie->{ 'TRACK_OFFSET' } += $y_max + $cookie->{ 'TRACK_SPACE' };
357 return wantarray ? @features : \@features;
363 # Martin A. Hansen, November 2009.
365 # Add to feature track alignment info if the granularity is
367 # TODO: The printing of chars is imprecise.
369 my ( $entry, # Partial KISS entry
370 $beg, # base window beg
371 $y_offset, # y axis draw offset
372 $factor, # scale factor
373 $feat_height, # hight of feature in pixels
378 my ( $w, $align, $pos, $nt_before, $nt_after, $x1, @features );
380 $w = sprintf( "%.0f", 1 * $factor );
384 foreach $align ( split /,/, $entry->[ ALIGN ] )
386 if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
394 Maasha::Common::error( qq(BAD align descriptor: "$align") );
397 $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] + $pos - $beg ) * $factor );
401 line_width => $feat_height,
402 color => [ 1, 0, 0 ],
407 y2 => $y_offset + $feat_height,
410 if ( $w > $feat_height )
414 font_size => $feat_height + 2,
415 color => [ 0, 0, 0 ],
417 x1 => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
418 y1 => $y_offset + $feat_height,
424 return wantarray ? @features : \@features;
428 sub track_feature_histogram
430 # Martin A. Hansen, November 2009.
432 # Create a feature track as a histogram using information
433 # from the index only thus avoiding to load features from the
436 my ( $cookie, # hashref with image draw metrics
437 $min, # minimum base position
438 $max, # maximum base position
439 $blocks, # list of blocks
444 my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
446 return if $max <= $min;
448 $hist_height = 100; # pixels
450 $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
451 $factor = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
453 $min_bucket = 999999999;
456 foreach $block ( @{ $blocks } )
458 $bucket_beg = int( $block->{ 'BEG' } * $factor );
459 $bucket_end = int( $block->{ 'END' } * $factor );
461 $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
463 for ( $i = $bucket_beg; $i < $bucket_end; $i++ )
465 $buckets[ $i ] += $block->{ 'COUNT' };
467 $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
471 if ( $max_height > 0 )
473 $factor_heigth = $hist_height / $max_height;
477 for ( $i = $min_bucket; $i < @buckets; $i++ )
479 if ( defined $buckets[ $i ] )
481 $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );
487 line_width => $bucket_width,
488 color => $cookie->{ 'FEAT_COLOR' },
489 title => "Features: $buckets[ $i ]",
491 y1 => $cookie->{ 'TRACK_OFFSET' } + $hist_height,
493 y2 => $cookie->{ 'TRACK_OFFSET' } + $hist_height - $h,
502 $cookie->{ 'TRACK_OFFSET' } += $hist_height + $cookie->{ 'TRACK_SPACE' };
504 return wantarray ? @hist : \@hist;
510 # Martin A. Hansen, November 2009.
512 # Returns the sequence from the contig in the beg/end interval
513 # contained in the cookie.
515 my ( $cookie, # cookie hash
520 my ( $path, $fh, $beg, $end, $len, $dna );
522 $path = path_seq( $cookie );
524 $beg = $cookie->{ 'S_BEG' };
525 $end = $cookie->{ 'S_END' };
528 $len = $end - $beg + 1;
531 $fh = Maasha::Filesys::file_read_open( $path );
533 $dna = Maasha::Filesys::file_read( $fh, $beg, $len );
535 $dna = Maasha::Seq::dna_revcomp( $dna ) if $cookie->{ 'STRAND' } eq '-';
537 Maasha::Seq::wrap( \$dna, 100 );
547 # Martin A. Hansen, November 2009.
549 # Returns the path to the sequence file for a specified
550 # contig as written in the cookie.
552 my ( $cookie, # cookie hash
559 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
560 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
561 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
562 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
563 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
566 $cookie->{ 'DATA_DIR' },
569 $cookie->{ 'CLADE' },
570 $cookie->{ 'GENOME' },
571 $cookie->{ 'ASSEMBLY' },
572 $cookie->{ 'CONTIG' },
577 die qq(ERROR: no such file: "$path".\n) if not -e $path;
585 # Martin A. Hansen, November 2009.
587 # Returns a list of paths to all tracks for a specified
588 # contig as written in the cookie.
590 my ( $cookie, # cookie path
595 my ( $path, @tracks );
597 die qq(ERROR: no USER in cookie.\n) if not $cookie->{ 'USER' };
598 die qq(ERROR: no CLADE in cookie.\n) if not $cookie->{ 'CLADE' };
599 die qq(ERROR: no GENOME in cookie.\n) if not $cookie->{ 'GENOME' };
600 die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
601 die qq(ERROR: no CONTIG in cookie.\n) if not $cookie->{ 'CONTIG' };
604 $cookie->{ 'DATA_DIR' },
607 $cookie->{ 'CLADE' },
608 $cookie->{ 'GENOME' },
609 $cookie->{ 'ASSEMBLY' },
610 $cookie->{ 'CONTIG' },
616 @tracks = Maasha::Filesys::ls_dirs( $path );
618 @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
620 return wantarray ? @tracks : \@tracks;
624 return wantarray ? () : [];
631 # Martin A. Hansen, December 2009.
633 # Uses grep to search all tracks in all contigs
634 # for a given pattern and return a list of KISS entries.
636 my ( $cookie, # cookie hash
641 my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries, $track_name );
643 if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
648 $search_track =~ tr/ /_/;
652 $search_term = $cookie->{ 'SEARCH' };
655 foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
657 $cookie->{ 'CONTIG' } = $contig;
659 push @tracks, path_tracks( $cookie );
662 foreach $track ( @tracks )
666 $track_name = ( split "/", $track )[ -1 ];
668 next if $track_name !~ /$search_track/i;
671 $file = "$track/track_data.kiss";
675 $fh = Maasha::Filesys::file_read_open( $file );
677 while ( $line = <$fh> )
681 if ( $line =~ /$search_term/i )
683 $entry = Maasha::KISS::kiss_entry_parse( $line );
684 $entry = Maasha::KISS::kiss2biopiece( $entry );
685 push @entries, $entry;
693 return wantarray ? @entries : \@entries;
699 # Martin A. Hansen, December 2009.
701 # List all users directories in the ~/Data/Users
702 # directory with full path.
706 my ( @dirs, @users );
708 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
710 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users" );
712 @users = grep { $_ !~ /\/\.\.?$/ } @dirs;
714 return wantarray ? @users : \@users;
720 # Martin A. Hansen, December 2009.
722 # List all users in ~/Data/Users
726 my ( @dirs, $dir, @users );
728 @dirs = list_user_dir();
730 foreach $dir ( @dirs ) {
731 push @users, ( split "/", $dir )[ -1 ];
734 return wantarray ? @users : \@users;
740 # Martin A. Hansen, December 2009.
742 # List all clades for a given user in ~/Data/Users
744 my ( $user, # user for which to return clades
749 my ( @dirs, @clades );
751 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
752 Maasha::Common::error( 'no user specified' ) if not $user;
754 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user" );
756 @clades = grep { $_ !~ /\/\.\.?$/ } @dirs;
758 return wantarray ? @clades : \@clades;
764 # Martin A. Hansen, December 2009.
766 # List all clades for a given user in ~/Data/Users
768 my ( $user, # user for which to return clades
773 my ( @dirs, $dir, @clades );
775 @dirs = list_clade_dir( $user );
777 foreach $dir ( @dirs ) {
778 push @clades, ( split "/", $dir )[ -1 ];
781 return wantarray ? @clades : \@clades;
787 # Martin A. Hansen, December 2009.
789 # List all genomes for a given user and clade in ~/Data/Users
791 my ( $user, # user for which to return genomes
792 $clade, # clade for which to return genomes
797 my ( @dirs, @genomes );
799 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
800 Maasha::Common::error( 'no user specified' ) if not $user;
801 Maasha::Common::error( 'no clade specified' ) if not $clade;
803 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade" );
805 @genomes = grep { $_ !~ /\/\.\.?$/ } @dirs;
807 return wantarray ? @genomes : \@genomes;
813 # Martin A. Hansen, December 2009.
815 # List all genomes for a given user and clade in ~/Data/Users
817 my ( $user, # user for which to return genomes
818 $clade, # clade for which to return genomes
823 my ( @dirs, $dir, @genomes );
825 @dirs = list_genome_dir( $user, $clade );
827 foreach $dir ( @dirs ) {
828 push @genomes, ( split "/", $dir )[ -1 ];
831 return wantarray ? @genomes : \@genomes;
835 sub list_assembly_dir
837 # Martin A. Hansen, December 2009.
839 # List all assemblies for a given user and clade and genome in ~/Data/Users
841 my ( $user, # user for which to return assemblies
842 $clade, # clade for which to return assemblies
843 $genome, # genome for which to return assemblies
848 my ( @dirs, @assemblies );
850 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
851 Maasha::Common::error( 'no user specified' ) if not $user;
852 Maasha::Common::error( 'no clade specified' ) if not $clade;
853 Maasha::Common::error( 'no genome specified' ) if not $genome;
855 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
857 @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
859 return wantarray ? @assemblies : \@assemblies;
865 # Martin A. Hansen, December 2009.
867 # List all assemblies for a given user and clade and genome in ~/Data/Users
869 my ( $user, # user for which to return assemblies
870 $clade, # clade for which to return assemblies
871 $genome, # genome for which to return assemblies
876 my ( @dirs, $dir, @assemblies );
878 @dirs = list_assembly_dir( $user, $clade, $genome );
880 foreach $dir ( @dirs ) {
881 push @assemblies, ( split "/", $dir )[ -1 ];
884 return wantarray ? @assemblies : \@assemblies;
890 # Martin A. Hansen, December 2009.
892 # List all assemblies for a given user->clade->genome->assembly in ~/Data/Users
894 my ( $user, # user for which to return contigs
895 $clade, # clade for which to return contigs
896 $genome, # genome for which to return contigs
897 $assembly, # assembly for which to return contigs
902 my ( @dirs, @contigs );
904 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
905 Maasha::Common::error( 'no user specified' ) if not $user;
906 Maasha::Common::error( 'no clade specified' ) if not $clade;
907 Maasha::Common::error( 'no genome specified' ) if not $genome;
908 Maasha::Common::error( 'no assembly specified' ) if not $assembly;
910 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
912 @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
914 return wantarray ? @contigs : \@contigs;
920 # Martin A. Hansen, December 2009.
922 # List all contigs for a given user->clade->genome->assembly in ~/Data/Users
924 my ( $user, # user for which to return contigs
925 $clade, # clade for which to return contigs
926 $genome, # genome for which to return contigs
927 $assembly, # assembly for which to return contigs
932 my ( @dirs, $dir, @contigs );
934 @dirs = list_contig_dir( $user, $clade, $genome, $assembly );
936 foreach $dir ( @dirs ) {
937 push @contigs, ( split "/", $dir )[ -1 ];
940 return wantarray ? @contigs : \@contigs;
946 # Martin A. Hansen, December 2009.
948 # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
950 my ( $user, # user for which to return tracks
951 $clade, # clade for which to return tracks
952 $genome, # genome for which to return tracks
953 $assembly, # assembly for which to return tracks
954 $contig, # contig for which to return tracks
959 my ( @dirs, @tracks );
961 Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
962 Maasha::Common::error( 'no user specified' ) if not $user;
963 Maasha::Common::error( 'no clade specified' ) if not $clade;
964 Maasha::Common::error( 'no genome specified' ) if not $genome;
965 Maasha::Common::error( 'no assembly specified' ) if not $assembly;
966 Maasha::Common::error( 'no contig specified' ) if not $contig;
968 if ( -d "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" ) {
969 @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" );
972 @tracks = grep { $_ !~ /\/\.\.?$/ } @dirs;
974 return wantarray ? @tracks : \@tracks;
980 # Martin A. Hansen, December 2009.
982 # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
984 my ( $user, # user for which to return tracks
985 $clade, # clade for which to return tracks
986 $genome, # genome for which to return tracks
987 $assembly, # assembly for which to return tracks
988 $contig, # contig for which to return tracks
993 my ( @dirs, $dir, @tracks );
995 @dirs = list_track_dir( $user, $clade, $genome, $assembly, $contig );
997 foreach $dir ( @dirs ) {
998 push @tracks, ( split "/", $dir )[ -1 ];
1001 return wantarray ? @tracks : \@tracks;
1007 # Martin A. Hansen, December 2009.
1009 # Traverses all contigs for a given user->clade->genome->assembly and
1010 # returns the maximum track's prefix value eg. 20 for 20_Genbank.
1018 # Returns an integer
1020 my ( @contigs, $contig, @tracks, $max );
1022 @contigs = list_contigs( $user, $clade, $genome, $assembly );
1024 foreach $contig ( @contigs ) {
1025 push @tracks, list_tracks( $user, $clade, $genome, $assembly, $contig );
1028 @tracks = sort @tracks;
1030 if ( scalar @tracks > 0 and $tracks[ -1 ] =~ /^(\d+)/ ) {
1040 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1047 sub search_tracks_nc
1049 # Martin A. Hansen, December 2009.
1051 # Uses grep to search all tracks in all contigs
1052 # for a given pattern and return a list of KISS entries.
1054 my ( $cookie, # cookie hash
1059 my ( $search_track, $search_term, $contig, @tracks, $track, $file, @features, $track_name, $nc_list );
1061 if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
1066 $search_track =~ tr/ /_/;
1070 $search_term = $cookie->{ 'SEARCH' };
1073 foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
1075 $cookie->{ 'CONTIG' } = $contig;
1077 push @tracks, path_tracks( $cookie );
1080 foreach $track ( @tracks )
1082 if ( $search_track )
1084 $track_name = ( split "/", $track )[ -1 ];
1086 next if $track_name !~ /$search_track/i;
1089 $file = "$track/track_data.kiss.json";
1093 $nc_list = Maasha::NClist::nc_list_retrieve( $file );
1094 push @features, Maasha::NClist::nc_list_search( $nc_list, $search_term, 12 );
1098 return wantarray ? @features : \@features;
1105 # Martin A. Hansen, November 2009.
1107 # Create a track with features. If there are more than $cookie->FEAT_MAX
1108 # features the track created will be a histogram, else linear.
1110 my ( $track, # path to kiss file with track data
1111 $cookie, # cookie hash
1116 my ( $index, $count, $track_name, $start, $end, $entries, $features );
1118 $start = $cookie->{ 'NAV_START' };
1119 $end = $cookie->{ 'NAV_END' };
1121 $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
1122 $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
1124 $track_name = ( split "/", $track )[ -1 ];
1125 $track_name =~ s/^\d+_//;
1126 $track_name =~ s/_/ /g;
1131 font_size => $cookie->{ 'SEQ_FONT_SIZE' },
1132 color => $cookie->{ 'SEQ_COLOR' },
1134 y1 => $cookie->{ 'TRACK_OFFSET' },
1137 $cookie->{ 'TRACK_OFFSET' } += 10;
1139 if ( $count > $cookie->{ 'FEAT_MAX' } )
1141 $entries = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
1142 push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
1146 $entries = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
1147 push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
1150 return wantarray ? @{ $features } : $features;