|
0
|
1 # $Id: MultiFile.pm,v 1.8 2002/10/22 07:38:42 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SeqIO::MultiFile
|
|
|
4 #
|
|
|
5 # Cared for by Ewan Birney <birney@ebi.ac.uk>
|
|
|
6 #
|
|
|
7 # Copyright Ewan Birney
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::SeqIO::MultiFile - Treating a set of files as a single input stream
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 $seqin = Bio::SeqIO::MultiFile( '-format' => 'Fasta',
|
|
|
20 '-files' => ['file1','file2'] );
|
|
|
21 while((my $seq = $seqin->next_seq)) {
|
|
|
22 # do something with $seq
|
|
|
23 }
|
|
|
24
|
|
|
25 =head1 DESCRIPTION
|
|
|
26
|
|
|
27 Bio::SeqIO::MultiFile provides a simple way of bundling a whole
|
|
|
28 set of identically formatted sequence input files as a single stream.
|
|
|
29
|
|
|
30 =head1 FEEDBACK
|
|
|
31
|
|
|
32 =head2 Mailing Lists
|
|
|
33
|
|
|
34 User feedback is an integral part of the evolution of this
|
|
|
35 and other Bioperl modules. Send your comments and suggestions preferably
|
|
|
36 to one of the Bioperl mailing lists.
|
|
|
37 Your participation is much appreciated.
|
|
|
38
|
|
|
39 bioperl-l@bioperl.org - General discussion
|
|
|
40 http://www.bioperl.org/MailList.shtml - About the mailing lists
|
|
|
41
|
|
|
42 =head2 Reporting Bugs
|
|
|
43
|
|
|
44 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
45 the bugs and their resolution.
|
|
|
46 Bug reports can be submitted via email or the web:
|
|
|
47
|
|
|
48 bioperl-bugs@bio.perl.org
|
|
|
49 http://bugzilla.bioperl.org/
|
|
|
50
|
|
|
51 =head1 AUTHOR - Ewan Birney
|
|
|
52
|
|
|
53 Email birney@ebi.ac.uk
|
|
|
54
|
|
|
55 Describe contact details here
|
|
|
56
|
|
|
57 =head1 APPENDIX
|
|
|
58
|
|
|
59 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
|
|
|
60
|
|
|
61 =cut
|
|
|
62
|
|
|
63
|
|
|
64 # Let the code begin...
|
|
|
65
|
|
|
66
|
|
|
67 package Bio::SeqIO::MultiFile;
|
|
|
68 use strict;
|
|
|
69 use vars qw(@ISA);
|
|
|
70 use Bio::SeqIO;
|
|
|
71
|
|
|
72 @ISA = qw(Bio::SeqIO);
|
|
|
73
|
|
|
74
|
|
|
75 # _initialize is where the heavy stuff will happen when new is called
|
|
|
76
|
|
|
77 sub _initialize {
|
|
|
78 my($self,@args) = @_;
|
|
|
79
|
|
|
80 $self->SUPER::_initialize(@args);
|
|
|
81
|
|
|
82 my ($file_array,$format) = $self->_rearrange([qw(
|
|
|
83 FILES
|
|
|
84 FORMAT
|
|
|
85 )],
|
|
|
86 @args,
|
|
|
87 );
|
|
|
88 if( !defined $file_array || ! ref $file_array ) {
|
|
|
89 $self->throw("Must have an array files for MultiFile");
|
|
|
90 }
|
|
|
91
|
|
|
92 if( !defined $format ) {
|
|
|
93 $self->throw("Must have a format for MultiFile");
|
|
|
94 }
|
|
|
95
|
|
|
96 $self->{'_file_array'} = [];
|
|
|
97
|
|
|
98 $self->_set_file(@$file_array);
|
|
|
99 $self->_format($format);
|
|
|
100 if( $self->_load_file() == 0 ) {
|
|
|
101 $self->throw("Unable even to initialise the first file");
|
|
|
102 }
|
|
|
103 }
|
|
|
104
|
|
|
105 =head2 next_seq
|
|
|
106
|
|
|
107 Title : next_seq
|
|
|
108 Usage :
|
|
|
109 Function:
|
|
|
110 Example :
|
|
|
111 Returns :
|
|
|
112 Args :
|
|
|
113
|
|
|
114
|
|
|
115 =cut
|
|
|
116
|
|
|
117 sub next_seq{
|
|
|
118 my ($self,@args) = @_;
|
|
|
119
|
|
|
120 my $seq = $self->_current_seqio->next_seq();
|
|
|
121 if( !defined $seq ) {
|
|
|
122 if( $self->_load_file() == 0) {
|
|
|
123 return undef;
|
|
|
124 } else {
|
|
|
125 return $self->next_seq();
|
|
|
126 }
|
|
|
127 } else {
|
|
|
128 return $seq;
|
|
|
129 }
|
|
|
130
|
|
|
131 }
|
|
|
132
|
|
|
133 =head2 next_primary_seq
|
|
|
134
|
|
|
135 Title : next_primary_seq
|
|
|
136 Usage :
|
|
|
137 Function:
|
|
|
138 Example :
|
|
|
139 Returns :
|
|
|
140 Args :
|
|
|
141
|
|
|
142
|
|
|
143 =cut
|
|
|
144
|
|
|
145 sub next_primary_seq{
|
|
|
146 my ($self,@args) = @_;
|
|
|
147
|
|
|
148 my $seq = $self->_current_seqio->next_primary_seq();
|
|
|
149 if( !defined $seq ) {
|
|
|
150 if( $self->_load_file() == 0) {
|
|
|
151 return undef;
|
|
|
152 } else {
|
|
|
153 return $self->next_primary_seq();
|
|
|
154 }
|
|
|
155 } else {
|
|
|
156 return $seq;
|
|
|
157 }
|
|
|
158
|
|
|
159 }
|
|
|
160
|
|
|
161 =head2 _load_file
|
|
|
162
|
|
|
163 Title : _load_file
|
|
|
164 Usage :
|
|
|
165 Function:
|
|
|
166 Example :
|
|
|
167 Returns :
|
|
|
168 Args :
|
|
|
169
|
|
|
170
|
|
|
171 =cut
|
|
|
172
|
|
|
173 sub _load_file{
|
|
|
174 my ($self,@args) = @_;
|
|
|
175
|
|
|
176 my $file = shift(@{$self->{'_file_array'}});
|
|
|
177 if( !defined $file ) {
|
|
|
178 return 0;
|
|
|
179 }
|
|
|
180 my $seqio = Bio::SeqIO->new( '-format' => $self->_format(), -file => $file);
|
|
|
181 # should throw an exception - but if not...
|
|
|
182 if( !defined $seqio) {
|
|
|
183 $self->throw("no seqio built for $file!");
|
|
|
184 }
|
|
|
185
|
|
|
186 $self->_current_seqio($seqio);
|
|
|
187 return 1;
|
|
|
188 }
|
|
|
189
|
|
|
190 =head2 _set_file
|
|
|
191
|
|
|
192 Title : _set_file
|
|
|
193 Usage :
|
|
|
194 Function:
|
|
|
195 Example :
|
|
|
196 Returns :
|
|
|
197 Args :
|
|
|
198
|
|
|
199
|
|
|
200 =cut
|
|
|
201
|
|
|
202 sub _set_file{
|
|
|
203 my ($self,@files) = @_;
|
|
|
204
|
|
|
205 push(@{$self->{'_file_array'}},@files);
|
|
|
206
|
|
|
207 }
|
|
|
208
|
|
|
209 =head2 _current_seqio
|
|
|
210
|
|
|
211 Title : _current_seqio
|
|
|
212 Usage : $obj->_current_seqio($newval)
|
|
|
213 Function:
|
|
|
214 Example :
|
|
|
215 Returns : value of _current_seqio
|
|
|
216 Args : newvalue (optional)
|
|
|
217
|
|
|
218
|
|
|
219 =cut
|
|
|
220
|
|
|
221 sub _current_seqio{
|
|
|
222 my ($obj,$value) = @_;
|
|
|
223 if( defined $value) {
|
|
|
224 $obj->{'_current_seqio'} = $value;
|
|
|
225 }
|
|
|
226 return $obj->{'_current_seqio'};
|
|
|
227
|
|
|
228 }
|
|
|
229
|
|
|
230 =head2 _format
|
|
|
231
|
|
|
232 Title : _format
|
|
|
233 Usage : $obj->_format($newval)
|
|
|
234 Function:
|
|
|
235 Example :
|
|
|
236 Returns : value of _format
|
|
|
237 Args : newvalue (optional)
|
|
|
238
|
|
|
239
|
|
|
240 =cut
|
|
|
241
|
|
|
242 sub _format{
|
|
|
243 my ($obj,$value) = @_;
|
|
|
244 if( defined $value) {
|
|
|
245 $obj->{'_format'} = $value;
|
|
|
246 }
|
|
|
247 return $obj->{'_format'};
|
|
|
248
|
|
|
249 }
|
|
|
250
|
|
|
251 1;
|
