[Bio] / FigKernelPackages / gjoseqlib.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/gjoseqlib.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6, Sun Jun 10 17:24:38 2007 UTC revision 1.8, Tue Jun 26 15:20:16 2007 UTC
# Line 1  Line 1 
1  package gjoseqlib;  package gjoseqlib;
2    use Carp;
3    
4  #  A sequence entry is ( $id, $def, $seq )  #  A sequence entry is ( $id, $def, $seq )
5  #  A list of entries is a list of references  #  A list of entries is a list of references
# Line 81  Line 82 
82  #  Convert GenBank locations to SEED locations  #  Convert GenBank locations to SEED locations
83  #  #
84  #  @seed_locs = gb_location_2_seed( $contig, @gb_locs )  #  @seed_locs = gb_location_2_seed( $contig, @gb_locs )
85    #
86    #  Read quality scores from a fasta-like file:
87    #
88    #  @seq_entries = read_qual( )               #  STDIN
89    # \@seq_entries = read_qual( )               #  STDIN
90    #  @seq_entries = read_qual( \*FILEHANDLE )
91    # \@seq_entries = read_qual( \*FILEHANDLE )
92    #  @seq_entries = read_qual(  $filename )
93    # \@seq_entries = read_qual(  $filename )
94    #
95    
96  use strict;  use strict;
97    
 use gjolib qw( wrap_text );  
   
98  #  Exported global variables:  #  Exported global variables:
99    
100  our @aa_1_letter_order;  # Alpha by 1 letter  our @aa_1_letter_order;  # Alpha by 1 letter
# Line 152  Line 160 
160          reverse_intervals          reverse_intervals
161    
162          gb_location_2_seed          gb_location_2_seed
163    
164            read_qual
165          );          );
166    
167  our @EXPORT_OK = qw(  our @EXPORT_OK = qw(
# Line 430  Line 440 
440      my ( $fh, undef, $close, $unused ) = output_filehandle( shift );      my ( $fh, undef, $close, $unused ) = output_filehandle( shift );
441      ( unshift @_, $unused ) if $unused;      ( unshift @_, $unused ) if $unused;
442    
443      ( ref( $_[0] ) eq "ARRAY" ) or die "Bad sequence entry passed to print_alignment_as_fasta\n";      ( ref( $_[0] ) eq "ARRAY" ) or confess "Bad sequence entry passed to print_alignment_as_fasta\n";
444    
445      #  Expand the sequence entry list if necessary:      #  Expand the sequence entry list if necessary:
446    
# Line 633  Line 643 
643    
644    
645  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
646    #  Return a string with text wrapped to defined line lengths:
647    #
648    #     $wrapped_text = wrap_text( $str )                  # default len   =  80
649    #     $wrapped_text = wrap_text( $str, $len )            # default ind   =   0
650    #     $wrapped_text = wrap_text( $str, $len, $indent )   # default ind_n = ind
651    #     $wrapped_text = wrap_text( $str, $len, $indent_1, $indent_n )
652    #-----------------------------------------------------------------------------
653    sub wrap_text {
654        my ($str, $len, $ind, $indn) = @_;
655    
656        defined($str)  || die "wrap_text called without a string\n";
657        defined($len)  || ($len  =   80);
658        defined($ind)  || ($ind  =    0);
659        ($ind  < $len) || die "wrap error: indent greater than line length\n";
660        defined($indn) || ($indn = $ind);
661        ($indn < $len) || die "wrap error: indent_n greater than line length\n";
662    
663        $str =~ s/\s+$//;
664        $str =~ s/^\s+//;
665        my ($maxchr, $maxchr1);
666        my (@lines) = ();
667    
668        while ($str) {
669            $maxchr1 = ($maxchr = $len - $ind) - 1;
670            if ($maxchr >= length($str)) {
671                push @lines, (" " x $ind) . $str;
672                last;
673            }
674            elsif ($str =~ /^(.{0,$maxchr1}\S)\s+(\S.*)$/) { # no expr in {}
675                push @lines, (" " x $ind) . $1;
676                $str = $2;
677            }
678            elsif ($str =~ /^(.{0,$maxchr1}-)(.*)$/) {
679                push @lines, (" " x $ind) . $1;
680                $str = $2;
681            }
682            else {
683                push @lines, (" " x $ind) . substr($str, 0, $maxchr);
684                $str = substr($str, $maxchr);
685            }
686            $ind = $indn;
687        }
688    
689        return join("\n", @lines);
690    }
691    
692    
693    #-----------------------------------------------------------------------------
694  #  Build an index from seq_id to pointer to sequence entry: (id, desc, seq)  #  Build an index from seq_id to pointer to sequence entry: (id, desc, seq)
695  #  #
696  #     my \%seq_ind  = index_seq_list(  @seq_list );  #     my \%seq_ind  = index_seq_list(  @seq_list );
# Line 1676  Line 1734 
1734  }  }
1735    
1736    
1737    #-----------------------------------------------------------------------------
1738    #  Read qual.
1739    #
1740    #  Save the contents in a list of refs to arrays: [ $id, $descript, \@qual ]
1741    #
1742    #     @seq_entries = read_qual( )               #  STDIN
1743    #    \@seq_entries = read_qual( )               #  STDIN
1744    #     @seq_entries = read_qual( \*FILEHANDLE )
1745    #    \@seq_entries = read_qual( \*FILEHANDLE )
1746    #     @seq_entries = read_qual(  $filename )
1747    #    \@seq_entries = read_qual(  $filename )
1748    #-----------------------------------------------------------------------------
1749    sub read_qual {
1750        my ( $fh, $name, $close, $unused ) = input_filehandle( $_[0] );
1751        $unused && die "Bad reference type (" . ref( $unused ) . ") passed to read_qual\n";
1752    
1753        my @quals = ();
1754        my ($id, $desc, $qual) = ("", "", []);
1755    
1756        while ( <$fh> ) {
1757            chomp;
1758            if (/^>\s*(\S+)(\s+(.*))?$/) {        #  new id
1759                if ($id && @$qual) { push @quals, [ $id, $desc, $qual ] }
1760                ($id, $desc, $qual) = ($1, $3 ? $3 : "", []);
1761            }
1762            else {
1763                push @$qual, split;
1764            }
1765        }
1766        close( $fh ) if $close;
1767    
1768        if ($id && @$qual) { push @quals, [ $id, $desc, $qual ] }
1769        return wantarray ? @quals : \@quals;
1770    }
1771    
1772    
1773  1;  1;

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.8

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3