File Coverage

blib/lib/Bio/AlignIO/nexml.pm

Criterion	Covered	Total	%
statement	15	53	28.3
branch	0	8	0.0
condition	0	3	0.0
subroutine	5	11	45.4
pod	4	4	100.0
total	24	79	30.3

#
# BioPerl module for Bio::AlignIO::nexml
#
# Copyright Chase Miller
#
# You may distribute this module under the same terms as perl itself
# POD documentation - main docs before the code

=head1 NAME

Bio::AlignIO::nexml - NeXML format sequence alignment input/output stream driver

=head1 SYNOPSIS

Do not use this module directly.  Use it via the L class.

=head1 DESCRIPTION

This object can transform L objects to and from
NeXML format. For more information on NeXML, visit L.

=head1 FEEDBACK

=head2 Support

Please direct usage questions or support issues to the mailing list:

I

rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.

=head2 Reporting Bugs

Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution.  Bug reports can be submitted via the
web:

  https://github.com/bioperl/bioperl-live/issues

=head1 AUTHORS

Chase Miller

=head1 CONTRIBUTORS

Mark Jensen, [e-mail]
Rutger Vos, [e-mail]

=head1 APPENDIX

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _

=cut

# Let the code begin...

package Bio::AlignIO::nexml;

use strict;
use lib '../..';
use Bio::Nexml::Factory;
use Bio::Phylo::IO qw(parse unparse);

use base qw(Bio::AlignIO);


sub _initialize {
  my($self,@args) = @_;
  $self->SUPER::_initialize(@args);
  $self->{_doc} = undef;
}

=head2 next_aln

 Title   : next_aln
 Usage   : $aln = $stream->next_aln
 Function: returns the next alignment in the stream.
 Returns : Bio::Align::AlignI object - returns 0 on end of file
	        or on error
 Args    :

See L

=cut

sub next_aln {
	my ($self) = @_;
    unless ( $self->{'_parsed'} ) {
    	#use a parse function to load all the alignment objects found in the nexml file at once
        $self->_parse;
    }
    return $self->{'_alns'}->[ $self->{'_alnsiter'}++ ];
}

=head2 rewind

 Title   : rewind
 Usage   : $alnio->rewind
 Function: Resets the stream
 Returns : none
 Args    : none


=cut

sub rewind {
    my $self = shift;
    $self->{'_alniter'} = 0;
}

=head2 doc

 Title   : doc
 Usage   : $treeio->doc
 Function: Returns the biophylo nexml document object
 Returns : Bio::Phylo::Project
 Args    : none or Bio::Phylo::Project object

=cut

sub doc {
	my ($obj,$value) = @_;
   if( defined $value) {
      $obj->{'_doc'} = $value;
	}
	return $obj->{'_doc'};
}

sub _parse {
    my ($self) = @_;

    $self->{'_parsed'}   = 1;
    $self->{'_alnsiter'} = 0;
    my $fac = Bio::Nexml::Factory->new();

    # Only pass filename if filehandle is not available,
    # or "Bio::Phylo" will create a new filehandle that ends
    # out of scope and can't be closed directly, leaving 2 open
    # filehandles for the same file (so file can't be deleted)
    my $file_arg;
    my $file_value;
    if (     exists $self->{'_filehandle'}
        and defined $self->{'_filehandle'}
        ) {
        $file_arg   = '-handle';
        $file_value = $self->{'_filehandle'};
    }
    else {
        $file_arg   = '-file';
        $file_value = $self->{'_file'};
    }

    $self->doc(parse(
                     $file_arg     => $file_value,
                     '-format'     => 'nexml',
                     '-as_project' => '1'
                     )
    );
    $self->{'_alns'} = $fac->create_bperl_aln($self);

    if(@{ $self->{'_alns'} } == 0) {
        self->debug("no seqs in $self->{_file}");
    }
}

=head2 write_aln

 Title   : write_aln
 Usage   : $stream->write_aln(@aln)
 Function: writes the $aln object into the stream in nexml format
 Returns : 1 for success and 0 for error
 Args    : L object

See L

=cut

sub write_aln {
	my ($self, $aln) = @_;

    my $fac = Bio::Nexml::Factory->new();
    my $taxa = $fac->create_bphylo_taxa($aln);
	my ($matrix) = $fac->create_bphylo_aln($aln, $taxa);
	$matrix->set_taxa($taxa);

	$self->doc(Bio::Phylo::Factory->create_project());
	$self->doc->insert($matrix);
	my $ret = $self->_print($self->doc->to_xml());
	$self->flush;
	return $ret;
}








1;