Bio/SeqIO/pir.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SeqIO::PIR
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Aaron Mackey <amackey@virginia.edu>
   8 #
   9 # Copyright Aaron Mackey
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12 #
  13 # _history
  14 # October 18, 1999  Largely rewritten by Lincoln Stein
  15
  16 # POD documentation - main docs before the code
  17
  18 =head1 NAME
  19
  20 Bio::SeqIO::pir - PIR sequence input/output stream
  21
  22 =head1 SYNOPSIS
  23
  24 Do not use this module directly.  Use it via the Bio::SeqIO class.
  25
  26 =head1 DESCRIPTION
  27
  28 This object can transform Bio::Seq objects to and from pir flat
  29 file databases.
  30
  31 Note: This does not completely preserve the PIR format - quality
  32 information about sequence is currently discarded since bioperl
  33 does not have a mechanism for handling these encodings in sequence
  34 data.
  35
  36 =head1 FEEDBACK
  37
  38 =head2 Mailing Lists
  39
  40 User feedback is an integral part of the evolution of this and other
  41 Bioperl modules. Send your comments and suggestions preferably to one
  42 of the Bioperl mailing lists.  Your participation is much appreciated.
  43
  44   bioperl-l@bioperl.org                  - General discussion
  45   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  46
  47 =head2 Support
  48
  49 Please direct usage questions or support issues to the mailing list:
  50
  51 L<bioperl-l@bioperl.org>
  52
  53 rather than to the module maintainer directly. Many experienced and
  54 reponsive experts will be able look at the problem and quickly
  55 address it. Please include a thorough description of the problem
  56 with code and data examples if at all possible.
  57
  58 =head2 Reporting Bugs
  59
  60 Report bugs to the Bioperl bug tracking system to help us keep track
  61 the bugs and their resolution.
  62 Bug reports can be submitted via the web:
  63
  64   http://bugzilla.open-bio.org/
  65
  66 =head1 AUTHORS
  67
  68 Aaron Mackey E<lt>amackey@virginia.eduE<gt>
  69 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
  70 Jason Stajich E<lt>jason@bioperl.orgE<gt>
  71
  72 =head1 APPENDIX
  73
  74 The rest of the documentation details each of the object
  75 methods. Internal methods are usually preceded with a _
  76
  77 =cut
  78
  79 # Let the code begin...
  80
  81 package Bio::SeqIO::pir;
  82 use strict;
  83
  84 use Bio::Seq::SeqFactory;
  85
  86 use base qw(Bio::SeqIO);
  87
  88 our %VALID_TYPE = map {$_ => 1} qw(P1 F1 DL DC RL RC XX);
  89
  90 sub _initialize {
  91   my($self,@args) = @_;
  92   $self->SUPER::_initialize(@args);
  93   if( ! defined $self->sequence_factory ) {
  94       $self->sequence_factory(Bio::Seq::SeqFactory->new
  95                               (-verbose => $self->verbose(),
  96                                -type => 'Bio::Seq'));
  97   }
  98 }
  99
 100 =head2 next_seq
 101
 102  Title   : next_seq
 103  Usage   : $seq = $stream->next_seq()
 104  Function: returns the next sequence in the stream
 105  Returns : Bio::Seq object
 106  Args    : NONE
 107
 108 =cut
 109
 110 sub next_seq {
 111     my ($self) = @_;
 112     local $/ = "\n>";
 113     return unless my $line = $self->_readline;
 114     if( $line eq '>' ) {        # handle the very first one having no comment
 115         return unless $line = $self->_readline;
 116     }
 117     my ($top, $desc,$seq) = ( $line =~ /^(.+?)\n(.+?)\n([^>]*)/s )  or
 118         $self->throw("Cannot parse entry PIR entry [$line]");
 119
 120     my ( $type,$id );
 121         if ( $top =~ /^>?(\S{2});(\S+)\s*$/ ) {
 122           ( $type,$id ) = ($1, $2);
 123           if (!exists $VALID_TYPE{$type} ) {
 124                 $self->throw("PIR stream read attempted without proper two-letter sequence code [ $type ]");
 125           }
 126         } else {
 127           $self->throw("Line does not match PIR format [ $line ]");
 128         }
 129
 130     # P - indicates complete protein
 131     # F - indicates protein fragment
 132     # not sure how to stuff these into a Bio object
 133     # suitable for writing out.
 134     $seq =~ s/\*//g;
 135     $seq =~ s/[\(\)\.\/\=\,]//g;
 136     $seq =~ s/\s+//g;           # get rid of whitespace
 137
 138     my ($alphabet) = ('protein');
 139     # TODO - not processing SFS data
 140     return $self->sequence_factory->create
 141         (-seq        => $seq,
 142          -primary_id => $id,
 143          -id         => $id,
 144          -desc       => $desc,
 145          -alphabet   => $alphabet
 146          );
 147 }
 148
 149 =head2 write_seq
 150
 151  Title   : write_seq
 152  Usage   : $stream->write_seq(@seq)
 153  Function: writes the $seq object into the stream
 154  Returns : 1 for success and 0 for error
 155  Args    : Array of Bio::PrimarySeqI objects
 156
 157
 158 =cut
 159
 160 sub write_seq {
 161     my ($self, @seq) = @_;
 162     for my $seq (@seq) {
 163         $self->throw("Did not provide a valid Bio::PrimarySeqI object")
 164             unless defined $seq && ref($seq) && $seq->isa('Bio::PrimarySeqI');
 165
 166         $self->warn("No whitespace allowed in PIR ID [". $seq->display_id. "]")
 167             if $seq->display_id =~ /\s/;
 168
 169         my $str = $seq->seq();
 170         return unless $self->_print(">P1;".$seq->id(),
 171                                     "\n", $seq->desc(), "\n",
 172                                     $str, "*\n");
 173     }
 174
 175     $self->flush if $self->_flush_on_write && defined $self->_fh;
 176     return 1;
 177 }
 178
 179 1;