File Coverage

blib/lib/Bio/Phylo/Unparsers/Hennig86.pm
Criterion Covered Total %
statement 47 51 92.1
branch 4 8 50.0
condition 1 3 33.3
subroutine 8 8 100.0
pod n/a
total 60 70 85.7


line stmt bran cond sub pod time code
1             package Bio::Phylo::Unparsers::Hennig86;
2 1     1   6 use strict;
  1         2  
  1         26  
3 1     1   4 use base 'Bio::Phylo::Unparsers::Abstract';
  1         2  
  1         243  
4 1     1   6 use Bio::Phylo;
  1         2  
  1         5  
5 1     1   4 use Bio::Phylo::Util::CONSTANT qw'/looks_like/ :objecttypes';
  1         1  
  1         220  
6 1     1   6 use Bio::Phylo::Util::Exceptions 'throw';
  1         1  
  1         417  
7              
8             my $MATRIX = _MATRIX_;
9             my $PROJECT = _PROJECT_;
10             my %typemap = (
11             'continuous' => 'cont',
12             'dna' => 'dna',
13             'protein' => 'prot',
14             'restriction'=> 'num',
15             'rna' => 'rna',
16             'standard' => 'num',
17             );
18              
19              
20             =head1 NAME
21              
22             Bio::Phylo::Unparsers::Hennig86 - Serializer used by Bio::Phylo::IO, no serviceable
23             parts inside
24              
25             =head1 DESCRIPTION
26              
27             This module turns the supplied object into a Hennig86 string. The supplied
28             object has to either be a L<Bio::Phylo::Matrices::Matrix> object or a
29             L<Bio::Phylo::Project> object, whose first matrix is exported to Hennig86. In
30             other words, this only works on things that are or contain character state
31             matrices.
32              
33             =begin comment
34              
35             Type : Wrapper
36             Title : _to_string
37             Usage : my $hennig_string = $obj->_to_string;
38             Function: Stringifies a Bio::Phylo object into a Hennig86 string
39             Alias :
40             Returns : SCALAR
41             Args : Bio::Phylo::* object
42              
43             =end comment
44              
45             =cut
46              
47             sub _to_string {
48 3     3   4 my $self = shift;
49 3         8 my $obj = $self->{'PHYLO'};
50 3         4 my $matrix;
51 3 50       5 if ( looks_like_implementor $obj, '_type' ) {
52 3 50       7 if ( $obj->_type == $MATRIX ) {
    0          
53 3         4 $matrix = $obj;
54             }
55             elsif ( $obj->_type == $PROJECT ) {
56 0         0 ($matrix) = @{ $obj->get_items(_MATRIX_) };
  0         0  
57             }
58             else {
59 0         0 throw 'ObjectMismatch' => "Can't serialize ".ref($obj)." objects as Hennig86";
60             }
61 3         6 return $self->_serialize_matrix($matrix);
62             }
63             else {
64 0         0 throw 'ObjectMismatch' => "Can't serialize supplied argument as Hennig86";
65             }
66             }
67              
68             sub _serialize_matrix {
69 3     3   6 my ( $self, $matrix ) = @_;
70 3         6 my $hennig86 = $self->_create_header($matrix);
71 3         7 my $to = $matrix->get_type_object;
72 3         6 for my $row ( @{ $matrix->get_entities } ) {
  3         5  
73 15         37 $hennig86 .= $row->get_nexus_name . "\t";
74 15         33 my @char = $row->get_char;
75 15         18 my @encoded;
76 15         23 for my $c ( @char ) {
77 65 100       120 if ( $to->is_ambiguous($c) ) {
78 7         8 my @states = @{ $to->get_states_for_symbol($c) };
  7         28  
79 7         15 push @encoded, '[' . $to->join(\@states) . ']';
80             }
81             else {
82 58         110 push @encoded, $c;
83             }
84             }
85 15         36 $hennig86 .= $to->join(\@encoded) . "\n";
86             }
87 3         10 return $hennig86 .= ";\n";
88             }
89              
90             sub _create_header {
91 3     3   3 my ( $self, $matrix ) = @_;
92            
93 3         11 my $comment = "Hennig86 matrix written by ".ref($self)." ".Bio::Phylo->VERSION." on ".localtime();
94            
95             # calculate nstates
96 3         6 my $nstates = scalar keys %{ $matrix->calc_state_counts };
  3         13  
97            
98             # calculate ntax and nchar
99 3         11 my ( $ntax, $nchar ) = ( $matrix->get_ntax, $matrix->get_nchar );
100            
101             # map type to hennig86 tokens
102 3         12 my $type = lc $matrix->get_type;
103 3   33     8 my $hennig86type = $typemap{ $type } || throw 'BadFormat' => "Can't write $type matrices to Hennig86";
104              
105 3         5 my $template = << 'TEMPLATE';
106             nstates %d
107             xread
108             '%s'
109             %d %d
110             & [%s]
111             TEMPLATE
112              
113 3         13 return sprintf $template, $nstates, $comment, $nchar, $ntax, $hennig86type;
114             }
115              
116             # podinherit_insert_token
117              
118             =head1 SEE ALSO
119              
120             There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
121             for any user or developer questions and discussions.
122              
123             =over
124              
125             =item L<Bio::Phylo::IO>
126              
127             The hennig86 unparser is called by the L<Bio::Phylo::IO> object.
128             Look there to learn how to unparse objects.
129              
130             =item L<Bio::Phylo::Manual>
131              
132             Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
133              
134             =item Hennig86 file format
135              
136             To learn more about the Hennig86 format, visit
137             L<http://www.phylo.org/tools/hennig.html>.
138              
139             =back
140              
141             =head1 CITATION
142              
143             If you use Bio::Phylo in published research, please cite it:
144              
145             B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
146             and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
147             I<BMC Bioinformatics> B<12>:63.
148             L<http://dx.doi.org/10.1186/1471-2105-12-63>
149              
150             =cut
151              
152             1;