From: martinahansen Date: Tue, 5 Jan 2010 18:57:08 +0000 (+0000) Subject: cleanup of BGB X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=5f74f8344cff325230c24eaa216ac6cf286adcf8;p=biopieces.git cleanup of BGB git-svn-id: http://biopieces.googlecode.com/svn/trunk@830 74ccb610-7750-0410-82ae-013aeee3265d --- diff --git a/bp_bin/intersect_records b/bp_bin/intersect_records new file mode 100755 index 0000000..81a390b --- /dev/null +++ b/bp_bin/intersect_records @@ -0,0 +1,126 @@ +#!/usr/bin/env perl + +# Copyright (C) 2007-2009 Martin A. Hansen. + +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +# http://www.gnu.org/copyleft/gpl.html + + +# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +# Intersect records in the stream based on overlapping intervals contained in values to specific keys. + +# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + +use warnings; +use strict; +use Maasha::Biopieces; +use Data::Dumper; + + +# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + +my ( $options, $in, $out, $record, $opt_key, $opt_strand, $found, $pos, $lookup_hash ); + +$options = Maasha::Biopieces::parse_options( + [ + { long => 'key', short => 'k', type => 'string', mandatory => 'yes', default => undef, allowed => undef, disallowed => undef }, + { long => 'strand', short => 's', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef }, + { long => 'inverse', short => 'i', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef }, + ] +); + +$in = Maasha::Biopieces::read_stream( $options->{ "stream_in" } ); +$out = Maasha::Biopieces::write_stream( $options->{ "stream_out" } ); + +$opt_key = $options->{ 'key' }; +$opt_strand = $options->{ 'strand' }; + +while ( $record = Maasha::Biopieces::get_record( $in ) ) +{ + if ( exists $record->{ 'S_ID' } and exists $record->{ 'S_BEG' } and exists $record->{ 'S_END' } ) + { + $record->{ 'STRAND' } ||= '.'; + + if ( exists $record->{ $opt_key } ) + { + map { $lookup_hash->{ $record->{ 'S_ID' } }->{ $record->{ 'STRAND' } }->{ $_ } = 1 } ( $record->{ 'S_BEG' } .. $record->{ 'S_END' } ); + } + else + { + $found = 0; + + foreach $pos ( $record->{ 'S_BEG' } .. $record->{ 'S_END' } ) + { + if ( $opt_strand ) + { + if ( exists $lookup_hash->{ $record->{ 'S_ID' } }->{ $record->{ 'STRAND' } }->{ $pos } ) + { + $found = 1; + + last; + } + } + else + { + if ( exists $lookup_hash->{ $record->{ 'S_ID' } }->{ '+' }->{ $pos } or + exists $lookup_hash->{ $record->{ 'S_ID' } }->{ '-' }->{ $pos } + ) + { + $found = 1; + + last; + } + } + } + + if ( ( $found and not $options->{ 'inverse' } ) or + ( not $found and $options->{ 'inverse' } ) + ) + { + Maasha::Biopieces::put_record( $record, $out ); + } + } + } +} + +# print Dumper( $lookup_hash ); + +Maasha::Biopieces::close_stream( $in ); +Maasha::Biopieces::close_stream( $out ); + + +# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + +BEGIN +{ + Maasha::Biopieces::status_set(); +} + + +END +{ + Maasha::Biopieces::status_log(); +} + + +# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + +__END__ diff --git a/code_perl/Maasha/BGB/Track.pm b/code_perl/Maasha/BGB/Track.pm index ae60c8b..64a3b6d 100644 --- a/code_perl/Maasha/BGB/Track.pm +++ b/code_perl/Maasha/BGB/Track.pm @@ -109,26 +109,30 @@ sub track_seq # Returns a list. - my ( $file, $fh, $seq, @chars, $factor, $i, @seq_list ); + my ( $file, $fh, $seq, @chars, $factor, $x_offset, $i, @seq_list ); - if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) + if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 ) # only add sequence if less than or equal to 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 ); + $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 ); close $fh; @chars = split //, $seq; $factor = $cookie->{ 'IMG_WIDTH' } / @chars; - for ( $i = 0; $i < @chars; $i++ ) { + $x_offset = sprintf( "%.0f", ( $factor / 2 ) - ( $cookie->{ 'SEQ_FONT_SIZE' } / 2 ) ); + $x_offset = 0 if $x_offset < 0; + + for ( $i = 0; $i < @chars; $i++ ) + { push @seq_list, { type => 'text', txt => $chars[ $i ], font_size => $cookie->{ 'SEQ_FONT_SIZE' }, color => $cookie->{ 'SEQ_COLOR' }, - x1 => sprintf( "%.0f", $i * $factor ), + x1 => sprintf( "%.0f", $x_offset + $i * $factor ), y1 => $cookie->{ 'TRACK_OFFSET' }, }; } diff --git a/www/index.cgi b/www/index.cgi index 99b535f..cebfc1c 100755 --- a/www/index.cgi +++ b/www/index.cgi @@ -579,7 +579,6 @@ sub page_browse push @html, section_taxonomy_table( $cookie ); push @html, section_navigate( $cookie ); push @html, section_browse( $cookie ); - push @html, section_permalink( $cookie ); return wantarray ? @html : \@html; } @@ -882,37 +881,6 @@ sub section_browse } -sub section_permalink -{ - # Martin A. Hansen, December 2009. - - # Return HTML with a permanent link to current browser view. - - my ( $cookie, # cookie hash - ) = @_; - - # Returns a list. - - my ( $href, @html ); - - $href = join( "&", - "$cookie->{ 'SCRIPT' }?page=browse", - "user=$cookie->{ 'USER' }", - "clade=$cookie->{ 'CLADE' }", - "genome=$cookie->{ 'GENOME' }", - "assembly=$cookie->{ 'ASSEMBLY' }", - "contig=$cookie->{ 'CONTIG' }", - "nav_start=$cookie->{ 'NAV_START' }", - "nav_end=$cookie->{ 'NAV_END' }", - "session_id=$cookie->{ 'SESSION_ID' }", - ); - - push @html, Maasha::XHTML::p( txt => Maasha::XHTML::ln( txt => "Permalink", href => $href ), class => 'center' ); - - return wantarray ? @html : \@html; -} - - sub section_export { # Martin A. Hansen, November 2009.