File Coverage

Bio/TreeIO.pm
Criterion Covered Total %
statement 75 101 74.2
branch 15 30 50.0
condition 2 7 28.5
subroutine 16 22 72.7
pod 4 11 36.3
total 112 171 65.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::TreeIO
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::TreeIO - Parser for Tree files
17              
18             =head1 SYNOPSIS
19              
20             {
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";
26             }
27             }
28              
29             =head1 DESCRIPTION
30              
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.
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
41             the Bioperl mailing list. 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             of the bugs and their resolution. Bug reports can be submitted via the
61             web:
62              
63             https://github.com/bioperl/bioperl-live/issues
64              
65             =head1 AUTHOR - Jason Stajich
66              
67             Email jason-at-bioperl-dot-org
68              
69             =head1 CONTRIBUTORS
70              
71             Allen Day Eallenday@ucla.eduE
72              
73             =head1 APPENDIX
74              
75             The rest of the documentation details each of the object methods.
76             Internal methods are usually preceded with a _
77              
78             =cut
79              
80              
81             # Let the code begin...
82              
83              
84             package Bio::TreeIO;
85 23     23   8088 use strict;
  23         26  
  23         620  
86              
87             # Object preamble - inherits from Bio::Root::Root
88              
89 23     23   6053 use Bio::TreeIO::TreeEventBuilder;
  23         36  
  23         642  
90              
91 23     23   101 use base qw(Bio::Root::Root Bio::Root::IO Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
  23         26  
  23         7383  
92              
93             =head2 new
94              
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:
101              
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
108              
109             =cut
110              
111             sub new {
112 1360     1360 1 4220 my($caller,@args) = @_;
113 1360   33     3709 my $class = ref($caller) || $caller;
114              
115             # or do we want to call SUPER on an object if $caller is an
116             # object?n
117              
118 1360         1108 my $obj;
119 1360 100       3930 if( $class =~ /Bio::TreeIO::(\S+)/ ) {
120 701         1499 $obj = $class->SUPER::new(@args);
121 701         1551 $obj->_initialize(@args);
122             } else {
123 659         1468 my %param = @args;
124 659         1380 @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
  1378         2334  
125             my $format = $param{'-format'} ||
126 659   50     1850 $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
127             'newick';
128 659         727 $format = "\L$format"; # normalize capitalization to lower case
129            
130             # normalize capitalization
131 659 50       1183 return undef unless( $class->_load_format_module($format) );
132 659         3074 $obj = "Bio::TreeIO::$format"->new(@args);
133             }
134 1360         2823 return $obj;
135             }
136              
137              
138             =head2 format
139              
140             Title : format
141             Usage : $format = $obj->format()
142             Function: Get the tree format
143             Returns : tree format
144             Args : none
145              
146             =cut
147              
148             # format() method inherited from Bio::Root::IO
149              
150              
151             =head2 next_tree
152              
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
158              
159             =cut
160              
161             sub next_tree{
162 0     0 1 0 my ($self) = @_;
163 0         0 $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
164             }
165              
166             =head2 write_tree
167              
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
173              
174              
175             =cut
176              
177             sub write_tree{
178 0     0 1 0 my ($self,$tree) = @_;
179 0         0 $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
180             }
181              
182              
183             =head2 attach_EventHandler
184              
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
190              
191             =cut
192              
193             sub attach_EventHandler{
194 701     701 1 620 my ($self,$handler) = @_;
195 701 50       1151 return if( ! $handler );
196 701 50       1836 if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
197 0         0 $self->warn("Ignoring request to attach handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
198             }
199 701         684 $self->{'_handler'} = $handler;
200 701         611 return;
201             }
202              
203             =head2 _eventHandler
204              
205             Title : _eventHandler
206             Usage : private
207             Function: Get the EventHandler
208             Returns : Bio::Event::EventHandlerI
209             Args : none
210              
211              
212             =cut
213              
214             sub _eventHandler{
215 36986     36986   27064 my ($self) = @_;
216 36986         75521 return $self->{'_handler'};
217             }
218              
219             sub _initialize {
220 701     701   1063 my($self, @args) = @_;
221 701         782 $self->{'_handler'} = undef;
222              
223 701         1139 $self->get_params; # Initialize the default parameters.
224              
225 701         1853 my ($nen,$ini) = $self->_rearrange
226             ([qw(NEWLINE_EACH_NODE INTERNAL_NODE_ID)],@args);
227 701         1565 $self->set_param('newline_each_node',$nen);
228 701         829 $self->set_param('internal_node_id',$ini);
229              
230 701         1375 $self->attach_EventHandler(Bio::TreeIO::TreeEventBuilder->new
231             (-verbose => $self->verbose(), @args));
232 701         1430 $self->_initialize_io(@args);
233             #$self->debug_params;
234             }
235              
236             =head2 _load_format_module
237              
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 :
244              
245             =cut
246              
247             sub _load_format_module {
248 659     659   620 my ($self,$format) = @_;
249 659         775 my $module = "Bio::TreeIO::" . $format;
250 659         493 my $ok;
251            
252 659         671 eval {
253 659         1413 $ok = $self->_load_module($module);
254             };
255              
256 659 50       1087 if ( $@ ) {
257 0         0 print STDERR <
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
262             END
263             ;
264             }
265 659         1249 return $ok;
266             }
267              
268             sub param {
269 112     112 0 112 my $self = shift;
270 112         92 my $param = shift;
271 112         94 my $value = shift;
272              
273 112 50       187 if (defined $value) {
274 0         0 $self->get_params->{$param} = $value;
275             }
276 112         176 return $self->get_params->{$param};
277             }
278              
279             sub set_param {
280 1402     1402 0 1155 my $self = shift;
281 1402         1015 my $param = shift;
282 1402         914 my $value = shift;
283              
284             #print STDERR "[$param] -> [undef]\n" if (!defined $value);
285 1402 100       2090 return unless (defined $value);
286             #print STDERR "[$param] -> [$value]\n";
287              
288 2         5 $self->get_params->{$param} = $value;
289 2         8 return $self->param($param);
290             }
291              
292             sub params {
293 5     5 0 11 my $self = shift;
294 5         8 return $self->get_params;
295             }
296             sub get_params {
297 1445     1445 0 1140 my $self = shift;
298              
299 1445 100       2261 if (!defined $self->{_params}) {
300 701         1224 $self->{_params} = $self->get_default_params;
301             }
302              
303 1445         1959 return $self->{_params};
304             }
305              
306             sub set_params {
307 42     42 0 33 my $self = shift;
308 42         33 my $params = shift;
309              
310             # Apply all the passed parameters to our internal parm hashref.
311 42         52 my $cur_params = $self->get_params;
312 42         213 $self->{_params} = { %$cur_params, %$params };
313              
314 42         64 return $self->get_params;
315             }
316              
317             sub get_default_params {
318 21     21 0 25 my $self = shift;
319            
320 21         42 return {};
321             }
322              
323             sub debug_params {
324 0     0 0 0 my $self = shift;
325              
326 0         0 my $params = $self->get_params;
327              
328 0         0 print STDERR "{\n";
329 0         0 foreach my $param (keys %$params) {
330 0         0 my $value = $params->{$param};
331 0         0 print STDERR " [$param] -> [$value]\n";
332             }
333 0         0 print STDERR "}\n";
334             }
335              
336             =head2 _guess_format
337              
338             Title : _guess_format
339             Usage : $obj->_guess_format($filename)
340             Function:
341             Example :
342             Returns : guessed format of filename (lower case)
343             Args :
344              
345             =cut
346              
347             sub _guess_format {
348 3     3   4 my $class = shift;
349 3 50       9 return unless $_ = shift;
350 3 100       24 return 'newick' if /\.(dnd|newick|nh)$/i;
351 2 50       14 return 'nhx' if /\.(nhx)$/i;
352 0 0       0 return 'phyloxml' if /\.(xml)$/i;
353 0 0       0 return 'svggraph' if /\.svg$/i;
354 0 0       0 return 'lintree' if( /\.(lin|lintree)$/i );
355             }
356              
357             sub DESTROY {
358 701     701   13933 my $self = shift;
359              
360 701         1562 $self->close();
361             }
362              
363             sub TIEHANDLE {
364 0     0     my $class = shift;
365 0           return bless {'treeio' => shift},$class;
366             }
367              
368             sub READLINE {
369 0     0     my $self = shift;
370 0 0 0       return $self->{'treeio'}->next_tree() || undef unless wantarray;
371 0           my (@list,$obj);
372 0           push @list,$obj while $obj = $self->{'treeio'}->next_tree();
373 0           return @list;
374             }
375              
376             sub PRINT {
377 0     0     my $self = shift;
378 0           $self->{'treeio'}->write_tree(@_);
379             }
380              
381             1;