Bio/TreeIO/nexml.pm

   1 #
   2 # BioPerl module for Bio::TreeIO::nexml
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Chase Miller <chmille4@gmail.com>
   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<http://www.nexml.org>.
  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<bioperl-l@bioperl.org>
  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://redmine.open-bio.org/projects/bioperl/
  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 use strict;
  75
  76 use lib '../..';
  77 use Bio::Event::EventGeneratorI;
  78 use IO::String;
  79 use Bio::Nexml::Factory;
  80 use Bio::Phylo::IO qw (parse unparse);
  81
  82
  83 use base qw(Bio::TreeIO);
  84
  85
  86 sub _initialize {
  87     my $self = shift;
  88     $self->SUPER::_initialize(@_);
  89     $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<Bio::Tree::TreeI>
  98  Args    : none
  99
 100
 101 =cut
 102
 103 sub next_tree {
 104     my ($self) = @_;
 105     unless ( $self->{'_parsed'} ) {
 106         $self->_parse;
 107     }
 108     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         my ($obj,$value) = @_;
 123    if( defined $value) {
 124       $obj->{'_doc'} = $value;
 125         }
 126         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     my $self = shift;
 142     $self->{'_treeiter'} = 0;
 143 }
 144
 145 sub _parse {
 146     my ($self) = @_;
 147
 148     $self->{'_parsed'}   = 1;
 149     $self->{'_treeiter'} = 0;
 150     my $fac = Bio::Nexml::Factory->new();
 151
 152
 153     $self->doc(parse(
 154         '-file'       => $self->{'_file'},
 155         '-format'     => 'nexml',
 156         '-as_project' => '1'
 157         ));
 158
 159         $self->{'_trees'} = $fac->create_bperl_tree($self);
 160 }
 161
 162 =head2 write_tree
 163
 164  Title   : write_tree
 165  Usage   : $treeio->write_tree($tree);
 166  Function: Writes a tree onto the stream
 167  Returns : none
 168  Args    : L<Bio::Tree::TreeI>
 169
 170
 171 =cut
 172
 173 sub write_tree {
 174         my ($self, $bp_tree) = @_;
 175
 176         my $fac = Bio::Nexml::Factory->new();
 177         my $taxa = $fac->create_bphylo_taxa($bp_tree);
 178         my ($tree) = $fac->create_bphylo_tree($bp_tree, $taxa);
 179
 180         my $forest = Bio::Phylo::Factory->create_forest();
 181         $self->doc(Bio::Phylo::Factory->create_project());
 182
 183         $forest->set_taxa($taxa);
 184         $forest->insert($tree);
 185
 186         $self->doc->insert($forest);
 187
 188         my $ret = $self->_print($self->doc->to_xml());
 189         $self->flush;
 190         return $ret;
 191 }
 192
 193
 194 1;