Bio/AlignIO/pfam.pm

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