|
0
|
1 # $Id: TreeIO.pm,v 1.11 2002/11/05 17:26:04 heikki Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::TreeIO
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
6 #
|
|
|
7 # Copyright Jason Stajich
|
|
|
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::TreeIO - Parser for Tree files
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 {
|
|
|
20 use Bio::TreeIO;
|
|
|
21 my $treeio = new Bio::TreeIO('-format' => 'newick',
|
|
|
22 '-file' => 'globin.dnd');
|
|
|
23 while( my $tree = $treeio->next_tree ) {
|
|
|
24 print "Tree is ", $tree->size, "\n";
|
|
|
25 }
|
|
|
26 }
|
|
|
27
|
|
|
28 =head1 DESCRIPTION
|
|
|
29
|
|
|
30 This is the driver module for Tree reading from data streams and
|
|
|
31 flatfiles. This is intended to be able to create Bio::Tree::TreeI
|
|
|
32 objects.
|
|
|
33
|
|
|
34 =head1 FEEDBACK
|
|
|
35
|
|
|
36 =head2 Mailing Lists
|
|
|
37
|
|
|
38 User feedback is an integral part of the evolution of this and other
|
|
|
39 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
40 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
41
|
|
|
42 bioperl-l@bioperl.org - General discussion
|
|
|
43 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
44
|
|
|
45 =head2 Reporting Bugs
|
|
|
46
|
|
|
47 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
48 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
49 email or the web:
|
|
|
50
|
|
|
51 bioperl-bugs@bioperl.org
|
|
|
52 http://bugzilla.bioperl.org/
|
|
|
53
|
|
|
54 =head1 AUTHOR - Jason Stajich
|
|
|
55
|
|
|
56 Email jason@bioperl.org
|
|
|
57
|
|
|
58 Describe contact details here
|
|
|
59
|
|
|
60 =head1 CONTRIBUTORS
|
|
|
61
|
|
|
62 Additional contributors names and emails here
|
|
|
63
|
|
|
64 =head1 APPENDIX
|
|
|
65
|
|
|
66 The rest of the documentation details each of the object methods.
|
|
|
67 Internal methods are usually preceded with a _
|
|
|
68
|
|
|
69 =cut
|
|
|
70
|
|
|
71
|
|
|
72 # Let the code begin...
|
|
|
73
|
|
|
74
|
|
|
75 package Bio::TreeIO;
|
|
|
76 use vars qw(@ISA);
|
|
|
77 use strict;
|
|
|
78
|
|
|
79 # Object preamble - inherits from Bio::Root::Root
|
|
|
80
|
|
|
81 use Bio::Root::Root;
|
|
|
82 use Bio::Root::IO;
|
|
|
83 use Bio::Event::EventGeneratorI;
|
|
|
84 use Bio::TreeIO::TreeEventBuilder;
|
|
|
85 use Bio::Factory::TreeFactoryI;
|
|
|
86
|
|
|
87 @ISA = qw(Bio::Root::Root Bio::Root::IO
|
|
|
88 Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
|
|
|
89
|
|
|
90 =head2 new
|
|
|
91
|
|
|
92 Title : new
|
|
|
93 Usage : my $obj = new Bio::TreeIO();
|
|
|
94 Function: Builds a new Bio::TreeIO object
|
|
|
95 Returns : Bio::TreeIO
|
|
|
96 Args :
|
|
|
97
|
|
|
98
|
|
|
99 =cut
|
|
|
100
|
|
|
101 sub new {
|
|
|
102 my($caller,@args) = @_;
|
|
|
103 my $class = ref($caller) || $caller;
|
|
|
104
|
|
|
105 # or do we want to call SUPER on an object if $caller is an
|
|
|
106 # object?
|
|
|
107 if( $class =~ /Bio::TreeIO::(\S+)/ ) {
|
|
|
108 my ($self) = $class->SUPER::new(@args);
|
|
|
109 $self->_initialize(@args);
|
|
|
110 return $self;
|
|
|
111 } else {
|
|
|
112
|
|
|
113 my %param = @args;
|
|
|
114 @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
|
|
|
115 my $format = $param{'-format'} ||
|
|
|
116 $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
|
|
|
117 'newick';
|
|
|
118 $format = "\L$format"; # normalize capitalization to lower case
|
|
|
119
|
|
|
120 # normalize capitalization
|
|
|
121 return undef unless( $class->_load_format_module($format) );
|
|
|
122 return "Bio::TreeIO::$format"->new(@args);
|
|
|
123 }
|
|
|
124 }
|
|
|
125
|
|
|
126
|
|
|
127 =head2 next_tree
|
|
|
128
|
|
|
129 Title : next_tree
|
|
|
130 Usage : my $tree = $treeio->next_tree;
|
|
|
131 Function: Gets the next tree off the stream
|
|
|
132 Returns : Bio::Tree::TreeI or undef if no more trees
|
|
|
133 Args : none
|
|
|
134
|
|
|
135 =cut
|
|
|
136
|
|
|
137 sub next_tree{
|
|
|
138 my ($self) = @_;
|
|
|
139 $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
|
|
|
140 }
|
|
|
141
|
|
|
142 =head2 write_tree
|
|
|
143
|
|
|
144 Title : write_tree
|
|
|
145 Usage : $treeio->write_tree($tree);
|
|
|
146 Function: Writes a tree onto the stream
|
|
|
147 Returns : none
|
|
|
148 Args : Bio::Tree::TreeI
|
|
|
149
|
|
|
150
|
|
|
151 =cut
|
|
|
152
|
|
|
153 sub write_tree{
|
|
|
154 my ($self,$tree) = @_;
|
|
|
155 $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
|
|
|
156 }
|
|
|
157
|
|
|
158
|
|
|
159 =head2 attach_EventHandler
|
|
|
160
|
|
|
161 Title : attach_EventHandler
|
|
|
162 Usage : $parser->attatch_EventHandler($handler)
|
|
|
163 Function: Adds an event handler to listen for events
|
|
|
164 Returns : none
|
|
|
165 Args : Bio::Event::EventHandlerI
|
|
|
166
|
|
|
167 =cut
|
|
|
168
|
|
|
169 sub attach_EventHandler{
|
|
|
170 my ($self,$handler) = @_;
|
|
|
171 return if( ! $handler );
|
|
|
172 if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
|
|
|
173 $self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
|
|
|
174 }
|
|
|
175 $self->{'_handler'} = $handler;
|
|
|
176 return;
|
|
|
177 }
|
|
|
178
|
|
|
179 =head2 _eventHandler
|
|
|
180
|
|
|
181 Title : _eventHandler
|
|
|
182 Usage : private
|
|
|
183 Function: Get the EventHandler
|
|
|
184 Returns : Bio::Event::EventHandlerI
|
|
|
185 Args : none
|
|
|
186
|
|
|
187
|
|
|
188 =cut
|
|
|
189
|
|
|
190 sub _eventHandler{
|
|
|
191 my ($self) = @_;
|
|
|
192 return $self->{'_handler'};
|
|
|
193 }
|
|
|
194
|
|
|
195 sub _initialize {
|
|
|
196 my($self, @args) = @_;
|
|
|
197 $self->{'_handler'} = undef;
|
|
|
198
|
|
|
199 # initialize the IO part
|
|
|
200 $self->_initialize_io(@args);
|
|
|
201 $self->attach_EventHandler(new Bio::TreeIO::TreeEventBuilder(-verbose => $self->verbose(), @args));
|
|
|
202 }
|
|
|
203
|
|
|
204 =head2 _load_format_module
|
|
|
205
|
|
|
206 Title : _load_format_module
|
|
|
207 Usage : *INTERNAL TreeIO stuff*
|
|
|
208 Function: Loads up (like use) a module at run time on demand
|
|
|
209 Example :
|
|
|
210 Returns :
|
|
|
211 Args :
|
|
|
212
|
|
|
213 =cut
|
|
|
214
|
|
|
215 sub _load_format_module {
|
|
|
216 my ($self,$format) = @_;
|
|
|
217 my $module = "Bio::TreeIO::" . $format;
|
|
|
218 my $ok;
|
|
|
219
|
|
|
220 eval {
|
|
|
221 $ok = $self->_load_module($module);
|
|
|
222 };
|
|
|
223 if ( $@ ) {
|
|
|
224 print STDERR <<END;
|
|
|
225 $self: $format cannot be found
|
|
|
226 Exception $@
|
|
|
227 For more information about the TreeIO system please see the TreeIO docs.
|
|
|
228 This includes ways of checking for formats at compile time, not run time
|
|
|
229 END
|
|
|
230 ;
|
|
|
231 }
|
|
|
232 return $ok;
|
|
|
233 }
|
|
|
234
|
|
|
235
|
|
|
236 =head2 _guess_format
|
|
|
237
|
|
|
238 Title : _guess_format
|
|
|
239 Usage : $obj->_guess_format($filename)
|
|
|
240 Function:
|
|
|
241 Example :
|
|
|
242 Returns : guessed format of filename (lower case)
|
|
|
243 Args :
|
|
|
244
|
|
|
245 =cut
|
|
|
246
|
|
|
247 sub _guess_format {
|
|
|
248 my $class = shift;
|
|
|
249 return unless $_ = shift;
|
|
|
250 return 'newick' if /\.(dnd|newick|nh)$/i;
|
|
|
251 return 'nhx' if /\.(nhx)$/i;
|
|
|
252 return 'phyloxml' if /\.(xml)$/i;
|
|
|
253 }
|
|
|
254
|
|
|
255 sub DESTROY {
|
|
|
256 my $self = shift;
|
|
|
257
|
|
|
258 $self->close();
|
|
|
259 }
|
|
|
260
|
|
|
261 sub TIEHANDLE {
|
|
|
262 my $class = shift;
|
|
|
263 return bless {'treeio' => shift},$class;
|
|
|
264 }
|
|
|
265
|
|
|
266 sub READLINE {
|
|
|
267 my $self = shift;
|
|
|
268 return $self->{'treeio'}->next_tree() unless wantarray;
|
|
|
269 my (@list,$obj);
|
|
|
270 push @list,$obj while $obj = $self->{'treeio'}->next_tree();
|
|
|
271 return @list;
|
|
|
272 }
|
|
|
273
|
|
|
274 sub PRINT {
|
|
|
275 my $self = shift;
|
|
|
276 $self->{'treeio'}->write_tree(@_);
|
|
|
277 }
|
|
|
278
|
|
|
279 1;
|
