t/AlignIO/AlignIO.t: fix number of tests in plan (fixup c523e6bed866)
[bioperl-live.git] / Bio / TreeIO.pm
blobbc966547cddfe9c5908aa84ba3558a3ab4a11a84
2 # BioPerl module for Bio::TreeIO
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Jason Stajich <jason@bioperl.org>
8 # Copyright Jason Stajich
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::TreeIO - Parser for Tree files
18 =head1 SYNOPSIS
21 use Bio::TreeIO;
22 my $treeio = Bio::TreeIO->new(-format => 'newick',
23 -file => 'globin.dnd');
24 while( my $tree = $treeio->next_tree ) {
25 print "Tree is ", $tree->number_nodes, "\n";
29 =head1 DESCRIPTION
31 This is the driver module for Tree reading from data streams and
32 flatfiles. This is intended to be able to create Bio::Tree::TreeI
33 objects.
35 =head1 FEEDBACK
37 =head2 Mailing Lists
39 User feedback is an integral part of the evolution of this and other
40 Bioperl modules. Send your comments and suggestions preferably to
41 the Bioperl mailing list. Your participation is much appreciated.
43 bioperl-l@bioperl.org - General discussion
44 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
46 =head2 Support
48 Please direct usage questions or support issues to the mailing list:
50 I<bioperl-l@bioperl.org>
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.
57 =head2 Reporting Bugs
59 Report bugs to the Bioperl bug tracking system to help us keep track
60 of the bugs and their resolution. Bug reports can be submitted via the
61 web:
63 https://github.com/bioperl/bioperl-live/issues
65 =head1 AUTHOR - Jason Stajich
67 Email jason-at-bioperl-dot-org
69 =head1 CONTRIBUTORS
71 Allen Day E<lt>allenday@ucla.eduE<gt>
73 =head1 APPENDIX
75 The rest of the documentation details each of the object methods.
76 Internal methods are usually preceded with a _
78 =cut
81 # Let the code begin...
84 package Bio::TreeIO;
85 use strict;
87 # Object preamble - inherits from Bio::Root::Root
89 use Bio::TreeIO::TreeEventBuilder;
91 use base qw(Bio::Root::Root Bio::Root::IO Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
93 =head2 new
95 Title : new
96 Usage : my $obj = Bio::TreeIO->new();
97 Function: Builds a new Bio::TreeIO object
98 Returns : Bio::TreeIO
99 Args : a hash. useful keys:
100 -format : Specify the format of the file. Supported formats:
102 newick Newick tree format
103 nexus Nexus tree format
104 nhx NHX tree format
105 svggraph SVG graphical representation of tree
106 tabtree ASCII text representation of tree
107 lintree lintree output format
109 =cut
111 sub new {
112 my($caller,@args) = @_;
113 my $class = ref($caller) || $caller;
115 # or do we want to call SUPER on an object if $caller is an
116 # object?n
118 my $obj;
119 if( $class =~ /Bio::TreeIO::(\S+)/ ) {
120 $obj = $class->SUPER::new(@args);
121 $obj->_initialize(@args);
122 } else {
123 my %param = @args;
124 @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
125 my $format = $param{'-format'} ||
126 $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
127 'newick';
128 $format = "\L$format"; # normalize capitalization to lower case
130 # normalize capitalization
131 return undef unless( $class->_load_format_module($format) );
132 $obj = "Bio::TreeIO::$format"->new(@args);
134 return $obj;
138 =head2 format
140 Title : format
141 Usage : $format = $obj->format()
142 Function: Get the tree format
143 Returns : tree format
144 Args : none
146 =cut
148 # format() method inherited from Bio::Root::IO
151 =head2 next_tree
153 Title : next_tree
154 Usage : my $tree = $treeio->next_tree;
155 Function: Gets the next tree off the stream
156 Returns : Bio::Tree::TreeI or undef if no more trees
157 Args : none
159 =cut
161 sub next_tree{
162 my ($self) = @_;
163 $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
166 =head2 write_tree
168 Title : write_tree
169 Usage : $treeio->write_tree($tree);
170 Function: Writes a tree onto the stream
171 Returns : none
172 Args : Bio::Tree::TreeI
175 =cut
177 sub write_tree{
178 my ($self,$tree) = @_;
179 $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
183 =head2 attach_EventHandler
185 Title : attach_EventHandler
186 Usage : $parser->attatch_EventHandler($handler)
187 Function: Adds an event handler to listen for events
188 Returns : none
189 Args : Bio::Event::EventHandlerI
191 =cut
193 sub attach_EventHandler{
194 my ($self,$handler) = @_;
195 return if( ! $handler );
196 if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
197 $self->warn("Ignoring request to attach handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
199 $self->{'_handler'} = $handler;
200 return;
203 =head2 _eventHandler
205 Title : _eventHandler
206 Usage : private
207 Function: Get the EventHandler
208 Returns : Bio::Event::EventHandlerI
209 Args : none
212 =cut
214 sub _eventHandler{
215 my ($self) = @_;
216 return $self->{'_handler'};
219 sub _initialize {
220 my($self, @args) = @_;
221 $self->{'_handler'} = undef;
223 $self->get_params; # Initialize the default parameters.
225 my ($nen,$ini) = $self->_rearrange
226 ([qw(NEWLINE_EACH_NODE INTERNAL_NODE_ID)],@args);
227 $self->set_param('newline_each_node',$nen);
228 $self->set_param('internal_node_id',$ini);
230 $self->attach_EventHandler(Bio::TreeIO::TreeEventBuilder->new
231 (-verbose => $self->verbose(), @args));
232 $self->_initialize_io(@args);
233 #$self->debug_params;
236 =head2 _load_format_module
238 Title : _load_format_module
239 Usage : *INTERNAL TreeIO stuff*
240 Function: Loads up (like use) a module at run time on demand
241 Example :
242 Returns :
243 Args :
245 =cut
247 sub _load_format_module {
248 my ($self,$format) = @_;
249 my $module = "Bio::TreeIO::" . $format;
250 my $ok;
252 eval {
253 $ok = $self->_load_module($module);
256 if ( $@ ) {
257 print STDERR <<END;
258 $self: $format cannot be found
259 Exception $@
260 For more information about the TreeIO system please see the TreeIO docs.
261 This includes ways of checking for formats at compile time, not run time
265 return $ok;
268 sub param {
269 my $self = shift;
270 my $param = shift;
271 my $value = shift;
273 if (defined $value) {
274 $self->get_params->{$param} = $value;
276 return $self->get_params->{$param};
279 sub set_param {
280 my $self = shift;
281 my $param = shift;
282 my $value = shift;
284 #print STDERR "[$param] -> [undef]\n" if (!defined $value);
285 return unless (defined $value);
286 #print STDERR "[$param] -> [$value]\n";
288 $self->get_params->{$param} = $value;
289 return $self->param($param);
292 sub params {
293 my $self = shift;
294 return $self->get_params;
296 sub get_params {
297 my $self = shift;
299 if (!defined $self->{_params}) {
300 $self->{_params} = $self->get_default_params;
303 return $self->{_params};
306 sub set_params {
307 my $self = shift;
308 my $params = shift;
310 # Apply all the passed parameters to our internal parm hashref.
311 my $cur_params = $self->get_params;
312 $self->{_params} = { %$cur_params, %$params };
314 return $self->get_params;
317 sub get_default_params {
318 my $self = shift;
320 return {};
323 sub debug_params {
324 my $self = shift;
326 my $params = $self->get_params;
328 print STDERR "{\n";
329 foreach my $param (keys %$params) {
330 my $value = $params->{$param};
331 print STDERR " [$param] -> [$value]\n";
333 print STDERR "}\n";
336 =head2 _guess_format
338 Title : _guess_format
339 Usage : $obj->_guess_format($filename)
340 Function:
341 Example :
342 Returns : guessed format of filename (lower case)
343 Args :
345 =cut
347 sub _guess_format {
348 my $class = shift;
349 return unless $_ = shift;
350 return 'newick' if /\.(dnd|newick|nh)$/i;
351 return 'nhx' if /\.(nhx)$/i;
352 return 'phyloxml' if /\.(xml)$/i;
353 return 'svggraph' if /\.svg$/i;
354 return 'lintree' if( /\.(lin|lintree)$/i );
357 sub DESTROY {
358 my $self = shift;
360 $self->close();
363 sub TIEHANDLE {
364 my $class = shift;
365 return bless {'treeio' => shift},$class;
368 sub READLINE {
369 my $self = shift;
370 return $self->{'treeio'}->next_tree() || undef unless wantarray;
371 my (@list,$obj);
372 push @list,$obj while $obj = $self->{'treeio'}->next_tree();
373 return @list;
376 sub PRINT {
377 my $self = shift;
378 $self->{'treeio'}->write_tree(@_);