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

package Bio::Phylo::Unparsers::Hennig86;
use strict;
use base 'Bio::Phylo::Unparsers::Abstract';
use Bio::Phylo;
use Bio::Phylo::Util::CONSTANT qw'/looks_like/ :objecttypes';
use Bio::Phylo::Util::Exceptions 'throw';

my $MATRIX  = _MATRIX_;
my $PROJECT = _PROJECT_;
my %typemap = (
    'continuous' => 'cont',
    'dna'        => 'dna',
    'protein'    => 'prot',
    'restriction'=> 'num',
    'rna'        => 'rna',
    'standard'   => 'num',
);


=head1 NAME

Bio::Phylo::Unparsers::Hennig86 - Serializer used by Bio::Phylo::IO, no serviceable
parts inside

=head1 DESCRIPTION

This module turns the supplied object into a Hennig86 string. The supplied
object has to either be a L object or a
L object, whose first matrix is exported to Hennig86. In
other words, this only works on things that are or contain character state
matrices.

=begin comment

 Type    : Wrapper
 Title   : _to_string
 Usage   : my $hennig_string = $obj->_to_string;
 Function: Stringifies a Bio::Phylo object into a Hennig86 string
 Alias   :
 Returns : SCALAR
 Args    : Bio::Phylo::* object

=end comment

=cut

sub _to_string {
    my $self = shift;
    my $obj  = $self->{'PHYLO'};
    my $matrix;
    if ( looks_like_implementor $obj, '_type' ) {
        if ( $obj->_type == $MATRIX ) {
            $matrix = $obj;
        }
        elsif ( $obj->_type == $PROJECT ) {
            ($matrix) = @{ $obj->get_items(_MATRIX_) };
        }
        else {
            throw 'ObjectMismatch' => "Can't serialize ".ref($obj)." objects as Hennig86";
        }
        return $self->_serialize_matrix($matrix);
    }
    else {
        throw 'ObjectMismatch' => "Can't serialize supplied argument as Hennig86";
    }
}

sub _serialize_matrix {
    my ( $self, $matrix ) = @_;
    my $hennig86 = $self->_create_header($matrix);
    my $to = $matrix->get_type_object;
    for my $row ( @{ $matrix->get_entities } ) {
        $hennig86 .= $row->get_nexus_name . "\t";
        my @char = $row->get_char;
        my @encoded;
        for my $c ( @char ) {
            if ( $to->is_ambiguous($c) ) {
                my @states = @{ $to->get_states_for_symbol($c) };
                push @encoded, '[' . $to->join(\@states) . ']';
            }
            else {
                push @encoded, $c;
            }
        }
        $hennig86 .= $to->join(\@encoded) . "\n";
    }
    return $hennig86 .= ";\n";
}

sub _create_header {
    my ( $self, $matrix ) = @_;

    my $comment = "Hennig86 matrix written by ".ref($self)." ".Bio::Phylo->VERSION." on ".localtime();

    # calculate nstates
    my $nstates = scalar keys %{ $matrix->calc_state_counts };

    # calculate ntax and nchar
    my ( $ntax, $nchar ) = ( $matrix->get_ntax, $matrix->get_nchar );

    # map type to hennig86 tokens
    my $type = lc $matrix->get_type;
    my $hennig86type = $typemap{ $type } || throw 'BadFormat' => "Can't write $type matrices to Hennig86";

    my $template = << 'TEMPLATE';
nstates %d
xread
'%s'
%d %d
& [%s]
TEMPLATE

    return sprintf $template, $nstates, $comment, $nchar, $ntax, $hennig86type;
}

# podinherit_insert_token

=head1 SEE ALSO

There is a mailing list at L
for any user or developer questions and discussions.

=over

=item L

The hennig86 unparser is called by the L object.
Look there to learn how to unparse objects.

=item L

Also see the manual: L and L.

=item Hennig86 file format

To learn more about the Hennig86 format, visit
L.

=back

=head1 CITATION

If you use Bio::Phylo in published research, please cite it:

B, B, B, B
and B, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
I B<12>:63.
L

=cut

1;