Bio/SeqIO/pir.pm

   1 #
   2 # BioPerl module for Bio::SeqIO::PIR
   3 #
   4 # Cared for by Aaron Mackey <amackey@virginia.edu>
   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 fasta flat
  26 file databases.
  27
  28 =head1 FEEDBACK
  29
  30 =head2 Mailing Lists
  31
  32 User feedback is an integral part of the evolution of this
  33 and other Bioperl modules. Send your comments and suggestions preferably
  34  to one of the Bioperl mailing lists.
  35 Your participation is much appreciated.
  36
  37   vsns-bcd-perl@lists.uni-bielefeld.de          - General discussion
  38   vsns-bcd-perl-guts@lists.uni-bielefeld.de     - Technically-oriented discussion
  39   http://bio.perl.org/MailList.html             - About the mailing lists
  40
  41 =head2 Reporting Bugs
  42
  43 Report bugs to the Bioperl bug tracking system to help us keep track
  44  the bugs and their resolution.
  45  Bug reports can be submitted via email or the web:
  46
  47   bioperl-bugs@bio.perl.org
  48   http://bio.perl.org/bioperl-bugs/
  49
  50 =head1 AUTHORS
  51
  52 Aaron Mackey <amackey@virginia.edu>
  53 Lincoln Stein <lstein@cshl.org>
  54
  55 =head1 APPENDIX
  56
  57 The rest of the documentation details each of the object
  58 methods. Internal methods are usually preceded with a _
  59
  60 =cut
  61
  62 # Let the code begin...
  63
  64 package Bio::SeqIO::pir;
  65 use vars qw(@ISA);
  66 use strict;
  67 use Bio::SeqIO;
  68
  69 @ISA = qw(Bio::SeqIO);
  70
  71 =head2 next_seq
  72
  73  Title   : next_seq
  74  Usage   : $seq = $stream->next_seq()
  75  Function: returns the next sequence in the stream
  76  Returns : Bio::Seq object
  77  Args    :
  78
  79
  80 =cut
  81
  82 sub next_seq{
  83    my ($self,@args) = @_;
  84    my ($seq,$line,$name,$sfs,$desc);
  85
  86    return unless $line = $self->_readline;
  87    $self->throw("PIR stream read attempted without leading '>P1;' [ $line ]")
  88      unless  $line =~ /^>(?:P|F)1;(\S+)\s*(\|.*)?\s*$/;
  89    $name = $1;
  90    $sfs = $2;
  91
  92    chomp($desc = $self->_readline);
  93    local $/ = "";
  94    my $junk = $self->_readline;  # throw away everything to first empty line
  95    my $seq = $self->_readline;   # everything else is the sequence
  96    $seq =~ s/\s+//g;
  97    $seq = Bio::Seq->new(-seq => $seq,
  98                         -id => $name,
  99                         -desc => $desc,
 100                         -names => defined $sfs ? { 'sfnum' => [ split(/\s*\|?\s+/, $sfs) ] } : undef );
 101    return $seq;
 102 }
 103
 104 =head2 write_seq
 105
 106  Title   : write_seq
 107  Usage   : $stream->write_seq(@seq)
 108  Function: writes the $seq object into the stream
 109  Returns : 1 for success and 0 for error
 110  Args    : Bio::Seq object
 111
 112
 113 =cut
 114
 115 sub write_seq {
 116    my ($self, @seq) = @_;
 117    for my $seq (@seq) {
 118      my $str = $seq->seq();
 119      $str =~ s/(.{10})/$1 /g;
 120      $str =~ s/(.{66})/$1\n/g;
 121      return unless $self->_print(">P1;", $seq->id(),
 122                                  (%{$seq->names()}->{'sfnum'} ? " |" .
 123                                   join(' ', @{%{$seq->names()}->{'sfnum'}}) : '' ),
 124                                  "\n", $seq->desc(), "\n",
 125                                  ">P1;", $seq->id(),"\n",
 126                                  "\n",$str, "\n");
 127    }
 128    return 1;
 129 }
 130
 131 1;