[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.17, Mon Jan 18 20:01:14 2010 UTC revision 1.18, Sun Aug 15 23:51:00 2010 UTC
# Line 153  Line 153 
153    
154  use strict;  use strict;
155  use Carp;  use Carp;
156    use Data::Dumper;
157    
158  #  Exported global variables:  #  Exported global variables:
159    
# Line 308  Line 309 
309  #    \@seq_entries = read_fasta(  $filename )  #    \@seq_entries = read_fasta(  $filename )
310  #  #  @seq_entries = read_fasta( "command |" )   #  open and read from pipe  #  #  @seq_entries = read_fasta( "command |" )   #  open and read from pipe
311  #  # \@seq_entries = read_fasta( "command |" )   #  open and read from pipe  #  # \@seq_entries = read_fasta( "command |" )   #  open and read from pipe
312    #     @seq_entries = read_fasta( \$string )      #  reference to file as string
313    #    \@seq_entries = read_fasta( \$string )      #  reference to file as string
314  #  #
315  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
316  sub read_fasta  sub read_fasta
317  {  {
318      my @seqs = map { $_->[2] =~ tr/ \n\r\t//d; $_ }      my @seqs;
319        if ( $_[0] && ref $_[0] eq 'SCALAR' )
320        {
321            @seqs = map { $_->[2] =~ tr/ \n\r\t//d; $_ }
322                    map { /^(\S+)([ \t]+([^\n]*\S)?\s*)?\n(.+)$/s ? [ $1, $3 || '', $4 ] : () }
323                    split /^>\s*/m, ${$_[0]};
324        }
325        else
326        {
327            @seqs = map { $_->[2] =~ tr/ \n\r\t//d; $_ }
328                 map { /^(\S+)([ \t]+([^\n]*\S)?\s*)?\n(.+)$/s ? [ $1, $3 || '', $4 ] : () }                 map { /^(\S+)([ \t]+([^\n]*\S)?\s*)?\n(.+)$/s ? [ $1, $3 || '', $4 ] : () }
329                 split /^>\s*/m, slurp( @_ );                 split /^>\s*/m, slurp( @_ );
330        }
331    
332      wantarray() ? @seqs : \@seqs;      wantarray() ? @seqs : \@seqs;
333  }  }
334    
# Line 353  Line 367 
367      else      else
368      {      {
369          $fh = \*STDIN;          $fh = \*STDIN;
370            $close = 0;
371      }      }
372    
373      my $out = '';      my $out = '';
# Line 560  Line 575 
575  #     string is taken as file name to be openend  #     string is taken as file name to be openend
576  #     undef or "" defaults to STDOUT  #     undef or "" defaults to STDOUT
577  #  #
578  #    ( \*FH, $name, $close [, $file] ) = output_filehandle( $file );  #    ( \*FH, $close [, $file] ) = output_filehandle( $file );
579  #  #
580  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
581  sub output_filehandle  sub output_filehandle
582  {  {
583      my $file = shift;      my $file = shift;
584    
585        #  Null string or undef
586    
587        return ( \*STDOUT, 0 ) if ( ! defined( $file ) || ( $file eq "" ) );
588    
589      #  FILEHANDLE      #  FILEHANDLE
590    
591      return ( $file, $file, 0 ) if ( ref( $file ) eq "GLOB" );      return ( $file, 0 ) if ( ref( $file ) eq "GLOB" );
592    
593      #  Null string or undef      #  Some other kind of reference; return the unused value
594    
595      return ( \*STDOUT, "", 0 ) if ( ! defined( $file ) || ( $file eq "" ) );      return ( \*STDOUT, 0, $file ) if ref( $file );
596    
597      #  File name      #  File name
598    
     if ( ! ref( $file ) )  
     {  
599          my $fh;          my $fh;
600          open( $fh, ">$file" ) || die "Could not open output $file\n";          open( $fh, ">$file" ) || die "Could not open output $file\n";
601          return ( $fh, $file, 1 );      return ( $fh, 1 );
     }  
   
     #  Some other kind of reference; return the unused value  
   
     return ( \*STDOUT, undef, 0, $file );  
602  }  }
603    
604    
# Line 610  Line 622 
622  #     print_alignment_as_fasta(  $filename,   \@seq_entry_list );  #     print_alignment_as_fasta(  $filename,   \@seq_entry_list );
623  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
624  sub print_alignment_as_fasta {  sub print_alignment_as_fasta {
625      my ( $fh, undef, $close, $unused ) = output_filehandle( shift );      my ( $fh, $close, $unused ) = output_filehandle( shift );
626      ( unshift @_, $unused ) if $unused;      ( unshift @_, $unused ) if $unused;
627    
628      ( ref( $_[0] ) eq "ARRAY" ) or confess "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";
# Line 637  Line 649 
649  #     print_alignment_as_phylip(  $filename,   \@seq_entry_list );  #     print_alignment_as_phylip(  $filename,   \@seq_entry_list );
650  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
651  sub print_alignment_as_phylip {  sub print_alignment_as_phylip {
652      my ( $fh, undef, $close, $unused ) = output_filehandle( shift );      my ( $fh, $close, $unused ) = output_filehandle( shift );
653      ( unshift @_, $unused ) if $unused;      ( unshift @_, $unused ) if $unused;
654    
655      ( ref( $_[0] ) eq "ARRAY" ) or die die "Bad sequence entry passed to print_alignment_as_phylip\n";      ( ref( $_[0] ) eq "ARRAY" ) or die die "Bad sequence entry passed to print_alignment_as_phylip\n";
# Line 696  Line 708 
708  #     print_alignment_as_nexus(  $filename,   [ \%label_hash, ] \@seq_entry_list );  #     print_alignment_as_nexus(  $filename,   [ \%label_hash, ] \@seq_entry_list );
709  #-----------------------------------------------------------------------------  #-----------------------------------------------------------------------------
710  sub print_alignment_as_nexus {  sub print_alignment_as_nexus {
711      my ( $fh, undef, $close, $unused ) = output_filehandle( shift );      my ( $fh, $close, $unused ) = output_filehandle( shift );
712      ( unshift @_, $unused ) if $unused;      ( unshift @_, $unused ) if $unused;
713    
714      my $lbls = ( ref( $_[0] ) eq "HASH" ) ? shift : undef;      my $lbls = ( ref( $_[0] ) eq "HASH" ) ? shift : undef;

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3