File Coverage

blib/lib/Bio/Phylo/Unparsers/Nhx.pm
Criterion Covered Total %
statement 31 41 75.6
branch 3 10 30.0
condition n/a
subroutine 7 9 77.7
pod n/a
total 41 60 68.3


line stmt bran cond sub pod time code
1             package Bio::Phylo::Unparsers::Nhx;
2 1     1   7 use strict;
  1         2  
  1         33  
3 1     1   5 use base 'Bio::Phylo::Unparsers::Abstract';
  1         1  
  1         297  
4 1     1   6 use Bio::Phylo::IO 'unparse';
  1         2  
  1         44  
5 1     1   5 use Bio::Phylo::Util::CONSTANT qw':objecttypes :namespaces';
  1         2  
  1         614  
6              
7             =head1 NAME
8              
9             Bio::Phylo::Unparsers::Nhx - Serializer used by Bio::Phylo::IO, no serviceable parts inside
10              
11             =head1 DESCRIPTION
12              
13             This module turns a tree object into a New Hampshire eXtended-formatted (parenthetical)
14             tree description. It is called by the L<Bio::Phylo::IO> facade, don't call it directly.
15             You can pass the following additional arguments to the unparse call:
16            
17             # by default, names for tips are derived from $node->get_name, if
18             # 'internal' is specified, uses $node->get_internal_name, if 'taxon'
19             # uses $node->get_taxon->get_name, if 'taxon_internal' uses
20             # $node->get_taxon->get_internal_name, if $key, uses $node->get_generic($key)
21             -tipnames => one of (internal|taxon|taxon_internal|$key)
22            
23             # for things like a translate table in nexus, or to specify truncated
24             # 10-character names, you can pass a translate mapping as a hashref.
25             # to generate the translated names, the strings obtained following the
26             # -tipnames rules are used.
27             -translate => { Homo_sapiens => 1, Pan_paniscus => 2 }
28            
29             # if set, appends labels to internal nodes (names obtained from the same
30             # source as specified by '-tipnames')
31             -nodelabels => 1
32            
33             # specifies a branch length sprintf number formatting template, default is %f
34             -blformat => '%e'
35              
36             In addition, you can influence what key/value pairs are inserted into the NHX "hot
37             comments" in two ways. The first way (and the way that is least likely to cause
38             unintentional mishaps) is by attaching a Meta annotation to a node. This annotation
39             has to be associated with the NHX namespace. Here is an example:
40              
41             use Bio::Phylo::Util::CONSTANT ':classnames';
42            
43             # ...other things happening...
44             $node->set_namespaces( 'nhx' => _NS_NHX_ );
45             $node->set_meta_object( 'nhx:foo' => 'bar' );
46            
47             # which results in: [&&NHX:foo=bar]
48              
49             The other way is by using the set/get generic methods, e.g.:
50              
51             $node->set_generic( 'foo' => 'bar');
52              
53             However, this is riskier because everything you attach to an object using these methods
54             will be inserted into the NHX, including references (which won't serialize well).
55              
56             =begin comment
57              
58             Type : Wrapper
59             Title : _to_string($tree)
60             Usage : $newick->_to_string($tree);
61             Function: Prepares for the recursion to unparse the tree object into a
62             newick string.
63             Alias :
64             Returns : SCALAR
65             Args : Bio::Phylo::Forest::Tree
66              
67             =end comment
68              
69             =cut
70              
71             sub _to_string {
72 1     1   1 my $self = shift;
73 1         8 my $tree = $self->{'PHYLO'};
74 1         5 my $type = $tree->_type;
75            
76             # collect distinct NHX keys
77 1         3 my %keys;
78 1 50       2 if ( $type == _TREE_ ) {
    0          
    0          
79 1         3 _get_keys_from_tree($tree,\%keys);
80             }
81             elsif ( $type == _FOREST_ ) {
82 0         0 my $forest = $tree;
83 0     0   0 $forest->visit(sub{_get_keys_from_tree(shift,\%keys)});
  0         0  
84             }
85             elsif ( $type == _PROJECT_ ) {
86 0         0 my $project = $tree;
87             $project->visit(sub{
88 0     0   0 my $forest = shift;
89 0         0 $forest->visit(sub{_get_keys_from_tree(shift,\%keys)});
  0         0  
90 0         0 });
91             }
92              
93             # transform arguments
94 1         14 my %args = (
95             '-format' => 'newick',
96             '-nhxstyle' => 'nhx',
97             '-nhxkeys' => [ keys %keys ],
98             '-phylo' => $tree,
99             );
100 1         3 for my $key (qw(TRANSLATE TIPNAMES NODELABELS BLFORMAT)) {
101 4 50       12 if ( my $val = $self->{$key} ) {
102 0         0 my $arg = '-' . lc($key);
103 0         0 $args{$arg} = $val;
104             }
105             }
106 1         9 return unparse(%args);
107             }
108              
109             sub _get_keys_from_tree {
110 1     1   2 my ( $tree, $hashref ) = @_;
111             $tree->visit(sub{
112 215     215   311 my $node = shift;
113 215         236 for my $m ( @{ $node->get_meta } ) {
  215         461  
114 645 50       1403 if ( $m->get_predicate_namespace eq _NS_NHX_ ) {
115 645         1253 my ( $pre, $key ) = split /:/, $m->get_predicate;
116 645         1157 $hashref->{$key}++;
117 645         1368 $node->set_generic( $key => $m->get_object );
118             }
119             }
120 1         17 });
121             }
122              
123             # podinherit_insert_token
124              
125             =head1 SEE ALSO
126              
127             There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
128             for any user or developer questions and discussions.
129              
130             =over
131              
132             =item L<Bio::Phylo::IO>
133              
134             The NHX unparser is called by the L<Bio::Phylo::IO> object.
135             Look there to learn how to unparse newick strings.
136              
137             =item L<Bio::Phylo::Manual>
138              
139             Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
140              
141             =back
142              
143             =head1 CITATION
144              
145             If you use Bio::Phylo in published research, please cite it:
146              
147             B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
148             and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
149             I<BMC Bioinformatics> B<12>:63.
150             L<http://dx.doi.org/10.1186/1471-2105-12-63>
151              
152             =cut
153              
154             1;