Bio::TreeIO - Parser for Tree files

  {
      use Bio::TreeIO;
      my $treeio = Bio::TreeIO->new('-format' => 'newick',
                   '-file'   => 'globin.dnd');
      while( my $tree = $treeio->next_tree ) {
		print "Tree is ", $tree->number_nodes, "\n";
      }
  }

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Title   : new
 Usage   : my $obj = Bio::TreeIO->new();
 Function: Builds a new Bio::TreeIO object 
 Returns : Bio::TreeIO
 Args    : a hash.  useful keys:
   -format : Specify the format of the file.  Supported formats:

     newick             Newick tree format
     nexus              Nexus tree format
     nhx                NHX tree format
     svggraph           SVG graphical representation of tree
     tabtree            ASCII text representation of tree
     lintree            lintree output format

 Title   : next_tree
 Usage   : my $tree = $treeio->next_tree;
 Function: Gets the next tree off the stream
 Returns : Bio::Tree::TreeI or undef if no more trees
 Args    : none

 Title   : write_tree
 Usage   : $treeio->write_tree($tree);
 Function: Writes a tree onto the stream
 Returns : none
 Args    : Bio::Tree::TreeI

 Title   : attach_EventHandler
 Usage   : $parser->attatch_EventHandler($handler)
 Function: Adds an event handler to listen for events
 Returns : none
 Args    : Bio::Event::EventHandlerI

 Title   : _eventHandler
 Usage   : private
 Function: Get the EventHandler
 Returns : Bio::Event::EventHandlerI
 Args    : none

 Title   : _load_format_module
 Usage   : *INTERNAL TreeIO stuff*
 Function: Loads up (like use) a module at run time on demand
 Example :
 Returns :
 Args    :

 Title   : _guess_format
 Usage   : $obj->_guess_format($filename)
 Function:
 Example :
 Returns : guessed format of filename (lower case)
 Args    :

#
# BioPerl module for Bio::TreeIO
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Jason Stajich <jason@bioperl.org>
#
# Copyright Jason Stajich
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

# Let the code begin...


package Bio::TreeIO;
use strict;

# Object preamble - inherits from Bio::Root::Root

use Bio::TreeIO::TreeEventBuilder;

use base qw(Bio::Root::Root Bio::Root::IO Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);

sub new {
  my($caller,@args) = @_;
  my $class = ref($caller) || $caller;

    # or do we want to call SUPER on an object if $caller is an
    # object?n

  my $obj;
  if( $class =~ /Bio::TreeIO::(\S+)/ ) {
    $obj = $class->SUPER::new(@args);
    $obj->_initialize(@args);
  } else {     
    my %param = @args;
    @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
    my $format = $param{'-format'} || 
      $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
      'newick';
    $format = "\L$format";  # normalize capitalization to lower case
      
    # normalize capitalization
    return undef unless( $class->_load_format_module($format) );
    $obj = "Bio::TreeIO::$format"->new(@args);
  }
  return $obj;
}

sub next_tree{
   my ($self) = @_;
   $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
}

sub write_tree{
   my ($self,$tree) = @_;
   $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
}

sub attach_EventHandler{
    my ($self,$handler) = @_;
    return if( ! $handler );
    if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
    $self->warn("Ignoring request to attach handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
    }
    $self->{'_handler'} = $handler;
    return;
}

sub _eventHandler{
   my ($self) = @_;
   return $self->{'_handler'};
}

sub _initialize {
    my($self, @args) = @_;
    $self->{'_handler'} = undef;

    $self->get_params; # Initialize the default parameters.

    my ($nen,$ini) = $self->_rearrange
    ([qw(NEWLINE_EACH_NODE INTERNAL_NODE_ID)],@args);
    $self->set_param('newline_each_node',$nen);
    $self->set_param('internal_node_id',$ini);

    $self->attach_EventHandler(Bio::TreeIO::TreeEventBuilder->new
                   (-verbose => $self->verbose(), @args));
    $self->_initialize_io(@args);
    #$self->debug_params;
}

sub _load_format_module {
  my ($self,$format) = @_;
  my $module = "Bio::TreeIO::" . $format;
  my $ok;
  
  eval {
      $ok = $self->_load_module($module);
  };

  if ( $@ ) {
    print STDERR <<END;
$self: $format cannot be found
Exception $@
For more information about the TreeIO system please see the TreeIO docs.
This includes ways of checking for formats at compile time, not run time
END
  ;
  }
  return $ok;
}

sub param {
  my $self = shift;
  my $param = shift;
  my $value = shift;

  if (defined $value) {
    $self->get_params->{$param} = $value;
  }
  return $self->get_params->{$param};
}

sub set_param {
  my $self = shift;
  my $param = shift;
  my $value = shift;

  #print STDERR "[$param] -> [undef]\n" if (!defined $value);
  return unless (defined $value);
  #print STDERR "[$param] -> [$value]\n";

  $self->get_params->{$param} = $value;
  return $self->param($param);
}

sub params {
  my $self = shift;
  return $self->get_params;
}
sub get_params {
  my $self = shift;

  if (!defined $self->{_params}) {
    $self->{_params} = $self->get_default_params;
  }

  return $self->{_params};
}

sub set_params {
  my $self = shift;
  my $params = shift;

  # Apply all the passed parameters to our internal parm hashref.
  my $cur_params = $self->get_params;
  $self->{_params} = { %$cur_params, %$params };

  return $self->get_params;
}

sub get_default_params {
  my $self = shift;
  
  return {};
}

sub debug_params {
  my $self = shift;

  my $params = $self->get_params;

  print STDERR "{\n";
  foreach my $param (keys %$params) {
    my $value = $params->{$param};
    print STDERR "  [$param] -> [$value]\n";
  }
  print STDERR "}\n";
}

sub _guess_format {
   my $class = shift;
   return unless $_ = shift;
   return 'newick'   if /\.(dnd|newick|nh)$/i;
   return 'nhx'   if /\.(nhx)$/i;
   return 'phyloxml' if /\.(xml)$/i;
   return 'svggraph' if /\.svg$/i;
   return 'lintree'  if( /\.(lin|lintree)$/i );
}

sub DESTROY {
    my $self = shift;

    $self->close();
}

sub TIEHANDLE {
  my $class = shift;
  return bless {'treeio' => shift},$class;
}

sub READLINE {
  my $self = shift;
  return $self->{'treeio'}->next_tree() unless wantarray;
  my (@list,$obj);
  push @list,$obj  while $obj = $self->{'treeio'}->next_tree();
  return @list;
}

sub PRINT {
  my $self = shift;
  $self->{'treeio'}->write_tree(@_);
}

1;