Bio/AlignIO/pfam.pm

   1 #
   2 # BioPerl module for Bio::AlignIO::pfam
   3
   4 #   based on the Bio::SeqIO:: modules
   5 #       by Ewan Birney <birney@ebi.ac.uk>
   6 #       and Lincoln Stein  <lstein@cshl.org>
   7 #
   8 #       and the SimpleAlign.pm module of Ewan Birney
   9 #
  10 # Copyright Peter Schattner
  11 #
  12 # You may distribute this module under the same terms as perl itself
  13 # _history
  14 # September 5, 2000
  15 # POD documentation - main docs before the code
  16
  17 =head1 NAME
  18
  19 Bio::AlignIO::pfam - pfam sequence input/output stream
  20
  21 =head1 SYNOPSIS
  22
  23 Do not use this module directly.  Use it via the L<Bio::AlignIO> class.
  24
  25 =head1 DESCRIPTION
  26
  27 This object can transform Bio::SimpleAlign objects to and from pfam flat
  28 file databases.
  29
  30 =head1 FEEDBACK
  31
  32 =head2 Support
  33
  34 Please direct usage questions or support issues to the mailing list:
  35
  36 I<bioperl-l@bioperl.org>
  37
  38 rather than to the module maintainer directly. Many experienced and
  39 reponsive experts will be able look at the problem and quickly
  40 address it. Please include a thorough description of the problem
  41 with code and data examples if at all possible.
  42
  43 =head2 Reporting Bugs
  44
  45 Report bugs to the Bioperl bug tracking system to help us keep track
  46 the bugs and their resolution.  Bug reports can be submitted via the
  47 web:
  48
  49   https://github.com/bioperl/bioperl-live/issues
  50
  51 =head1 AUTHORS - Peter Schattner
  52
  53 Email: schattner@alum.mit.edu
  54
  55
  56 =head1 APPENDIX
  57
  58 The rest of the documentation details each of the object
  59 methods. Internal methods are usually preceded with a _
  60
  61 =cut
  62
  63 # Let the code begin...
  64
  65 package Bio::AlignIO::pfam;
  66 use strict;
  67
  68 use Bio::SimpleAlign;
  69 use base qw(Bio::AlignIO);
  70
  71 =head2 next_aln
  72
  73  Title   : next_aln
  74  Usage   : $aln = $stream->next_aln()
  75  Function: returns the next alignment in the stream
  76  Returns : L<Bio::Align::AlignI> object
  77  Args    : NONE
  78
  79 =cut
  80
  81 sub next_aln {
  82     my $self = shift;
  83     my $entry;
  84     my $name;
  85     my $start;
  86     my $end;
  87     my $seq;
  88     my $add;
  89     my $acc;
  90     my %names;
  91
  92     my $aln =  Bio::SimpleAlign->new(-source => 'pfam');
  93
  94     while( $entry = $self->_readline) {
  95         chomp $entry;
  96         $entry =~ m{^//} && last;
  97         if($entry !~ m{^(\S+)/(\d+)-(\d+)\s+(\S+)\s*} ) {
  98             $self->throw("Found a bad line [$_] in the pfam format alignment");
  99             next;
 100         }
 101
 102         $name = $1;
 103         $start = $2;
 104         $end = $3;
 105         $seq = $4;
 106
 107
 108         $add = Bio::LocatableSeq->new('-seq'         => $seq,
 109                                       '-display_id'  => $name,
 110                                       '-start'       => $start,
 111                                       '-end'         => $end,
 112                                       '-alphabet'    => $self->alphabet,
 113                             );
 114
 115         $aln->add_seq($add);
 116
 117     }
 118
 119 #  If $end <= 0, we have either reached the end of
 120 #  file in <> or we have encountered some other error
 121 #
 122
 123         return $aln if $aln->num_sequences;
 124         return;
 125 }
 126
 127
 128
 129 =head2 write_aln
 130
 131  Title   : write_aln
 132  Usage   : $stream->write_aln(@aln)
 133  Function: writes the $aln object into the stream
 134  Returns : 1 for success and 0 for error
 135  Args    : L<Bio::Align::AlignI> object
 136
 137
 138 =cut
 139
 140 sub write_aln {
 141    my ($self,@aln) = @_;
 142    if( @aln > 1 ) { $self->warn("Only the 1st pfam alignment will be output since the format does not support multiple alignments in the same file"); }
 143    my $aln = shift @aln;
 144    if( ! $aln || ! $aln->isa('Bio::Align::AlignI')  ) {
 145        $self->warn("Must provide a Bio::Align::AlignI object when calling write_aln");
 146        next;
 147    }
 148    my ($namestr,$seq,$add);
 149    my ($maxn);
 150    $maxn = $aln->maxdisplayname_length();
 151
 152    foreach $seq ( $aln->each_seq() ) {
 153        $namestr = $aln->displayname($seq->get_nse());
 154        $add = $maxn - length($namestr) + 2;
 155        $namestr .= " " x $add;
 156           $self->_print (sprintf("%s  %s\n",$namestr,$seq->seq())) or return;
 157    }
 158    $self->flush() if $self->_flush_on_write && defined $self->_fh;
 159    return 1;
 160 }
 161
 162 1;