[Bioperl-guts-l] bioperl-live/Bio/TreeIO nhx.pm,1.14,1.15

[Jason Stajich]

Update of /home/repository/bioperl/bioperl-live/Bio/TreeIO
In directory pub.open-bio.org:/tmp/cvs-serv25086

Modified Files:
	nhx.pm 
Log Message:
allow newline separated clustalW dendogram style output


Index: nhx.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/TreeIO/nhx.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** nhx.pm	11 Nov 2005 20:31:51 -0000	1.14
--- nhx.pm	25 Nov 2005 17:15:59 -0000	1.15
***************
*** 257,262 ****
  sub write_tree{
      my ($self, at trees) = @_;
     foreach my $tree ( @trees ) {
!        my @data = _write_tree_Helper($tree->get_root_node);
         # per bug # 1471 do not include enclosing brackets.
         # this is sort of cheating but it should work
--- 257,263 ----
  sub write_tree{
      my ($self, at trees) = @_;
+     my $nl = $self->newline_each_node;
     foreach my $tree ( @trees ) {
!        my @data = _write_tree_Helper($tree->get_root_node,$nl);
         # per bug # 1471 do not include enclosing brackets.
         # this is sort of cheating but it should work
***************
*** 265,269 ****
  	   $data[0] =~ s/^\(//;
         }
!        $self->_print(join(',', @data), ";\n");
     }
     $self->flush if $self->_flush_on_write && defined $self->_fh;
--- 266,275 ----
  	   $data[0] =~ s/^\(//;
         }
!        if( $nl ) {
! 	   chomp($data[-1]);# remove last newline
! 	   $self->_print(join(",\n", @data), ";\n");
!        } else {
! 	   $self->_print(join(',', @data), ";\n");
!        }
     }
     $self->flush if $self->_flush_on_write && defined $self->_fh;
***************
*** 272,276 ****
  
  sub _write_tree_Helper {
!     my ($node) = @_;
      return () unless defined $node;
      # rebless
--- 278,282 ----
  
  sub _write_tree_Helper {
!     my ($node,$nl) = @_;
      return () unless defined $node;
      # rebless
***************
*** 279,300 ****
      
      foreach my $n ( $node->each_Descendent() ) {
! 	push @data, _write_tree_Helper($n);
      }
      
      if( @data > 1 ) {
! 	$data[0] = "(" . $data[0];
! 	$data[-1] .= ")";
  	my $id = $node->id;
  	$data[-1] .= $id  if( defined $id );
! 	$data[-1] .= ":". $node->branch_length if $node->branch_length;	
  	# this is to not print out an empty NHX for the root node which is 
  	# a convience for how we get a handle to the whole tree
! 	
! 	if( $node->ancestor || defined $id && length($id) || defined $node->branch_length ) {	    
  	    $data[-1] .= '[' . 
  		join(":", "&&NHX",
  		     map { "$_=" .join(',',$node->get_tag_values($_)) } 
! 		     $node->get_all_tags() ) . ']';
! 
  	}
      } else { 
--- 285,321 ----
      
      foreach my $n ( $node->each_Descendent() ) {
! 	push @data, _write_tree_Helper($n,$nl);
      }
      
      if( @data > 1 ) {
! 	if( $nl ) {
! 	    $data[0] = "(\n" . $data[0];
! 	    $data[-1] .= ")\n";	
! 	} else {
! 	    $data[0] = "(" . $data[0];
! 	    $data[-1] .= ")";
! 	}
! 
  	my $id = $node->id;
  	$data[-1] .= $id  if( defined $id );
! 	my $blen  = $node->branch_length;
! 	$data[-1] .= ":". $blen if $blen;	
  	# this is to not print out an empty NHX for the root node which is 
  	# a convience for how we get a handle to the whole tree
! 	my @tags = $node->get_all_tags;
! 	if( $node->ancestor || @tags ) {
  	    $data[-1] .= '[' . 
  		join(":", "&&NHX",
  		     map { "$_=" .join(',',$node->get_tag_values($_)) } 
! 		     @tags ) . ']';
! 	    
! 	} else {
! 	    if( $nl ) {
! 		$data[0] = "(\n" . $data[0];
! 		$data[-1] .= ")\n";	
! 	    } else {
! 		$data[0] = "(" . $data[0];
! 		$data[-1] .= ")";
! 	    }
  	}
      } else {