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://github.com/bioperl/bioperl-live/issues
  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     # Only pass filename if filehandle is not available,
 153     # or "Bio::Phylo" will create a new filehandle that ends
 154     # out of scope and can't be closed directly, leaving 2 open
 155     # filehandles for the same file (so file can't be deleted)
 156     my $file_arg;
 157     my $file_value;
 158     if (     exists $self->{'_filehandle'}
 159         and defined $self->{'_filehandle'}
 160         ) {
 161         $file_arg   = '-handle';
 162         $file_value = $self->{'_filehandle'};
 163     }
 164     else {
 165         $file_arg   = '-file';
 166         $file_value = $self->{'_file'};
 167     }
 168
 169     $self->doc(parse(
 170                      $file_arg     => $file_value,
 171                      '-format'     => 'nexml',
 172                      '-as_project' => '1'
 173                      )
 174     );
 175     $self->{'_trees'} = $fac->create_bperl_tree($self);
 176 }
 177
 178 =head2 write_tree
 179
 180  Title   : write_tree
 181  Usage   : $treeio->write_tree($tree);
 182  Function: Writes a tree onto the stream
 183  Returns : none
 184  Args    : L<Bio::Tree::TreeI>
 185
 186
 187 =cut
 188
 189 sub write_tree {
 190         my ($self, $bp_tree) = @_;
 191
 192         my $fac = Bio::Nexml::Factory->new();
 193         my $taxa = $fac->create_bphylo_taxa($bp_tree);
 194         my ($tree) = $fac->create_bphylo_tree($bp_tree, $taxa);
 195
 196         my $forest = Bio::Phylo::Factory->create_forest();
 197         $self->doc(Bio::Phylo::Factory->create_project());
 198
 199         $forest->set_taxa($taxa);
 200         $forest->insert($tree);
 201
 202         $self->doc->insert($forest);
 203
 204         my $ret = $self->_print($self->doc->to_xml());
 205         $self->flush;
 206         return $ret;
 207 }
 208
 209
 210 1;