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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3