File Coverage

blib/lib/Bio/TreeIO/nexml.pm
Criterion Covered Total %
statement 21 58 36.2
branch 0 6 0.0
condition 0 3 0.0
subroutine 7 13 53.8
pod 4 4 100.0
total 32 84 38.1


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::TreeIO::nexml
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Chase Miller
7             #
8             # Copyright Chase Miller
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::nexml - A TreeIO driver module for parsing NeXML tree files
17              
18             =head1 SYNOPSIS
19              
20             use Bio::TreeIO;
21             my $in = Bio::TreeIO->new(-file => 'data.nexml' -format => 'Nexml');
22             while( my $tree = $in->next_tree ) {
23             }
24              
25             =head1 DESCRIPTION
26              
27             This is a driver module for parsing tree data in a NeXML format. For
28             more information on NeXML, visit L.
29              
30             =head1 FEEDBACK
31              
32             =head2 Mailing Lists
33              
34             User feedback is an integral part of the evolution of this and other
35             Bioperl modules. Send your comments and suggestions preferably to
36             the Bioperl mailing list. Your participation is much appreciated.
37              
38             bioperl-l@bioperl.org - General discussion
39             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
40              
41             =head2 Support
42              
43             Please direct usage questions or support issues to the mailing list:
44              
45             I
46              
47             rather than to the module maintainer directly. Many experienced and
48             reponsive experts will be able look at the problem and quickly
49             address it. Please include a thorough description of the problem
50             with code and data examples if at all possible.
51              
52             =head2 Reporting Bugs
53              
54             Report bugs to the Bioperl bug tracking system to help us keep track
55             of the bugs and their resolution. Bug reports can be submitted via
56             the web:
57              
58             https://github.com/bioperl/bioperl-live/issues
59              
60             =head1 AUTHOR - Chase Miller
61              
62             Email chmille4@gmail.com
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             # Let the code begin...
72              
73             package Bio::TreeIO::nexml;
74 1     1   4 use strict;
  1         1  
  1         26  
75              
76 1     1   3 use lib '../..';
  1         1  
  1         4  
77 1     1   93 use Bio::Event::EventGeneratorI;
  1         3  
  1         38  
78 1     1   431 use IO::String;
  1         1788  
  1         26  
79 1     1   5 use Bio::Nexml::Factory;
  1         1  
  1         20  
80 1     1   2 use Bio::Phylo::IO qw (parse unparse);
  1         2  
  1         52  
81              
82              
83 1     1   3 use base qw(Bio::TreeIO);
  1         1  
  1         352  
84              
85              
86             sub _initialize {
87 0     0     my $self = shift;
88 0           $self->SUPER::_initialize(@_);
89 0           $self->{_doc} = undef;
90             }
91              
92             =head2 next_tree
93              
94             Title : next_tree
95             Usage : my $tree = $treeio->next_tree
96             Function: Gets the next tree in the stream
97             Returns : L
98             Args : none
99              
100              
101             =cut
102              
103             sub next_tree {
104 0     0 1   my ($self) = @_;
105 0 0         unless ( $self->{'_parsed'} ) {
106 0           $self->_parse;
107             }
108 0           return $self->{'_trees'}->[ $self->{'_treeiter'}++ ];
109             }
110              
111             =head2 doc
112              
113             Title : doc
114             Usage : $treeio->doc
115             Function: Returns the biophylo nexml document object
116             Returns : Bio::Phylo::Project
117             Args : none or Bio::Phylo::Project object
118              
119             =cut
120              
121             sub doc {
122 0     0 1   my ($obj,$value) = @_;
123 0 0         if( defined $value) {
124 0           $obj->{'_doc'} = $value;
125             }
126 0           return $obj->{'_doc'};
127             }
128              
129              
130             =head2 rewind
131              
132             Title : rewind
133             Usage : $treeio->rewind
134             Function: Resets the stream
135             Returns : none
136             Args : none
137              
138             =cut
139              
140             sub rewind {
141 0     0 1   my $self = shift;
142 0           $self->{'_treeiter'} = 0;
143             }
144              
145             sub _parse {
146 0     0     my ($self) = @_;
147            
148 0           $self->{'_parsed'} = 1;
149 0           $self->{'_treeiter'} = 0;
150 0           my $fac = Bio::Nexml::Factory->new();
151            
152             # Only pass filename if filehandle is not available,
153             # or "Bio::Phylo" will create a new filehandle that ends
154             # out of scope and can't be closed directly, leaving 2 open
155             # filehandles for the same file (so file can't be deleted)
156 0           my $file_arg;
157             my $file_value;
158 0 0 0       if ( exists $self->{'_filehandle'}
159             and defined $self->{'_filehandle'}
160             ) {
161 0           $file_arg = '-handle';
162 0           $file_value = $self->{'_filehandle'};
163             }
164             else {
165 0           $file_arg = '-file';
166 0           $file_value = $self->{'_file'};
167             }
168              
169 0           $self->doc(parse(
170             $file_arg => $file_value,
171             '-format' => 'nexml',
172             '-as_project' => '1'
173             )
174             );
175 0           $self->{'_trees'} = $fac->create_bperl_tree($self);
176             }
177              
178             =head2 write_tree
179              
180             Title : write_tree
181             Usage : $treeio->write_tree($tree);
182             Function: Writes a tree onto the stream
183             Returns : none
184             Args : L
185              
186              
187             =cut
188              
189             sub write_tree {
190 0     0 1   my ($self, $bp_tree) = @_;
191            
192 0           my $fac = Bio::Nexml::Factory->new();
193 0           my $taxa = $fac->create_bphylo_taxa($bp_tree);
194 0           my ($tree) = $fac->create_bphylo_tree($bp_tree, $taxa);
195            
196 0           my $forest = Bio::Phylo::Factory->create_forest();
197 0           $self->doc(Bio::Phylo::Factory->create_project());
198            
199 0           $forest->set_taxa($taxa);
200 0           $forest->insert($tree);
201            
202 0           $self->doc->insert($forest);
203            
204 0           my $ret = $self->_print($self->doc->to_xml());
205 0           $self->flush;
206 0           return $ret;
207             }
208              
209              
210             1;