Bio/SeqIO/pir.pm

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