From 9ad09f4ee118fd3e4e0637c40eaadf4cc15dfca4 Mon Sep 17 00:00:00 2001 From: martinahansen Date: Tue, 24 Nov 2009 11:19:17 +0000 Subject: [PATCH] major work on KISS browser completed git-svn-id: http://biopieces.googlecode.com/svn/trunk@766 74ccb610-7750-0410-82ae-013aeee3265d --- code_perl/Maasha/KISS/IO.pm | 369 +++++++++++++++----- code_perl/Maasha/KISS/Track.pm | 257 ++++++++++---- www/cgi-bin/index.cgi | 606 +++++++++++++++++---------------- 3 files changed, 789 insertions(+), 443 deletions(-) diff --git a/code_perl/Maasha/KISS/IO.pm b/code_perl/Maasha/KISS/IO.pm index 291749d..f013d2f 100644 --- a/code_perl/Maasha/KISS/IO.pm +++ b/code_perl/Maasha/KISS/IO.pm @@ -42,18 +42,21 @@ 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, + 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, + INDEX_BLOCK_SIZE => 100, + INDEX_LEVEL => 100_000_000, + INDEX_FACTOR => 100, }; @@ -77,7 +80,7 @@ sub kiss_entry_get @fields = split /\t/, $line; - Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 12; + Maasha::Common::error( qq(BAD kiss entry: $line) ) if not @fields == 12; $entry{ 'S_ID' } = $fields[ S_ID ]; $entry{ 'S_BEG' } = $fields[ S_BEG ]; @@ -107,7 +110,7 @@ sub kiss_entry_put my ( @fields ); - if ( defined $entry->{ 'S_ID' } and + if ( defined $entry->{ 'S_ID' } and defined $entry->{ 'S_BEG' } and defined $entry->{ 'S_END' } ) @@ -153,53 +156,150 @@ sub kiss_sql_get sub kiss_index { - # Martin A, Hansen, October 2009. + # Martin A, Hansen, November 2009. - # Creates an index of a sorted KISS file that - # allowing the location of the byte position - # from where records can be read given a - # specific S_BEG position. The index consists of - # triples: [ beg, end, bytepos ], where beg and - # end denotes the interval where the next KISS - # record begins at bytepos. + # Creates an index of a sorted KISS file. - my ( $fh, # filehandle to KISS file + my ( $file, # KISS file to index ) = @_; - # Returns a list. + # Returns a hashref. - my ( $line, @fields, $beg, $end, $pos, @index ); + my ( $tree, $offset, $fh, $line, $beg ); - $beg = 0; - $pos = 0; + $tree = {}; + $offset = 0; + + $fh = Maasha::Filesys::file_read_open( $file ); while ( $line = <$fh> ) { - chomp $line; + ( undef, $beg ) = split "\t", $line, 3; - @fields = split /\t/, $line, 3; + kiss_index_node_add( $tree, INDEX_LEVEL, INDEX_FACTOR, $beg, $offset ); + + $offset += length $line; + } + + close $fh; + + kiss_index_store( "$file.index", $tree ); +} + + +sub kiss_index_node_add +{ + # Martin A, Hansen, November 2009. + + # Recursive routine to add nodes to a tree. + + my ( $node, + $level, + $factor, + $beg, + $offset, + $sum, + ) = @_; + + my ( $bucket ); + + $sum ||= 0; + $bucket = int( $beg / $level ); + + if ( $level >= $factor ) + { + $sum += $bucket * $level; + $beg -= $bucket * $level; - $end = $fields[ S_BEG ]; + $node->{ 'CHILDREN' }->[ $bucket ]->{ 'COUNT' }++; + # $node->{ 'CHILDREN' }->[ $bucket ]->{ 'LEVEL' } = $level; + # $node->{ 'CHILDREN' }->[ $bucket ]->{ 'BUCKET' } = $bucket; + $node->{ 'CHILDREN' }->[ $bucket ]->{ 'BEG' } = $sum; + $node->{ 'CHILDREN' }->[ $bucket ]->{ 'END' } = $sum + $level - 1; + $node->{ 'CHILDREN' }->[ $bucket ]->{ 'OFFSET' } = $offset if not defined $node->{ 'CHILDREN' }->[ $bucket ]->{ 'OFFSET' }; + + kiss_index_node_add( $node->{ 'CHILDREN' }->[ $bucket ], $level / $factor, $factor, $beg, $offset, $sum ); + } +} - if ( $end == 0 ) - { - push @index, [ $beg, $end, $pos ]; - $beg = 1; - } - elsif ( $end > $beg ) + +sub kiss_index_offset +{ + # Martin A. Hansen, November 2009. + + # Given a KISS index and a begin position, + # locate the offset closest to the begin position, + # and return this. + + my ( $index, # KISS index + $beg, # begin position + $level, # index level - OPTIONAL + $factor, # index factor - OPTIONAL + ) = @_; + + # Returns a number. + + my ( $child, $offset ); + + $level ||= INDEX_LEVEL; + $factor ||= INDEX_FACTOR; + + foreach $child ( @{ $index->{ 'CHILDREN' } } ) + { + next if not defined $child; + + if ( $child->{ 'BEG' } <= $beg and $beg <= $child->{ 'END' } ) { - push @index, [ $beg, $end - 1, $pos ]; - $beg = $end; + if ( $level == $factor ) { + $offset = $child->{ 'OFFSET' }; + } else { + $offset = kiss_index_offset( $child, $beg, $level / $factor, $factor ); + } } - elsif( $end < $beg ) + } + + return $offset; +} + + +sub kiss_index_count +{ + # Martin A. Hansen, November 2009. + + # Given a KISS index and a begin/end interval + # sum the number of counts in that interval, + # and return this. + + my ( $index, # KISS index + $beg, # Begin position + $end, # End position + $level, # index level - OPTIONAL + $factor, # index factor - OPTIONAL + ) = @_; + + # Returns a number. + + my ( $count, $child ); + + $level ||= INDEX_LEVEL; + $factor ||= INDEX_FACTOR; + $count ||= 0; + + foreach $child ( @{ $index->{ 'CHILDREN' } } ) + { + next if not defined $child; + + if ( $level >= $factor ) { - Maasha::Common::error( qq(KISS file not sorted: $end < $beg) ); + if ( Maasha::Calc::overlap( $beg, $end, $child->{ 'BEG' }, $child->{ 'END' } ) ) + { + $count += $child->{ 'COUNT' } if $level == $factor; + $count += kiss_index_count( $child, $beg, $end, $level / $factor, $factor ); + } } - - $pos += 1 + length $line; } - return wantarray ? @index : \@index; + return $count; } @@ -226,63 +326,90 @@ sub kiss_index_retrieve } -sub kiss_index_search +sub kiss_index_get_entries { - my ( $index, - $num, + my ( $file, + $index, + $beg, + $end, ) = @_; - # Returns a number. + my ( $offset, $fh, $entry, @entries ); - my ( $high, $low, $try ); + $offset = kiss_index_offset( $index, $beg ); - $low = 0; - $high = scalar @{ $index }; + $fh = Maasha::Filesys::file_read_open( $file ); - while ( $low <= $high ) + sysseek( $fh, $offset, 0 ); + + while ( $entry = kiss_entry_get( $fh ) ) { - $try = int( ( $high + $low ) / 2 ); - - if ( $num < $index->[ $try ]->[ 0 ] ) { - $high = $try; - } elsif ( $num > $index->[ $try ]->[ 1 ] ) { - $low = $try + 1; - } else { - return $index->[ $try ]->[ 2 ]; - } + push @entries, $entry if $entry->{ 'S_END' } > $beg; + + last if $entry->{ 'S_BEG' } > $end; } - Maasha::Common::error( "Could not find number->$num in index" ); + close $fh; + + return wantarray ? @entries : \@entries; } -sub kiss_index_get +sub kiss_index_get_blocks { - my ( $file, + my ( $index, $beg, $end, + $level, # index level - OPTIONAL + $factor, # index factor - OPTIONAL + $size, ) = @_; - my ( $index, $offset, $fh, $entry, @entries ); - - $index = Maasha::KISS::IO::kiss_index_retrieve( "$file.index" ); - - $offset = Maasha::KISS::IO::kiss_index_search( $index, $beg ); - - $fh = Maasha::Filesys::file_read_open( $file ); - - sysseek( $fh, $offset, 0 ); - - while ( $entry = kiss_entry_get( $fh ) ) + # Returns a list. + + my ( $len, @blocks, $child ); + + $level ||= INDEX_LEVEL; + $factor ||= INDEX_FACTOR; + + $size ||= 100; # TODO: lazy list loading? + +# if ( not defined $size ) +# { +# $len = $end - $beg + 1; +# +# if ( $len > 100_000_000 ) { +# $size = 1_000_000; +# } elsif ( $len > 1_000_000 ) { +# $size = 10_000; +# } else { +# $size = 100; +# } +# } + + if ( $level >= $size ) { - push @entries, $entry; + foreach $child ( @{ $index->{ 'CHILDREN' } } ) + { + next if not defined $child; - last if $entry->{ 'S_END' } > $end; + if ( Maasha::Calc::overlap( $beg, $end, $child->{ 'BEG' }, $child->{ 'END' } ) ) + { + if ( $level == $size ) + { + push @blocks, { + BEG => $child->{ 'BEG' }, + END => $child->{ 'END' }, + COUNT => $child->{ 'COUNT' }, + }; + } + + push @blocks, kiss_index_get_blocks( $child, $beg, $end, $level / $factor, $factor, $size ); + } + } } - close $fh; - - return wantarray ? @entries : \@entries; + return wantarray ? @blocks : \@blocks; } @@ -367,4 +494,88 @@ sub biopiece2kiss 1; +__END__ + +sub kiss_index +{ + # Martin A, Hansen, October 2009. + + # Creates an index of a sorted KISS file that + # allowing the location of the byte position + # from where records can be read given a + # specific S_BEG position. The index consists of + # triples: [ beg, end, bytepos ], where beg and + # end denotes the interval where the next KISS + # record begins at bytepos. + + my ( $fh, # filehandle to KISS file + ) = @_; + + # Returns a list. + + my ( $line, @fields, $beg, $end, $pos, @index ); + + $beg = 0; + $pos = 0; + + while ( $line = <$fh> ) + { + chomp $line; + + @fields = split /\t/, $line, 3; + + $end = $fields[ S_BEG ]; + + if ( $end == 0 ) + { + push @index, [ $beg, $end, $pos ]; + $beg = 1; + } + elsif ( $end > $beg ) + { + push @index, [ $beg, $end - 1, $pos ]; + $beg = $end; + } + elsif ( $end < $beg ) + { + Maasha::Common::error( qq(KISS file not sorted: beg > end -> $beg > $end) ); + } + + $pos += 1 + length $line; + } + + return wantarray ? @index : \@index; +} + + + +sub kiss_index_search +{ + my ( $index, + $num, + ) = @_; + + # Returns a number. + + my ( $high, $low, $try ); + + $low = 0; + $high = scalar @{ $index }; + + while ( $low <= $high ) + { + $try = int( ( $high + $low ) / 2 ); + + if ( $num < $index->[ $try ]->[ 0 ] ) { + $high = $try; + } elsif ( $num > $index->[ $try ]->[ 1 ] ) { + $low = $try + 1; + } else { + return $index->[ $try ]->[ 2 ]; + } + } + + Maasha::Common::error( "Could not find number->$num in index" ); +} + diff --git a/code_perl/Maasha/KISS/Track.pm b/code_perl/Maasha/KISS/Track.pm index 15007e2..5972442 100644 --- a/code_perl/Maasha/KISS/Track.pm +++ b/code_perl/Maasha/KISS/Track.pm @@ -43,17 +43,16 @@ use vars qw( @ISA @EXPORT ); sub track_ruler { - my ( $width, # draw window width - $y_offset, # y axis draw offset - $beg, # base window beg - $end, # base window end - $font_size, # font size - $color, # font color + my ( $draw_metrics, # hashref with image draw metrics + $cookie, # browser cookie ) = @_; - my ( $factor, $step, $i, $txt, $x, @ruler ); + my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler ); - $factor = $width / ( $end - $beg ); + $beg = $cookie->{ 'NAV_START' }; + $end = $cookie->{ 'NAV_END' }; + + $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg ); $step = 10; @@ -66,75 +65,134 @@ sub track_ruler { if ( ( $i % $step ) == 0 ) { - $txt = "$i|"; + $txt = Maasha::Calc::commify( $i ) . "|"; $x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor ); - if ( $x > 0 and $x + ( $font_size * length $txt ) < $width ) + if ( $x > 0 and $x + ( $draw_metrics->{ 'RULER_FONT_SIZE' } * length $txt ) < $draw_metrics->{ 'IMG_WIDTH' } ) { push @ruler, { type => 'text', txt => $txt, - font_size => $font_size, - color => $color, + font_size => $draw_metrics->{ 'RULER_FONT_SIZE' }, + color => $draw_metrics->{ 'RULER_COLOR' }, x1 => $x, - y1 => $y_offset + y1 => $draw_metrics->{ 'TRACK_OFFSET' }, }; } } } + $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' }; + return wantarray ? @ruler : \@ruler; } sub track_seq { - my ( $width, # draw window width - $y_offset, # y axis draw offset - $seq, # sequence to draw - $font_size, # font size - $color, # font color + my ( $draw_metrics, # hashref with image draw metrics + $cookie, # browser cookie ) = @_; - my ( @chars, $factor, $i, @seq_list ); + my ( $file, $fh, $seq, @chars, $factor, $i, @seq_list ); - @chars = split //, $seq; + if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) + { + $file = path_seq( $cookie ); + $fh = Maasha::Filesys::file_read_open( $file ); + $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' } - 1, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 ); + close $fh; + + @chars = split //, $seq; + + $factor = $draw_metrics->{ 'IMG_WIDTH' } / @chars; + + for ( $i = 0; $i < @chars; $i++ ) { + push @seq_list, { + type => 'text', + txt => $chars[ $i ], + font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' }, + color => $draw_metrics->{ 'SEQ_COLOR' }, + x1 => sprintf( "%.0f", $i * $factor ), + y1 => $draw_metrics->{ 'TRACK_OFFSET' }, + }; + } - $factor = $width / @chars; + $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' }; - for ( $i = 0; $i < @chars; $i++ ) { - push @seq_list, { - type => 'text', - txt => $chars[ $i ], - font_size => $font_size, - color => $color, - x1 => sprintf( "%.0f", $i * $factor ), - y1 => $y_offset, - }; + return wantarray ? @seq_list : \@seq_list; + } + else + { + return; } - - return wantarray ? @seq_list : \@seq_list; } sub track_feature { - my ( $width, # draw window width - $y_offset, # y axis draw offset - $beg, # base window beg - $end, # base window end - $entries, # list of unsorted KISS entries + my ( $track, + $draw_metrics, + $cookie, + ) = @_; + + # Returns a list. + + my ( $index, $count, $track_name, $start, $end, $entries, $features ); + + $start = $cookie->{ 'NAV_START' }; + $end = $cookie->{ 'NAV_END' }; + + $index = Maasha::KISS::IO::kiss_index_retrieve( "$track/track_data.kiss.index" ); + $count = Maasha::KISS::IO::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 => $draw_metrics->{ 'SEQ_FONT_SIZE' }, + color => $draw_metrics->{ 'SEQ_COLOR' }, + x1 => 0, + y1 => $draw_metrics->{ 'TRACK_OFFSET' }, + } ]; + + $draw_metrics->{ 'TRACK_OFFSET' } += 10; + + if ( $count > 5000 ) + { + $entries = Maasha::KISS::IO::kiss_index_get_blocks( $index, $start, $end ); + push @{ $features }, Maasha::KISS::Track::track_feature_histogram( $draw_metrics, $start, $end, $entries ); + } + else + { + $entries = Maasha::KISS::IO::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end ); + push @{ $features }, Maasha::KISS::Track::track_feature_linear( $draw_metrics, $start, $end, $entries ); + } + + return wantarray ? @{ $features } : $features; +} + + +sub track_feature_linear +{ + my ( $draw_metrics, # hashref with image draw metrics + $beg, # base window beg + $end, # base window end + $entries, # list of unsorted KISS entries ) = @_; # Returns a list. - my ( $feat_height, $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features ); + my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features ); @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries }; - $feat_height = 5; - $factor = $width / ( $end - $beg ); - $y_step = 0; + $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg ); + $y_step = 0; + $y_max = 0; foreach $entry ( @{ $entries } ) { @@ -144,30 +202,33 @@ sub track_feature { $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor ); - for ( $y_step = 0; $y_step < @ladder; $y_step++ ) - { + for ( $y_step = 0; $y_step < @ladder; $y_step++ ) { last if $x1 >= $ladder[ $y_step ] + 1; } - $y1 = $y_offset + ( $feat_height * $y_step ); + $y1 = $draw_metrics->{ 'TRACK_OFFSET' } + ( $draw_metrics->{ 'FEAT_WIDTH' } * $y_step ); push @features, { type => 'rect', - line_width => $feat_height, + line_width => $draw_metrics->{ 'FEAT_WIDTH' }, color => 'green', title => $entry->{ 'Q_ID' }, x1 => $x1, y1 => $y1, x2 => $x1 + $w, - y2 => $y1 + $feat_height, + y2 => $y1 + $draw_metrics->{ 'FEAT_WIDTH' }, }; - push @features, feature_align( $entry, $beg, $y1, $factor, $feat_height ) if defined $entry->{ 'ALIGN' }; + $y_max = Maasha::Calc::max( $y_max, $y_step * $draw_metrics->{ 'FEAT_WIDTH' } ); + + push @features, feature_align( $entry, $beg, $y1, $factor, $draw_metrics->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.'; $ladder[ $y_step ] = $x1 + $w; } } + $draw_metrics->{ 'TRACK_OFFSET' } += $y_max + $draw_metrics->{ 'TRACK_SPACE' }; + return wantarray ? @features : \@features; } @@ -235,39 +296,38 @@ sub feature_align } -sub track_histogram +sub track_feature_histogram { - my ( $width, # draw window width - $y_offset, # y axis draw offset - $min, # minimum base position - $max, # maximum base position - $entries, # list of unsorted KISS entries + my ( $draw_metrics, # hashref with image draw metrics + $min, # minimum base position + $max, # maximum base position + $blocks, # list of blocks ) = @_; # Returns a list. - my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h ); + my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist ); - return if $max == $min; + return if $max <= $min; $hist_height = 100; # pixels - $bucket_width = 5; # pixels - - $factor_width = ( $width / $bucket_width ) / ( $max - $min ); + $bucket_width = 5; + $bucket_count = $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width; + $factor = ( $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 ); $min_bucket = 999999999; $max_height = 0; - foreach $entry ( @{ $entries } ) + foreach $block ( @{ $blocks } ) { - $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width ); - $bucket_end = int( $entry->{ 'S_END' } * $factor_width ); + $bucket_beg = int( $block->{ 'BEG' } * $factor ); + $bucket_end = int( $block->{ 'END' } * $factor ); $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg ); for ( $i = $bucket_beg; $i <= $bucket_end; $i++ ) { - $buckets[ $i ]++; + $buckets[ $i ] += $block->{ 'COUNT' }; $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] ); } @@ -293,9 +353,9 @@ sub track_histogram color => 'green', title => "Features: $buckets[ $i ]", x1 => $x, - y1 => $y_offset + $hist_height, + y1 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height, x2 => $x, - y2 => $y_offset + $hist_height - $h, + y2 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height - $h, }; } } @@ -304,10 +364,79 @@ sub track_histogram } } + $draw_metrics->{ 'TRACK_OFFSET' } += $hist_height + $draw_metrics->{ 'TRACK_SPACE' }; + return wantarray ? @hist : \@hist; } +sub path_seq +{ + my ( $cookie, + ) = @_; + + # Returns a string. + + my ( $path ); + + die qq(ERROR: no DEF_USER in cookie.\n) if not exists $cookie->{ 'DEF_USER' }; + die qq(ERROR: no DEF_CLADE in cookie.\n) if not exists $cookie->{ 'DEF_CLADE' }; + die qq(ERROR: no DEF_GENOME in cookie.\n) if not exists $cookie->{ 'DEF_GENOME' }; + die qq(ERROR: no DEF_ASSEMBLY in cookie.\n) if not exists $cookie->{ 'DEF_ASSEMBLY' }; + die qq(ERROR: no DEF_CONTIG in cookie.\n) if not exists $cookie->{ 'DEF_CONTIG' }; + + $path = join( "/", + $cookie->{ 'DATA_DIR' }, + "Users", + $cookie->{ 'DEF_USER' }, + $cookie->{ 'DEF_CLADE' }, + $cookie->{ 'DEF_GENOME' }, + $cookie->{ 'DEF_ASSEMBLY' }, + $cookie->{ 'DEF_CONTIG' }, + "Sequence", + "sequence.txt" + ); + + die qq(ERROR: no such file: "$path".\n) if not -e $path; + + return $path; +} + + +sub path_tracks +{ + my ( $cookie, + ) = @_; + + # Returns a list. + # + my ( $path, @tracks ); + + die qq(ERROR: no DEF_USER in cookie.\n) if not exists $cookie->{ 'DEF_USER' }; + die qq(ERROR: no DEF_CLADE in cookie.\n) if not exists $cookie->{ 'DEF_CLADE' }; + die qq(ERROR: no DEF_GENOME in cookie.\n) if not exists $cookie->{ 'DEF_GENOME' }; + die qq(ERROR: no DEF_ASSEMBLY in cookie.\n) if not exists $cookie->{ 'DEF_ASSEMBLY' }; + die qq(ERROR: no DEF_CONTIG in cookie.\n) if not exists $cookie->{ 'DEF_CONTIG' }; + + $path = join( "/", + $cookie->{ 'DATA_DIR' }, + "Users", + $cookie->{ 'DEF_USER' }, + $cookie->{ 'DEF_CLADE' }, + $cookie->{ 'DEF_GENOME' }, + $cookie->{ 'DEF_ASSEMBLY' }, + $cookie->{ 'DEF_CONTIG' }, + "Tracks", + ); + + @tracks = Maasha::Filesys::ls_dirs( $path ); + + @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks; + + return wantarray ? @tracks : \@tracks; +} + # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1; + diff --git a/www/cgi-bin/index.cgi b/www/cgi-bin/index.cgi index 01a0011..e4420e8 100755 --- a/www/cgi-bin/index.cgi +++ b/www/cgi-bin/index.cgi @@ -39,17 +39,11 @@ use Maasha::KISS::IO; use Maasha::KISS::Track; use Maasha::KISS::Draw; -my ( $cgi, $database, $user, $password, $dbh, $script, @html ); +my ( $cgi, $cookie, $script, @html ); -$cgi = new CGI; - -$database = 'S_aur_COL'; -$user = Maasha::Biopieces::biopiecesrc( "MYSQL_USER" ); -$password = Maasha::Biopieces::biopiecesrc( "MYSQL_PASSWORD" ); - -$dbh = Maasha::SQL::connect( $database, $user, $password ); - -$script = Maasha::Common::get_scriptname(); +$cgi = new CGI; +$script = Maasha::Common::get_scriptname(); +$cookie = cookie_default( $cgi );; push @html, Maasha::XHTML::html_header( cgi_header => 1, @@ -64,8 +58,8 @@ push @html, Maasha::XHTML::html_header( push @html, Maasha::XHTML::h1( txt => "KISS Genome Browser", class => 'center' ); push @html, Maasha::XHTML::form_beg( action => $script, method => "get", enctype => "multipart/form-data" ); -push @html, sec_navigate( $cgi ); -push @html, sec_browse( $dbh, $cgi ); +push @html, sec_navigate( $cookie ); +push @html, sec_browse( $cookie ); push @html, Maasha::XHTML::form_end; push @html, Maasha::XHTML::body_end; @@ -77,435 +71,447 @@ print "$_\n" foreach @html; # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -sub sec_navigate +sub cookie_default { my ( $cgi, # CGI object ) = @_; - # Returns a list. + # Returns a hash - my ( $list_clade, $list_genome, $list_assembly, $list_contig, $def_clade, $def_genome, $def_assembly, $def_contig, $def_start, $def_end, @html ); + my ( $cookie ); - $list_clade = nav_list_clade(); - $list_genome = nav_list_genome(); - $list_assembly = nav_list_assembly(); - $list_contig = nav_list_contig(); + $cookie = {}; - nav_zoom( $cgi ); - nav_move( $cgi, 2_800_000 ); # FIXME + $cookie->{ 'DATA_DIR' } = "Data"; - $def_clade = nav_def_clade( $cgi ); - $def_genome = nav_def_genome( $cgi ); - $def_assembly = nav_def_assembly( $cgi ); - $def_contig = nav_def_contig( $cgi ); - $def_start = nav_def_start( $cgi ); - $def_end = nav_def_end( $cgi ); + cookie_cgi( $cookie, $cgi ); + cookie_user( $cookie ); + cookie_clade( $cookie ); + cookie_genome( $cookie ); + cookie_assembly( $cookie ); + cookie_contig( $cookie ); + cookie_start( $cookie ); + cookie_end( $cookie ); + cookie_zoom( $cookie ); + cookie_move( $cookie ); - push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' ); - push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Clade Genome Assembly Contig Start End ) ], align => 'center' ); - push @html, Maasha::XHTML::table_row_simple( tr => [ - Maasha::XHTML::menu( name => "nav_clade", options => $list_clade, selected => $def_clade ), - Maasha::XHTML::menu( name => "nav_genome", options => $list_genome, selected => $def_genome ), - Maasha::XHTML::menu( name => "nav_assembly", options => $list_assembly, selected => $def_assembly ), - Maasha::XHTML::menu( name => "nav_contig", options => $list_contig, selected => $def_contig ), - Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $def_start ), size => 20 ), - Maasha::XHTML::text( name => "nav_end", value => Maasha::Calc::commify( $def_end ), size => 20 ), - Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ), - ] ); - push @html, Maasha::XHTML::table_end; + # print STDERR Dumper( $cookie ); - push @html, Maasha::XHTML::table_beg( summary => "Zoom table", align => 'center' ); - push @html, Maasha::XHTML::table_row_simple( tr => [ - Maasha::XHTML::p( txt => 'Move:' ), - Maasha::XHTML::submit( name => "move_left3", value => "<<<", title => "move 95% to the left" ), - Maasha::XHTML::submit( name => "move_left2", value => "<<", title => "move 47.5% to the left" ), - Maasha::XHTML::submit( name => "move_left1", value => "<", title => "move 10% to the left" ), - Maasha::XHTML::submit( name => "move_right1", value => ">", title => "move 10% to the rigth" ), - Maasha::XHTML::submit( name => "move_right2", value => ">>", title => "move 47.5% to the rigth" ), - Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ), - Maasha::XHTML::p( txt => 'Zoom in:' ), - Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ), - Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ), - Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ), - Maasha::XHTML::p( txt => 'Zoom out:' ), - Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ), - Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ), - Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ), - ] ); - push @html, Maasha::XHTML::table_end; - - @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'navigate' ); - - return wantarray ? @html : \@html; + return wantarray ? %{ $cookie } : $cookie; } -sub sec_browse +sub cookie_cgi { - my ( $dbh, # Database handle - $cgi, # CGI object + my ( $cookie, + $cgi, ) = @_; - # Returns a list. - - my ( $t0, $t1, @stats, $start, $end, $ruler, $index, $index_beg, $index_len, $fh, $seq, $dna, $table, $entries, $features, $surface, $cr, $file, @html, @img ); - - $start = $cgi->param( 'nav_start' ); - $end = $cgi->param( 'nav_end' ); - - $ruler = Maasha::KISS::Track::track_ruler( 1200, 25, $start, $end, 10, 'black' ); - - $index = Maasha::Fasta::index_retrieve( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.index" ); - - ( $index_beg, $index_len ) = @{ $index->{ 'S_aur_COL' } }; - - $fh = Maasha::Filesys::file_read_open( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.fna" ); - - $seq = Maasha::Filesys::file_read( $fh, $index_beg + $start, $end - $start + 1 ); - - close $fh; - - $dna = Maasha::KISS::Track::track_seq( 1200, 50, $seq, 10, 'black' ) if length $seq <= 220; + # Returns nothing. + + $cookie->{ 'DEF_CLADE' } = $cgi->param( 'nav_clade' ); + $cookie->{ 'DEF_GENOME' } = $cgi->param( 'nav_genome' ); + $cookie->{ 'DEF_ASSEMBLY' } = $cgi->param( 'nav_assembly' ); + $cookie->{ 'DEF_CONTIG' } = $cgi->param( 'nav_contig' ); + $cookie->{ 'NAV_START' } = $cgi->param( 'nav_start' ); + $cookie->{ 'NAV_END' } = $cgi->param( 'nav_end' ); + $cookie->{ 'ZOOM_IN1' } = $cgi->param( 'zoom_in1' ); + $cookie->{ 'ZOOM_IN2' } = $cgi->param( 'zoom_in2' ); + $cookie->{ 'ZOOM_IN3' } = $cgi->param( 'zoom_in3' ); + $cookie->{ 'ZOOM_OUT1' } = $cgi->param( 'zoom_out1' ); + $cookie->{ 'ZOOM_OUT2' } = $cgi->param( 'zoom_out2' ); + $cookie->{ 'ZOOM_OUT3' } = $cgi->param( 'zoom_out3' ); + $cookie->{ 'MOVE_LEFT1' } = $cgi->param( 'move_left1' ); + $cookie->{ 'MOVE_LEFT2' } = $cgi->param( 'move_left2' ); + $cookie->{ 'MOVE_LEFT3' } = $cgi->param( 'move_left3' ); + $cookie->{ 'MOVE_RIGHT1' } = $cgi->param( 'move_right1' ); + $cookie->{ 'MOVE_RIGHT2' } = $cgi->param( 'move_right2' ); + $cookie->{ 'MOVE_RIGHT3' } = $cgi->param( 'move_right3' ); +} - $table = 'Solexa'; - $t0 = Time::HiRes::gettimeofday(); - $entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $start, $end ); - $t1 = Time::HiRes::gettimeofday(); +sub cookie_user +{ + my ( $cookie, + ) = @_; - push @stats, "Feature count: " . Maasha::Calc::commify( scalar @$entries ); - push @stats, "Time SQL: " . sprintf( "%.4f", $t1 - $t0 ); + # Returns nothing. + + my ( @dirs, $dir ); - $t0 = Time::HiRes::gettimeofday(); + @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users" ); - my $MAX = 4000; # FIXME should depend on height of track as well + foreach $dir ( @dirs ) + { + next if $dir =~ /\/\.\.?$/; - if ( @$entries > $MAX ) { - $features = Maasha::KISS::Track::track_histogram( 1200, 75, $start, $end, $entries ); - } else { - $features = Maasha::KISS::Track::track_feature( 1200, 75, $start, $end, $entries ); + push @{ $cookie->{ 'LIST_USER' } }, ( split "/", $dir )[ -1 ]; } - $t1 = Time::HiRes::gettimeofday(); - - # push @html, Maasha::KISS::Draw::hdump( $entries ); - # push @html, Maasha::KISS::Draw::hdump( $features ); - - push @stats, "Time Track: " . sprintf( "%.4f", $t1 - $t0 ); - - $file = "fisk.png"; - - $surface = Cairo::ImageSurface->create( 'argb32', 1200, 800 ); - $cr = Cairo::Context->create( $surface ); - - $t0 = Time::HiRes::gettimeofday(); - - Maasha::KISS::Draw::draw_feature( $cr, $ruler ) if $ruler; - Maasha::KISS::Draw::draw_feature( $cr, $dna ) if $dna; - Maasha::KISS::Draw::draw_feature( $cr, $features ) if $features; - - Maasha::KISS::Draw::file_png( $surface, $file ); - - $t1 = Time::HiRes::gettimeofday(); - - push @stats, "Time Draw: " . sprintf( "%.4f", $t1 - $t0 ); - - push @html, Maasha::XHTML::p( txt => join( " ", @stats ) ); - - push @img, Maasha::XHTML::img( src => $file, alt => "Browser Tracks", height => 800, width => 1200, id => "browser_map", usemap => "#browser_map" ); - - push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" ); - - map { push @img, Maasha::XHTML::area( href => "www.dmi.dk", shape => "rect", coords => "$_->{ x1 }, $_->{ y1 }, $_->{ x2 }, $_->{ y2 }", title => "$_->{ title }" ) } @{ $features }; - - push @img, Maasha::XHTML::map_end(); - - push @html, Maasha::XHTML::p( txt => join( "\n", @img ) ); - - @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'browse' ); - - return wantarray ? @html : \@html; + $cookie->{ 'DEF_USER' } = $cookie->{ 'LIST_USER' }->[ 0 ]; } -sub nav_list_clade +sub cookie_clade { - my ( @dirs, $dir, @list_clade ); + my ( $cookie, + ) = @_; + + # Returns nothing. + + my ( $user, @dirs, $dir ); - @dirs = Maasha::Filesys::ls_dirs( "Data" ); + $user = $cookie->{ 'DEF_USER' }; + + @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user" ); foreach $dir ( @dirs ) { - next if $dir eq "Data/." or $dir eq "Data/.."; + next if $dir =~ /\/\.\.?$/; - push @list_clade, ( split "/", $dir )[ -1 ]; + push @{ $cookie->{ 'LIST_CLADE' } }, ( split "/", $dir )[ -1 ]; } - return wantarray ? @list_clade : \@list_clade; + if ( not defined $cookie->{ 'DEF_CLADE' } ) { + $cookie->{ 'DEF_CLADE' } = $cookie->{ 'LIST_CLADE' }->[ 1 ]; + } } -sub nav_list_genome +sub cookie_genome { - my ( $list_genome ); + my ( $cookie, + ) = @_; - $list_genome = [ qw( S.aur_COL E.col B.sub ) ]; + # Returns nothing. + + my ( $user, $clade, @dirs, $dir ); - return wantarray ? @{ $list_genome } : $list_genome; -} + $user = $cookie->{ 'DEF_USER' }; + $clade = $cookie->{ 'DEF_CLADE' }; + @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade" ); -sub nav_list_assembly -{ - my ( $list_assembly ); + foreach $dir ( @dirs ) + { + next if $dir =~ /\/\.\.?$/; - $list_assembly = [ qw( 2008-02-21 2009-01-23 ) ]; + push @{ $cookie->{ 'LIST_GENOME' } }, ( split "/", $dir )[ -1 ]; + } - return wantarray ? @{ $list_assembly } : $list_assembly; + if ( not defined $cookie->{ 'DEF_GENOME' } ) { + $cookie->{ 'DEF_GENOME' } = $cookie->{ 'LIST_GENOME' }->[ 0 ]; + } } -sub nav_list_contig +sub cookie_assembly { - my ( $list_contig ); - - $list_contig = [ qw( chr1 chr2 ) ]; - - return wantarray ? @{ $list_contig } : $list_contig; -} + my ( $cookie, + ) = @_; + # Returns nothing. + + my ( $user, $clade, $genome, @dirs, $dir ); -sub nav_zoom -{ - my ( $cgi, # CGI object - ) = @_; + $user = $cookie->{ 'DEF_USER' }; + $clade = $cookie->{ 'DEF_CLADE' }; + $genome = $cookie->{ 'DEF_GENOME' }; - my ( $start, $end, $dist, $new_dist, $dist_diff, $new_start, $new_end ); + @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome" ); - if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) ) + foreach $dir ( @dirs ) { - $start = $cgi->param( 'nav_start' ); - $end = $cgi->param( 'nav_end' ); - - $start =~ tr/,//d; - $end =~ tr/,//d; - - $dist = $end - $start; - - if ( defined $cgi->param( 'zoom_in1' ) ) { - $new_dist = $dist / 1.5; - } elsif ( defined $cgi->param( 'zoom_in2' ) ) { - $new_dist = $dist / 3; - } elsif ( defined $cgi->param( 'zoom_in3' ) ) { - $new_dist = $dist / 10; - } elsif ( defined $cgi->param( 'zoom_out1' ) ) { - $new_dist = $dist * 1.5; - } elsif ( defined $cgi->param( 'zoom_out2' ) ) { - $new_dist = $dist * 3; - } elsif ( defined $cgi->param( 'zoom_out3' ) ) { - $new_dist = $dist * 10; - } + next if $dir =~ /\/\.\.?$/; - if ( $new_dist ) - { - $dist_diff = $dist - $new_dist; - $new_start = int( $start + ( $dist_diff / 2 ) ); - $new_end = int( $end - ( $dist_diff / 2 ) ); + push @{ $cookie->{ 'LIST_ASSEMBLY' } }, ( split "/", $dir )[ -1 ]; + } - $cgi->param( 'nav_start', $new_start ); - $cgi->param( 'nav_end', $new_end ); - } + if ( not defined $cookie->{ 'DEF_ASSEMBLY' } ) { + $cookie->{ 'DEF_ASSEMBLY' } = $cookie->{ 'LIST_ASSEMBLY' }->[ 0 ]; } } -sub nav_move +sub cookie_contig { - my ( $cgi, # CGI object - $max, # Max end position + my ( $cookie, ) = @_; - my ( $start, $end, $dist, $shift, $new_start, $new_end ); + # Returns nothing. + + my ( $user, $clade, $genome, $assembly, @dirs, $dir ); - if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) ) - { - $start = $cgi->param( 'nav_start' ); - $end = $cgi->param( 'nav_end' ); - - $start =~ tr/,//d; - $end =~ tr/,//d; - - $dist = $end - $start; - - if ( defined $cgi->param( 'move_left1' ) ) { - $shift = -1 * $dist * 0.10; - } elsif ( defined $cgi->param( 'move_left2' ) ) { - $shift = -1 * $dist * 0.475; - } elsif ( defined $cgi->param( 'move_left3' ) ) { - $shift = -1 * $dist * 0.95; - } elsif ( defined $cgi->param( 'move_right1' ) ) { - $shift = $dist * 0.10; - } elsif ( defined $cgi->param( 'move_right2' ) ) { - $shift = $dist * 0.475; - } elsif ( defined $cgi->param( 'move_right3' ) ) { - $shift = $dist * 0.95; - } + $user = $cookie->{ 'DEF_USER' }; + $clade = $cookie->{ 'DEF_CLADE' }; + $genome = $cookie->{ 'DEF_GENOME' }; + $assembly = $cookie->{ 'DEF_ASSEMBLY' }; - if ( $shift ) - { - $new_start = int( $start + $shift ); - $new_end = int( $end + $shift ); + @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome/$assembly" ); - print "HERRRR: shift: $shift start: $new_start end: $new_end\n"; + foreach $dir ( @dirs ) + { + next if $dir =~ /\/\.\.?$/; - if ( $new_start > 0 and $new_end < $max ) - { - $cgi->param( 'nav_start', $new_start ); - $cgi->param( 'nav_end', $new_end ); - } - } + push @{ $cookie->{ 'LIST_CONTIG' } }, ( split "/", $dir )[ -1 ]; + } + + if ( not defined $cookie->{ 'DEF_CONTIG' } ) { + $cookie->{ 'DEF_CONTIG' } = $cookie->{ 'LIST_CONTIG' }->[ 0 ]; } } -sub nav_def_clade +sub cookie_start { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_clade ); + # Returns nothing. - if ( defined $cgi->param( 'nav_clade' ) ) + if ( defined $cookie->{ 'NAV_START' } ) { - $def_clade = $cgi->param( 'nav_clade' ); + $cookie->{ 'NAV_START' } =~ tr/,//d; + $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0; } else { - $def_clade = "Bacteria"; + $cookie->{ 'NAV_START' } = 1; } - - return $def_clade; } -sub nav_def_genome +sub cookie_end { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_genome ); + # Returns nothing. - if ( defined $cgi->param( 'nav_genome' ) ) + my ( $max ); + + $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) ); + + if ( defined $cookie->{ 'NAV_END' } ) { - $def_genome = $cgi->param( 'nav_genome' ); + $cookie->{ 'NAV_END' } =~ tr/,//d; + $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max; } else { - $def_genome = "S.aur_COL"; + $cookie->{ 'NAV_END' } = $max; } - - return $def_genome; } -sub nav_def_assembly +sub cookie_zoom { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_assembly ); + # Returns nothing. - if ( defined $cgi->param( 'nav_assembly' ) ) - { - $def_assembly = $cgi->param( 'nav_assembly' ); + my ( $max, $dist, $new_dist, $dist_diff ); + + $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) ); + + $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' }; + + if ( defined $cookie->{ 'ZOOM_IN1' } ) { + $new_dist = $dist / 1.5; + } elsif ( defined $cookie->{ 'ZOOM_IN2' } ) { + $new_dist = $dist / 3; + } elsif ( defined $cookie->{ 'ZOOM_IN3' } ) { + $new_dist = $dist / 10; + } elsif ( defined $cookie->{ 'ZOOM_OUT1' } ) { + $new_dist = $dist * 1.5; + } elsif ( defined $cookie->{ 'ZOOM_OUT2' } ) { + $new_dist = $dist * 3; + } elsif ( defined $cookie->{ 'ZOOM_OUT3' } ) { + $new_dist = $dist * 10; } - else + + if ( $new_dist ) { - $def_assembly = "2009-01-23"; - } + $dist_diff = $dist - $new_dist; + + $cookie->{ 'NAV_START' } = int( $cookie->{ 'NAV_START' } + ( $dist_diff / 2 ) ); + $cookie->{ 'NAV_END' } = int( $cookie->{ 'NAV_END' } - ( $dist_diff / 2 ) ); - return $def_assembly; + $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0; + $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max; + } } -sub nav_def_contig +sub cookie_move { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_contig ); + my ( $max, $dist, $shift, $new_start, $new_end ); - if ( defined $cgi->param( 'nav_contig' ) ) - { - $def_contig = $cgi->param( 'nav_contig' ); + $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) ); + + $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' }; + + if ( defined $cookie->{ 'MOVE_LEFT1' } ) { + $shift = -1 * $dist * 0.10; + } elsif ( defined $cookie->{ 'MOVE_LEFT2' } ) { + $shift = -1 * $dist * 0.475; + } elsif ( defined $cookie->{ 'MOVE_LEFT3' } ) { + $shift = -1 * $dist * 0.95; + } elsif ( defined $cookie->{ 'MOVE_RIGHT1' } ) { + $shift = $dist * 0.10; + } elsif ( defined $cookie->{ 'MOVE_RIGHT2' } ) { + $shift = $dist * 0.475; + } elsif ( defined $cookie->{ 'MOVE_RIGHT3' } ) { + $shift = $dist * 0.95; } - else + + if ( $shift ) { - $def_contig = "chr1"; - } + $new_start = int( $cookie->{ 'NAV_START' } + $shift ); + $new_end = int( $cookie->{ 'NAV_END' } + $shift ); - return $def_contig; + if ( $new_start > 0 and $new_end < $max ) + { + $cookie->{ 'NAV_START' } = $new_start; + $cookie->{ 'NAV_END' } = $new_end; + } + } } -sub nav_def_start +sub sec_navigate { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_start ); + # Returns a list. - if ( defined $cgi->param( 'nav_start' ) ) { - $def_start = $cgi->param( 'nav_start' ); - } else { - $def_start = 1; - } + my ( @html ); - $def_start =~ tr/,//d; + push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' ); + push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Clade Genome Assembly Contig Start End ) ], align => 'center' ); + push @html, Maasha::XHTML::table_row_simple( tr => [ + Maasha::XHTML::menu( name => "nav_clade", options => $cookie->{ 'LIST_CLADE' }, selected => $cookie->{ 'DEF_CLADE' } ), + Maasha::XHTML::menu( name => "nav_genome", options => $cookie->{ 'LIST_GENOME' }, selected => $cookie->{ 'DEF_GENOME' } ), + Maasha::XHTML::menu( name => "nav_assembly", options => $cookie->{ 'LIST_ASSEMBLY' }, selected => $cookie->{ 'DEF_ASSEMBLY' } ), + Maasha::XHTML::menu( name => "nav_contig", options => $cookie->{ 'LIST_CONTIG' }, selected => $cookie->{ 'DEF_CONTIG' } ), + Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 20 ), + Maasha::XHTML::text( name => "nav_end", value => Maasha::Calc::commify( $cookie->{ 'NAV_END' } ), size => 20 ), + Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ), + ] ); + push @html, Maasha::XHTML::table_end; - if ( $def_start <= 0 ) { - $def_start = 1; - } + push @html, Maasha::XHTML::table_beg( summary => "Zoom table", align => 'center' ); + push @html, Maasha::XHTML::table_row_simple( tr => [ + Maasha::XHTML::p( txt => 'Move:' ), + Maasha::XHTML::submit( name => "move_left3", value => "<<<", title => "move 95% to the left" ), + Maasha::XHTML::submit( name => "move_left2", value => "<<", title => "move 47.5% to the left" ), + Maasha::XHTML::submit( name => "move_left1", value => "<", title => "move 10% to the left" ), + Maasha::XHTML::submit( name => "move_right1", value => ">", title => "move 10% to the rigth" ), + Maasha::XHTML::submit( name => "move_right2", value => ">>", title => "move 47.5% to the rigth" ), + Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ), + Maasha::XHTML::p( txt => 'Zoom in:' ), + Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ), + Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ), + Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ), + Maasha::XHTML::p( txt => 'Zoom out:' ), + Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ), + Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ), + Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ), + ] ); + push @html, Maasha::XHTML::table_end; - $cgi->param( 'nav_start', $def_start ); + @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'navigate' ); - return $def_start; + return wantarray ? @html : \@html; } -sub nav_def_end +sub sec_browse { - my ( $cgi, # CGI object + my ( $cookie, ) = @_; - my ( $def_end ); + # Returns a list. + + my ( $draw_metrics, @tracks, @features, $feat, $elem, $file, $surface, $cr, @html, @img ); + + $draw_metrics = { + IMG_WIDTH => 1200, + IMG_HEIGHT => 800, + TRACK_OFFSET => 20, + TRACK_SPACE => 20, + RULER_FONT_SIZE => 10, + RULER_COLOR => 'black', + SEQ_FONT_SIZE => 10, + SEQ_COLOR => 'black', + FEAT_WIDTH => 5, + }; - if ( defined $cgi->param( 'nav_end' ) ) { - $def_end = $cgi->param( 'nav_end' ); - } else { - $def_end = 2809422; - $def_end = 2000; + push @features, [ Maasha::KISS::Track::track_ruler( $draw_metrics, $cookie ) ]; + push @features, [ Maasha::KISS::Track::track_seq( $draw_metrics, $cookie ) ]; + + @tracks = Maasha::KISS::Track::path_tracks( $cookie ); + + map { push @features, [ Maasha::KISS::Track::track_feature( $_, $draw_metrics, $cookie ) ] } @tracks; + + $file = "fisk.png"; + + $surface = Cairo::ImageSurface->create( 'argb32', $draw_metrics->{ 'IMG_WIDTH' }, $draw_metrics->{ 'TRACK_OFFSET' } ); + $cr = Cairo::Context->create( $surface ); + + foreach $feat ( @features ) { + Maasha::KISS::Draw::draw_feature( $cr, $feat ) if $feat; } - $def_end =~ tr/,//d; + Maasha::KISS::Draw::file_png( $surface, $file ); + + push @img, Maasha::XHTML::img( + src => $file, + alt => "Browser Tracks", + height => $draw_metrics->{ 'TRACK_OFFSET' }, + width => $draw_metrics->{ 'IMG_WIDTH' }, + id => "browser_map", + usemap => "#browser_map" + ); - if ( $def_end > 2809422 ) { - $def_end = 2809422; + push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" ); + + foreach $feat ( @features ) + { + foreach $elem ( @{ $feat } ) + { + next if not $elem->{ 'type' } eq 'line'; + + push @img, Maasha::XHTML::area( + href => "www.dmi.dk", + shape => "rect", + coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }", + ); + } } - $cgi->param( 'nav_end', $def_end ); + push @img, Maasha::XHTML::map_end(); + + push @html, Maasha::XHTML::p( txt => join( "\n", @img ) ); + + @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'browse' ); - return $def_end; + return wantarray ? @html : \@html; } # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -END -{ - Maasha::SQL::disconnect( $dbh ) if $dbh; -} +__END__ + # push @html, Maasha::KISS::Draw::hdump( $entries ); + # push @html, Maasha::KISS::Draw::hdump( $features ); -__END__ + $t0 = Time::HiRes::gettimeofday(); + $t1 = Time::HiRes::gettimeofday(); -- 2.39.2