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 # Copyright Aaron Mackey
   7 #
   8 # You may distribute this module under the same terms as perl itself
   9 #
  10 # _history
  11 # October 18, 1999  Largely rewritten by Lincoln Stein
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::SeqIO::pir - PIR sequence input/output stream
  18
  19 =head1 SYNOPSIS
  20
  21 Do not use this module directly.  Use it via the Bio::SeqIO class.
  22
  23 =head1 DESCRIPTION
  24
  25 This object can transform Bio::Seq objects to and from pir flat
  26 file databases.
  27
  28 Note: This does not completely preserve the PIR format - quality
  29 information about sequence is currently discarded since bioperl
  30 does not have a mechanism for handling these encodings in sequence
  31 data.
  32
  33 =head1 FEEDBACK
  34
  35 =head2 Mailing Lists
  36
  37 User feedback is an integral part of the evolution of this and other
  38 Bioperl modules. Send your comments and suggestions preferably to one
  39 of the Bioperl mailing lists.  Your participation is much appreciated.
  40
  41   bioperl-l@bioperl.org                  - General discussion
  42   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  43
  44 =head2 Support
  45
  46 Please direct usage questions or support issues to the mailing list:
  47
  48 I<bioperl-l@bioperl.org>
  49
  50 rather than to the module maintainer directly. Many experienced and
  51 reponsive experts will be able look at the problem and quickly
  52 address it. Please include a thorough description of the problem
  53 with code and data examples if at all possible.
  54
  55 =head2 Reporting Bugs
  56
  57 Report bugs to the Bioperl bug tracking system to help us keep track
  58 the bugs and their resolution.
  59 Bug reports can be submitted via the web:
  60
  61   https://github.com/bioperl/bioperl-live/issues
  62
  63 =head1 AUTHORS
  64
  65 Aaron Mackey E<lt>amackey@virginia.eduE<gt>
  66 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
  67 Jason Stajich E<lt>jason@bioperl.orgE<gt>
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object
  72 methods. Internal methods are usually preceded with a _
  73
  74 =cut
  75
  76 # Let the code begin...
  77
  78 package Bio::SeqIO::pir;
  79 use strict;
  80
  81 use Bio::Seq::SeqFactory;
  82
  83 use base qw(Bio::SeqIO);
  84
  85 our %VALID_TYPE = map {$_ => 1} qw(P1 F1 DL DC RL RC XX);
  86
  87 sub _initialize {
  88   my($self,@args) = @_;
  89   $self->SUPER::_initialize(@args);
  90   if( ! defined $self->sequence_factory ) {
  91       $self->sequence_factory(Bio::Seq::SeqFactory->new
  92                               (-verbose => $self->verbose(),
  93                                -type => 'Bio::Seq'));
  94   }
  95 }
  96
  97 =head2 next_seq
  98
  99  Title   : next_seq
 100  Usage   : $seq = $stream->next_seq()
 101  Function: returns the next sequence in the stream
 102  Returns : Bio::Seq object
 103  Args    : NONE
 104
 105 =cut
 106
 107 sub next_seq {
 108     my ($self) = @_;
 109     local $/ = "\n>";
 110     return unless my $line = $self->_readline;
 111     if ( $line eq '>' ) {    # handle the very first one having no comment
 112         return unless $line = $self->_readline;
 113     }
 114     my ( $top, $desc, $seq ) = ( $line =~ /^(.+?)\n(.*?)\n([^>]*)/s )
 115         or $self->throw("Cannot parse entry PIR entry [$line]");
 116
 117     my ( $type, $id );
 118     if ( $top =~ /^>?(\S{2});(\S+)\s*$/ ) {
 119         ( $type, $id ) = ( $1, $2 );
 120         if ( ! exists $VALID_TYPE{$type} ) {
 121             $self->throw(
 122                 "PIR stream read attempted without proper two-letter sequence code [ $type ]"
 123             );
 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
 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;