Toolbar

Summary

Bio::TreeIO::TreeEventBuilder - Build Bio::Tree::Tree's and
Bio::Tree::Node's from Events

Package variables

Included modules

Inherit

Bio::Event::EventHandlerI Bio::Root::Root

Synopsis

# internal use only

Description

This object will take events and build a Bio::Tree::TreeI compliant
object makde up of Bio::Tree::NodeI objects.

Methods

Methods description

 Title   : characters
 Usage   : $handler->characters($text);
 Function: Processes characters 
 Returns : none
 Args    : text string

 Title   : end_document
 Usage   : my @trees = $parser->end_document
 Function: Finishes a Phylogeny cycle
 Returns : An array  Bio::Tree::TreeI
 Args    : none

 Title   : end_element
 Usage   : 
 Function:
 Returns : none
 Args    : $data => hashref with key 'Name'

 Title   : in_element
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :

 Title   : new
 Usage   : my $obj = new Bio::TreeIO::TreeEventBuilder();
 Function: Builds a new Bio::TreeIO::TreeEventBuilder object 
 Returns : Bio::TreeIO::TreeEventBuilder
 Args    :

 Title   : nodetype
 Usage   : $obj->nodetype($newval)
 Function: 
 Returns : value of nodetype
 Args    : newvalue (optional)

 Title   : start_document
 Usage   : $handler->start_document
 Function: Begins a Tree event cycle
 Returns : none 
 Args    : none

 Title   : start_element
 Usage   :
 Function:
 Example :
 Returns : 
 Args    : $data => hashref with key 'Name'

 Title   : treetype
 Usage   : $obj->treetype($newval)
 Function: 
 Returns : value of treetype
 Args    : newvalue (optional)

 Title   : within_element
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :

Methods code

sub characters {

   my ($self,$ch) = @_;
   if( $self->within_element('node') ) {
       my $hash = pop @{$self->{'_currentitems'}};
       if( $self->in_element('bootstrap') ) {
	   $hash->{'-bootstrap'} = $ch;
       } elsif( $self->in_element('branch_length') ) {
	   $hash->{'-branch_length'} = $ch;
       } elsif( $self->in_element('id')  ) {
	   $hash->{'-id'} = $ch;
       } elsif( $self->in_element('description') ) {
	   $hash->{'-desc'} = $ch;
       } elsif ( $self->in_element('tag_name') ) {
	   $hash->{'-NHXtagname'} = $ch;
       } elsif ( $self->in_element('tag_value') ) {
	   $hash->{'-nhx'}->{$hash->{'-NHXtagname'}} = $ch;
	   delete $hash->{'-NHXtagname'};
       } elsif( $self->in_element('leaf') ) {
	   $hash->{'-leaf'} = $ch;
       }
       push @{$self->{'_currentitems'}}, $hash;
   }
   $self->debug("chars: $ch\n");
}


1;

}

sub end_document {

    my ($self) = @_; 
    my $vb = $self->verbose;
    my $root = $self->nodetype->new(-verbose => $vb);
    # aggregate the nodes into trees basically ad-hoc.
    while ( @{$self->{'_currentnodes'}} ) {	
	my ($node) = ( shift @{$self->{'_currentnodes'}});
	$root->add_Descendent($node);
    }

    $self->debug("Root node is " . $root->to_string()."\n");
    if( $self->verbose > 0 ) { 
	foreach my $node ( $root->get_Descendents  ) {
	    $self->debug("node is ". $node->to_string(). "\n");
	}
    }
    my $tree = $self->treetype->new(-root    => $root,
				    -verbose => $vb);
    return $tree;

}

sub end_element {

   my ($self,$data) = @_;   

   $self->debug("end of element: $data->{Name}\n");

   if( $data->{'Name'} eq 'node' ) {
       my $tnode;
       my $node = pop @{$self->{'_currentitems'}};	   

       $tnode = $self->nodetype->new(-verbose => $self->verbose,
				     %{$node});
       unless ( $node->{'-leaf'} ) { 
	   for ( splice( @{$self->{'_currentnodes'}}, 
 			 - $self->{'_nodect'}->[$self->{'_treelevel'}+1])) {
	       
	       $self->debug("adding desc: " . $_->to_string . "\n");
	       $tnode->add_Descendent($_);
	   }
	   $self->{_nodect}->[$self->{_treelevel}+1] = 0;
       }
       push @{$self->{'_currentnodes'}}, $tnode;
       $self->{_nodect}->[$self->{'_treelevel'}]++;
       $self->debug ("added node: nodes in stack is ". scalar @{$self->{'_currentnodes'}} . ", treelevel: $self->{_treelevel}, nodect: $self->{_nodect}->[$self->{_treelevel}]\n");
   } elsif(  $data->{'Name'} eq 'tree' ) { 
       $self->debug("end of tree: nodes in stack is ". scalar @{$self->{'_currentnodes'}}. "\n");
       $self->{'_treelevel'}--;
   }
   $self->{'_lastitem'}->{ $data->{'Name'} }--; 
   
   pop @{$self->{'_lastitem'}->{'current'}};

}

sub in_element {

   my ($self,$e) = @_;

   return 0 if ! defined $self->{'_lastitem'} || 
       ! defined $self->{'_lastitem'}->{'current'}->[-1];
   return ($e eq $self->{'_lastitem'}->{'current'}->[-1]);

}

sub new {

  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  my ($treetype, $nodetype) = $self->_rearrange([qw(TREETYPE
						    NODETYPE)], @args);
  $treetype ||= 'Bio::Tree::Tree';
  $nodetype ||= 'Bio::Tree::Node';

  eval { 
      $self->_load_module($treetype);
      $self->_load_module($nodetype);
  };

  if( $@ ) {
      $self->throw("Could not load module $treetype or $nodetype.\n $@\n")
  }
  $self->treetype($treetype);
  $self->nodetype($nodetype);
  $self->{'_treelevel'} = 0;

  return $self;

}

sub nodetype {

   my ($self,$value) = @_;
   if( defined $value) {
      $self->{'nodetype'} = $value;
    }
    return $self->{'nodetype'};

}

sub start_document {

   my ($self) = @_;   
   $self->{'_lastitem'} = {};
   $self->{'_currentitems'} = [];
   $self->{'_currentnodes'} = [];
   return;

}

sub start_element {

   my ($self,$data) =@_;
   $self->{'_lastitem'}->{$data->{'Name'}}++;   

   $self->debug("starting element: $data->{Name}\n");

   push @{$self->{'_lastitem'}->{'current'}},$data->{'Name'};

   my %data;
   
   if( $data->{'Name'} eq 'node' ) {
       push @{$self->{'_currentitems'}},\% data; 
   } elsif ( $data->{Name} eq 'tree' ) {
       $self->{'_treelevel'}++;
   }

}

sub treetype {

   my ($self,$value) = @_;
   if( defined $value) {
      $self->{'treetype'} = $value;
    }
    return $self->{'treetype'};

}

sub within_element {

   my ($self,$e) = @_;
   return $self->{'_lastitem'}->{$e};

}

General documentation

User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to
the Bioperl mailing list. Your participation is much appreciated.

  bioperl-l@bioperl.org              - General discussion
  http://bioperl.org/MailList.shtml  - About the mailing lists

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

  bioperl-bugs@bioperl.org
  http://bugzilla.bioperl.org/

Email jason@bioperl.org
Describe contact details here

Additional contributors names and emails here

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