File Coverage

Bio/SeqIO/pir.pm
Criterion Covered Total %
statement 35 38 92.1
branch 11 22 50.0
condition 3 9 33.3
subroutine 6 6 100.0
pod 2 2 100.0
total 57 77 74.0


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SeqIO::PIR
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Aaron Mackey
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
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 Eamackey@virginia.eduE
68             Lincoln Stein Elstein@cshl.orgE
69             Jason Stajich Ejason@bioperl.orgE
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 3     3   430 use strict;
  3         3  
  3         73  
82              
83 3     3   240 use Bio::Seq::SeqFactory;
  3         3  
  3         65  
84              
85 3     3   9 use base qw(Bio::SeqIO);
  3         4  
  3         1312  
86              
87             our %VALID_TYPE = map {$_ => 1} qw(P1 F1 DL DC RL RC XX);
88              
89             sub _initialize {
90 5     5   8 my($self,@args) = @_;
91 5         15 $self->SUPER::_initialize(@args);
92 5 50       16 if( ! defined $self->sequence_factory ) {
93 5         13 $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 10     10 1 367 my ($self) = @_;
111 10         29 local $/ = "\n>";
112 10 100       35 return unless my $line = $self->_readline;
113 9 50       16 if( $line eq '>' ) { # handle the very first one having no comment
114 0 0       0 return unless $line = $self->_readline;
115             }
116 9 50       70 my ($top, $desc,$seq) = ( $line =~ /^(.+?)\n(.+?)\n([^>]*)/s ) or
117             $self->throw("Cannot parse entry PIR entry [$line]");
118              
119 9         8 my ( $type,$id );
120 9 50       31 if ( $top =~ /^>?(\S{2});(\S+)\s*$/ ) {
121 9         18 ( $type,$id ) = ($1, $2);
122 9 50       20 if (!exists $VALID_TYPE{$type} ) {
123 0         0 $self->throw("PIR stream read attempted without proper two-letter sequence code [ $type ]");
124             }
125             } else {
126 0         0 $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 9         23 $seq =~ s/\*//g;
134 9         39 $seq =~ s/[\(\)\.\/\=\,]//g;
135 9         22 $seq =~ s/\s+//g; # get rid of whitespace
136              
137 9         11 my ($alphabet) = ('protein');
138             # TODO - not processing SFS data
139 9         19 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 1     1 1 6 my ($self, @seq) = @_;
161 1         3 for my $seq (@seq) {
162 1 50 33     13 $self->throw("Did not provide a valid Bio::PrimarySeqI object")
      33        
163             unless defined $seq && ref($seq) && $seq->isa('Bio::PrimarySeqI');
164              
165 1 50       4 $self->warn("No whitespace allowed in PIR ID [". $seq->display_id. "]")
166             if $seq->display_id =~ /\s/;
167              
168 1         3 my $str = $seq->seq();
169 1 50       3 return unless $self->_print(">P1;".$seq->id(),
170             "\n", $seq->desc(), "\n",
171             $str, "*\n");
172             }
173              
174 1 50 33     3 $self->flush if $self->_flush_on_write && defined $self->_fh;
175 1         3 return 1;
176             }
177              
178             1;