code_perl/Maasha/BGB/Track.pm

   1 package Maasha::BGB::Track;
   2
   3 # Copyright (C) 2009 Martin A. Hansen.
   4
   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.
   9
  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.
  14
  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.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines for creating Biopieces Browser tracks.
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use warnings;
  32 use strict;
  33 use Data::Dumper;
  34 use Maasha::Common;
  35 use Maasha::Calc;
  36 use Maasha::Filesys;
  37 use Maasha::KISS;
  38 use Maasha::Biopieces;
  39 use Maasha::Seq;
  40 use Maasha::BGB::Wiggle;
  41
  42 use vars qw( @ISA @EXPORT );
  43
  44 @ISA = qw( Exporter );
  45
  46 use constant {
  47     S_ID             => 0,
  48     S_BEG            => 1,
  49     S_END            => 2,
  50     Q_ID             => 3,
  51     SCORE            => 4,
  52     STRAND           => 5,
  53     HITS             => 6,
  54     ALIGN            => 7,
  55     BLOCK_COUNT      => 8,
  56     BLOCK_BEGS       => 9,
  57     BLOCK_LENS       => 10,
  58     BLOCK_TYPE       => 11,
  59 };
  60
  61 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  62
  63
  64 sub track_ruler
  65 {
  66     # Martin A. Hansen, November 2009.
  67
  68     # Create a track with a ruler of tics and positions for
  69     # the browser window.
  70
  71     my ( $cookie,   # browser cookie
  72        ) = @_;
  73
  74     # Returns a list.
  75
  76     my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
  77
  78     $beg    = $cookie->{ 'NAV_START' };
  79     $end    = $cookie->{ 'NAV_END' };
  80     $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
  81
  82     $step = 10;
  83
  84     while ( ( $end - $beg ) / $step > 20 ) {
  85         $step *= 5;
  86     }
  87
  88     for ( $i = $beg; $i < $end; $i++ )
  89     {
  90         if ( ( $i % $step ) == 0 )
  91         {
  92             $txt = "|" . Maasha::Calc::commify( $i );
  93             $x   = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
  94
  95             if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
  96             {
  97                 push @ruler, {
  98                     type      => 'text',
  99                     txt       => $txt,
 100                     font_size => $cookie->{ 'RULER_FONT_SIZE' },
 101                     color     => $cookie->{ 'RULER_COLOR' },
 102                     x1        => $x,
 103                     y1        => $cookie->{ 'TRACK_OFFSET' },
 104                 };
 105             }
 106         }
 107     }
 108
 109     $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
 110
 111     return wantarray ? @ruler : \@ruler;
 112 }
 113
 114
 115 sub track_seq
 116 {
 117     # Martin A. Hansen, November 2009.
 118
 119     # Create a sequence track by extracting the appropriate
 120     # stretch of sequence from the sequence file.
 121
 122     my ( $cookie,   # browser cookie
 123        ) = @_;
 124
 125     # Returns a list.
 126
 127     my ( $file, $fh, $seq, @chars, $factor, $x_offset, $i, @seq_list );
 128
 129     if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 )  # only add sequence if less than or equal to 220.
 130     {
 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 );
 134         close $fh;
 135
 136         @chars = split //, $seq;
 137
 138         $factor = $cookie->{ 'IMG_WIDTH' } / @chars;
 139
 140         $x_offset = sprintf( "%.0f", ( $factor / 2 ) - ( $cookie->{ 'SEQ_FONT_SIZE' } / 2 ) );
 141         $x_offset = 0 if $x_offset < 0;
 142
 143         for ( $i = 0; $i < @chars; $i++ )
 144         {
 145             push @seq_list, {
 146                 type      => 'text',
 147                 txt       => $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' },
 152             };
 153         }
 154
 155         $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
 156
 157         return wantarray ? @seq_list : \@seq_list;
 158     }
 159     else
 160     {
 161         return;
 162     }
 163 }
 164
 165
 166 sub track_feature
 167 {
 168     # Martin A. Hansen, November 2009.
 169
 170     my ( $track,    # path to track data
 171          $cookie,   # cookie hash
 172        ) = @_;
 173
 174     # Returns a list.
 175
 176     my ( $data_wig, $data_kiss, $track_name, $features );
 177
 178     $track_name = ( split "/", $track )[ -1 ];
 179     $track_name =~ s/^\d+_//;
 180     $track_name =~ s/_/ /g;
 181
 182     push @{ $features }, {
 183         type      => 'text',
 184         txt       => $track_name,
 185         font_size => $cookie->{ 'SEQ_FONT_SIZE' },
 186         color     => $cookie->{ 'SEQ_COLOR' },
 187         x1        => 0,
 188         y1        => $cookie->{ 'TRACK_OFFSET' },
 189     };
 190
 191     $cookie->{ 'TRACK_OFFSET' } += 10;
 192
 193     if ( -f "$track/track_data.wig" )
 194     {
 195         $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
 196
 197         push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
 198     }
 199     elsif ( -f "$track/track_data.kiss" )
 200     {
 201         $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
 202
 203         push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
 204     }
 205     else
 206     {
 207         Maasha::Common::error( "Unknown track data type" );
 208     }
 209
 210     return wantarray ? @{ $features } : $features;
 211 }
 212
 213
 214 sub track_wiggle
 215 {
 216     # Martin A. Hansen, February 2010.
 217
 218     # Create a wiggle track.
 219
 220     my ( $cookie,    # hashref with image draw metrics
 221          $beg,       # base window beg
 222          $end,       # base window end
 223          $vals,      # wiggle values
 224        ) = @_;
 225
 226     # Returns a list.
 227
 228     my ( $i, $height, $max_val, $min_val, $max, $factor, $x1, $y1, $x2, $y2, @features );
 229
 230     $height  = 75;   # pixels
 231
 232     ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
 233
 234     $vals    = Maasha::BGB::Wiggle::wiggle_normalize( $vals, $cookie->{ 'IMG_WIDTH' } );
 235
 236     $max     = Maasha::Calc::list_max( $vals );
 237
 238     $factor = $height / $max;
 239
 240     $x1 = 0;
 241     $y1 = $cookie->{ 'TRACK_OFFSET' } + $height;
 242
 243     for ( $i = 0; $i < scalar @{ $vals }; $i++ )
 244     {
 245         $x2 = $i;
 246         $y2 = $cookie->{ 'TRACK_OFFSET' } + $height - sprintf( "%.0f", $vals->[ $i ] * $factor );
 247
 248         push @features, {
 249             type  => 'wiggle',
 250             color => $cookie->{ 'FEAT_COLOR' },
 251             line_width => 1,
 252             x1         => $x1,
 253             y1         => $y1,
 254             x2         => $x2,
 255             y2         => $y2,
 256         };
 257
 258         $x1 = $x2;
 259         $y1 = $y2;
 260     }
 261
 262     $x2 = $i;
 263     $y2 = $cookie->{ 'TRACK_OFFSET' } + $height;
 264
 265     push @features, {
 266         type  => 'wiggle',
 267         color => $cookie->{ 'FEAT_COLOR' },
 268         line_width => 1,
 269         x1         => $x1,
 270         y1         => $y1,
 271         x2         => $x2,
 272         y2         => $y2,
 273     };
 274
 275     unshift @features, {
 276         type      => 'text',
 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' },
 280         x1        => 0,
 281         y1        => $cookie->{ 'TRACK_OFFSET' },
 282     };
 283
 284     $cookie->{ 'TRACK_OFFSET' } += $height + $cookie->{ 'TRACK_SPACE' };
 285
 286     return wantarray ? @features : \@features;
 287 }
 288
 289
 290 sub track_linear
 291 {
 292     # Martin A. Hansen, November 2009.
 293
 294     # Create a linear feature track where the granularity depends
 295     # on the lenght of the features and the browser window width.
 296
 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
 301        ) = @_;
 302
 303     # Returns a list.
 304
 305     my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
 306
 307     $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
 308     $y_step = 0;
 309     $y_max  = 0;
 310
 311     foreach $entry ( @{ $entries } )
 312     {
 313         $w = sprintf( "%.0f", ( $entry->[ S_END ] - $entry->[ S_BEG ] + 1 ) * $factor );
 314
 315         if ( $w >= 1 )
 316         {
 317             $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor );
 318
 319             for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
 320                 last if $x1 >= $ladder[ $y_step ] + 1;
 321             }
 322
 323             $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
 324
 325             $feature = {
 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 ],
 333                 x1         => $x1,
 334                 y1         => $y1,
 335                 x2         => $x1 + $w,
 336                 y2         => $y1 + $cookie->{ 'FEAT_WIDTH' },
 337             };
 338
 339             if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
 340                 $feature->{ 'type' } = 'arrow';
 341             } else {
 342                 $feature->{ 'type' } = 'rect';
 343             }
 344
 345             push @features, $feature;
 346
 347             $y_max = Maasha::Calc::max( $y_max, $y_step * ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) );
 348
 349             push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';
 350
 351             $ladder[ $y_step ] = $x1 + $w;
 352         }
 353     }
 354
 355     $cookie->{ 'TRACK_OFFSET' } += $y_max + $cookie->{ 'TRACK_SPACE' };
 356
 357     return wantarray ? @features : \@features;
 358 }
 359
 360
 361 sub feature_align
 362 {
 363     # Martin A. Hansen, November 2009.
 364
 365     # Add to feature track alignment info if the granularity is
 366     # sufficient.
 367     # TODO: The printing of chars is imprecise.
 368
 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
 374        ) = @_;
 375
 376     # Returns a list.
 377
 378     my ( $w, $align, $pos, $nt_before, $nt_after, $x1, @features );
 379
 380     $w = sprintf( "%.0f", 1 * $factor );
 381
 382     if ( $w >= 1 )
 383     {
 384         foreach $align ( split /,/, $entry->[ ALIGN ] )
 385         {
 386             if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
 387             {
 388                 $pos       = $1;
 389                 $nt_before = $2;
 390                 $nt_after  = $3;
 391             }
 392             else
 393             {
 394                 Maasha::Common::error( qq(BAD align descriptor: "$align") );
 395             }
 396
 397             $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] + $pos - $beg ) * $factor );
 398
 399             push @features, {
 400                 type       => 'rect',
 401                 line_width => $feat_height,
 402                 color      => [ 1, 0, 0 ],
 403                 title      => $align,
 404                 x1         => $x1,
 405                 y1         => $y_offset,
 406                 x2         => $x1 + $w,
 407                 y2         => $y_offset + $feat_height,
 408             };
 409
 410             if ( $w > $feat_height )
 411             {
 412                 push @features, {
 413                     type       => 'text',
 414                     font_size  => $feat_height + 2,
 415                     color      => [ 0, 0, 0 ],
 416                     txt        => $nt_after,
 417                     x1         => $x1 + sprintf( "%.0f", ( $w / 2 ) ) - $feat_height / 2,
 418                     y1         => $y_offset + $feat_height,
 419                 };
 420             }
 421         }
 422     }
 423
 424     return wantarray ? @features : \@features;
 425 }
 426
 427
 428 sub track_feature_histogram
 429 {
 430     # Martin A. Hansen, November 2009.
 431
 432     # Create a feature track as a histogram using information
 433     # from the index only thus avoiding to load features from the
 434     # file.
 435
 436     my ( $cookie,   # hashref with image draw metrics
 437          $min,      # minimum base position
 438          $max,      # maximum base position
 439          $blocks,   # list of blocks
 440        ) = @_;
 441
 442     # Returns a list.
 443
 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 );
 445
 446     return if $max <= $min;
 447
 448     $hist_height  = 100;   # pixels
 449     $bucket_width = 5;
 450     $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
 451     $factor       = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
 452
 453     $min_bucket = 999999999;
 454     $max_height = 0;
 455
 456     foreach $block ( @{ $blocks } )
 457     {
 458         $bucket_beg = int( $block->{ 'BEG' } * $factor );
 459         $bucket_end = int( $block->{ 'END' } * $factor );
 460
 461         $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
 462
 463         for ( $i = $bucket_beg; $i < $bucket_end; $i++ )
 464         {
 465             $buckets[ $i ] += $block->{ 'COUNT' };
 466
 467             $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
 468         }
 469     }
 470
 471     if ( $max_height > 0 )
 472     {
 473         $factor_heigth = $hist_height / $max_height;
 474
 475         $x = 0;
 476
 477         for ( $i = $min_bucket; $i < @buckets; $i++ )
 478         {
 479             if ( defined $buckets[ $i ] )
 480             {
 481                 $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth );
 482
 483                 if ( $h >= 1 )
 484                 {
 485                     push @hist, {
 486                         type       => 'line',
 487                         line_width => $bucket_width,
 488                         color      => $cookie->{ 'FEAT_COLOR' },
 489                         title      => "Features: $buckets[ $i ]",
 490                         x1         => $x,
 491                         y1         => $cookie->{ 'TRACK_OFFSET' } + $hist_height,
 492                         x2         => $x,
 493                         y2         => $cookie->{ 'TRACK_OFFSET' } + $hist_height - $h,
 494                     };
 495                 }
 496             }
 497
 498             $x += $bucket_width;
 499         }
 500     }
 501
 502     $cookie->{ 'TRACK_OFFSET' } += $hist_height + $cookie->{ 'TRACK_SPACE' };
 503
 504     return wantarray ? @hist : \@hist;
 505 }
 506
 507
 508 sub dna_get
 509 {
 510     # Martin A. Hansen, November 2009.
 511
 512     # Returns the sequence from the contig in the beg/end interval
 513     # contained in the cookie.
 514
 515     my ( $cookie,   # cookie hash
 516        ) = @_;
 517
 518     # Returns a string.
 519
 520     my ( $path, $fh, $beg, $end, $len, $dna );
 521
 522     $path = path_seq( $cookie );
 523
 524     $beg = $cookie->{ 'S_BEG' };
 525     $end = $cookie->{ 'S_END' };
 526     $beg =~ tr/,//d;
 527     $end =~ tr/,//d;
 528     $len = $end - $beg + 1;
 529
 530
 531     $fh = Maasha::Filesys::file_read_open( $path );
 532
 533     $dna = Maasha::Filesys::file_read( $fh, $beg, $len );
 534
 535     $dna = Maasha::Seq::dna_revcomp( $dna ) if $cookie->{ 'STRAND' } eq '-';
 536
 537     Maasha::Seq::wrap( \$dna, 100 );
 538
 539     close $fh;
 540
 541     return $dna;
 542 }
 543
 544
 545 sub path_seq
 546 {
 547     # Martin A. Hansen, November 2009.
 548
 549     # Returns the path to the sequence file for a specified
 550     # contig as written in the cookie.
 551
 552     my ( $cookie,   # cookie hash
 553        ) = @_;
 554
 555     # Returns a string.
 556
 557     my ( $path );
 558
 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' };
 564
 565     $path = join( "/",
 566         $cookie->{ 'DATA_DIR' },
 567         "Users",
 568         $cookie->{ 'USER' },
 569         $cookie->{ 'CLADE' },
 570         $cookie->{ 'GENOME' },
 571         $cookie->{ 'ASSEMBLY' },
 572         $cookie->{ 'CONTIG' },
 573         "Sequence",
 574         "sequence.txt"
 575     );
 576
 577     die qq(ERROR: no such file: "$path".\n) if not -e $path;
 578
 579     return $path;
 580 }
 581
 582
 583 sub path_tracks
 584 {
 585     # Martin A. Hansen, November 2009.
 586
 587     # Returns a list of paths to all tracks for a specified
 588     # contig as written in the cookie.
 589
 590     my ( $cookie,   # cookie path
 591        ) = @_;
 592
 593     # Returns a list.
 594
 595     my ( $path, @tracks );
 596
 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' };
 602
 603     $path = join( "/",
 604         $cookie->{ 'DATA_DIR' },
 605         "Users",
 606         $cookie->{ 'USER' },
 607         $cookie->{ 'CLADE' },
 608         $cookie->{ 'GENOME' },
 609         $cookie->{ 'ASSEMBLY' },
 610         $cookie->{ 'CONTIG' },
 611         "Tracks",
 612     );
 613
 614     if ( -d $path )
 615     {
 616         @tracks = Maasha::Filesys::ls_dirs( $path );
 617
 618         @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
 619
 620         return wantarray ? @tracks : \@tracks;
 621     }
 622     else
 623     {
 624         return wantarray ? () : [];
 625     }
 626 }
 627
 628
 629 sub search_tracks
 630 {
 631     # Martin A. Hansen, December 2009.
 632
 633     # Uses grep to search all tracks in all contigs
 634     # for a given pattern and return a list of KISS entries.
 635
 636     my ( $cookie,   # cookie hash
 637        ) = @_;
 638
 639     # Returns a list.
 640
 641     my ( $search_track, $search_term, $contig, @tracks, $track, $file, $line, $out_file, $fh, $entry, @entries, $track_name );
 642
 643     if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
 644     {
 645         $search_term  = $1;
 646         $search_track = $2;
 647
 648         $search_track =~ tr/ /_/;
 649     }
 650     else
 651     {
 652         $search_term = $cookie->{ 'SEARCH' };
 653     }
 654
 655     foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
 656     {
 657         $cookie->{ 'CONTIG' } = $contig;
 658
 659         push @tracks, path_tracks( $cookie );
 660     }
 661
 662     foreach $track ( @tracks )
 663     {
 664         if ( $search_track )
 665         {
 666             $track_name = ( split "/", $track )[ -1 ];
 667
 668             next if $track_name !~ /$search_track/i;
 669         }
 670
 671         $file = "$track/track_data.kiss";
 672
 673         if ( -f $file )
 674         {
 675             $fh = Maasha::Filesys::file_read_open( $file );
 676
 677             while ( $line = <$fh> )
 678             {
 679                 chomp $line;
 680
 681                 if ( $line =~ /$search_term/i )
 682                 {
 683                     $entry = Maasha::KISS::kiss_entry_parse( $line );
 684                     push @entries, $entry;
 685                 }
 686             }
 687
 688             close $fh;
 689         }
 690     }
 691
 692     return wantarray ? @entries : \@entries;
 693 }
 694
 695
 696 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 697
 698 1;
 699
 700 __END__
 701
 702
 703 sub search_tracks_nc
 704 {
 705     # Martin A. Hansen, December 2009.
 706
 707     # Uses grep to search all tracks in all contigs
 708     # for a given pattern and return a list of KISS entries.
 709
 710     my ( $cookie,   # cookie hash
 711        ) = @_;
 712
 713     # Returns a list.
 714
 715     my ( $search_track, $search_term, $contig, @tracks, $track, $file, @features, $track_name, $nc_list );
 716
 717     if ( $cookie->{ 'SEARCH' } =~ /^(.+)\s+track:\s*(.+)/i )
 718     {
 719         $search_term  = $1;
 720         $search_track = $2;
 721
 722         $search_track =~ tr/ /_/;
 723     }
 724     else
 725     {
 726         $search_term = $cookie->{ 'SEARCH' };
 727     }
 728
 729     foreach $contig ( @{ $cookie->{ 'LIST_CONTIG' } } )
 730     {
 731         $cookie->{ 'CONTIG' } = $contig;
 732
 733         push @tracks, path_tracks( $cookie );
 734     }
 735
 736     foreach $track ( @tracks )
 737     {
 738         if ( $search_track )
 739         {
 740             $track_name = ( split "/", $track )[ -1 ];
 741
 742             next if $track_name !~ /$search_track/i;
 743         }
 744
 745         $file = "$track/track_data.kiss.json";
 746
 747         if ( -f $file )
 748         {
 749             $nc_list  = Maasha::NClist::nc_list_retrieve( $file );
 750             push @features, Maasha::NClist::nc_list_search( $nc_list, $search_term, 12 );
 751         }
 752     }
 753
 754     return wantarray ? @features : \@features;
 755 }
 756
 757
 758
 759 sub track_feature
 760 {
 761     # Martin A. Hansen, November 2009.
 762
 763     # Create a track with features. If there are more than $cookie->FEAT_MAX
 764     # features the track created will be a histogram, else linear.
 765
 766     my ( $track,    # path to kiss file with track data
 767          $cookie,   # cookie hash
 768        ) = @_;
 769
 770     # Returns a list.
 771
 772     my ( $index, $count, $track_name, $start, $end, $entries, $features );
 773
 774     $start = $cookie->{ 'NAV_START' };
 775     $end   = $cookie->{ 'NAV_END' };
 776
 777     $index = Maasha::KISS::kiss_index_retrieve( "$track/track_data.kiss.index" );
 778     $count = Maasha::KISS::kiss_index_count( $index, $start, $end );
 779
 780     $track_name = ( split "/", $track )[ -1 ];
 781     $track_name =~ s/^\d+_//;
 782     $track_name =~ s/_/ /g;
 783
 784     $features = [ {
 785         type      => 'text',
 786         txt       => $track_name,
 787         font_size => $cookie->{ 'SEQ_FONT_SIZE' },
 788         color     => $cookie->{ 'SEQ_COLOR' },
 789         x1        => 0,
 790         y1        => $cookie->{ 'TRACK_OFFSET' },
 791     } ];
 792
 793     $cookie->{ 'TRACK_OFFSET' } += 10;
 794
 795     if ( $count > $cookie->{ 'FEAT_MAX' } )
 796     {
 797         $entries  = Maasha::KISS::kiss_index_get_blocks( $index, $start, $end );
 798         push @{ $features }, track_feature_histogram( $cookie, $start, $end, $entries );
 799     }
 800     else
 801     {
 802         $entries  = Maasha::KISS::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
 803         push @{ $features }, track_feature_linear( $cookie, $start, $end, $entries );
 804     }
 805
 806     return wantarray ? @{ $features } : $features;
 807 }