annotate variant_effect_predictor/Bio/TreeIO/nhx.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 # $Id: nhx.pm,v 1.4.2.2 2003/09/14 19:00:36 jason Exp $
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 # BioPerl module for Bio::TreeIO::nhx
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5 # Cared for by Aaron Mackey <amackey@virginia.edu>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 # Copyright Aaron Mackey
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11 # POD documentation - main docs before the code
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15 Bio::TreeIO::nhx - TreeIO implementation for parsing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16 Newick/New Hampshire eXtendend (NHX) format.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20 # do not use this module directly
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 use Bio::TreeIO;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22 my $treeio = new Bio::TreeIO(-format => 'nhx', -file => 'tree.dnd');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 my $tree = $treeio->next_tree;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27 This module handles parsing and writing of Newick/New Hampshire eXtended (NHX) format.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29 =head1 FEEDBACK
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31 =head2 Mailing Lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 User feedback is an integral part of the evolution of this and other
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34 Bioperl modules. Send your comments and suggestions preferably to the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 Bioperl mailing list. Your participation is much appreciated.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37 bioperl-l@bioperl.org - General discussion
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38 http://bioperl.org/MailList.shtml - About the mailing lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40 =head2 Reporting Bugs
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42 Report bugs to the Bioperl bug tracking system to help us keep track
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43 of the bugs and their resolution. Bug reports can be submitted via
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44 email or the web:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 bioperl-bugs@bioperl.org
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47 http://bugzilla.bioperl.org/
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49 =head1 AUTHOR - Aaron Mackey
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51 Email amackey@virginia.edu
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53 Describe contact details here
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55 =head1 CONTRIBUTORS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57 Additional contributors names and emails here
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59 =head1 APPENDIX
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61 The rest of the documentation details each of the object methods.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 Internal methods are usually preceded with a _
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67 # Let the code begin...
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70 package Bio::TreeIO::nhx;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71 use vars qw(@ISA);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74 # Object preamble - inherits from Bio::Root::Root
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 use Bio::TreeIO;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77 use Bio::Tree::NodeNHX;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 use Bio::Event::EventGeneratorI;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79 #use XML::Handler::Subs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82 @ISA = qw(Bio::TreeIO );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84 sub _initialize {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85 my($self, %args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86 $args{-nodetype} ||= 'Bio::Tree::NodeNHX';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87 $self->SUPER::_initialize(%args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90 =head2 next_tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92 Title : next_tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93 Usage : my $tree = $treeio->next_tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94 Function: Gets the next tree in the stream
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95 Returns : Bio::Tree::TreeI
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 sub next_tree{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103 local $/ = ";\n";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104 return unless $_ = $self->_readline;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105 s/\s+//g;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 $self->debug("entry is $_\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107 my $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108 $self->_eventHandler->start_document;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109 my ($prev_event,$lastevent) = ('','');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110 my @ch = split(//, $_);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111 foreach my $ch (@ch) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112 if( $ch eq ';' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 $self->_eventHandler->in_element('node') &&
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114 $self->_eventHandler->end_element( {'Name' => 'node'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 return $self->_eventHandler->end_document;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116 } elsif ($ch eq '[') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 if ( length $chars ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118 if ( $lastevent eq ':' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119 $self->_eventHandler->start_element( { Name => 'branch_length' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121 $self->_eventHandler->end_element( { Name => 'branch_length' });
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122 $lastevent = $prev_event;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 $self->debug("id with no branchlength is $chars\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125 $self->_eventHandler->start_element( { 'Name' => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 $self->_eventHandler->start_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128 $self->_eventHandler->end_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 $self->_eventHandler->start_element( { Name => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133 my $leafstatus = ( $lastevent ne ')' ) ? 1 : 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134 $self->_eventHandler->start_element({'Name' => 'leaf'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135 $self->_eventHandler->characters($leafstatus);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 $self->_eventHandler->end_element({'Name' => 'leaf'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 $self->_eventHandler->start_element( { Name => 'nhx_tag' });
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140 } elsif( $ch eq '(' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142 $self->_eventHandler->start_element( {'Name' => 'tree'} );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143 } elsif($ch eq ')' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144 if( length $chars ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145 if( $lastevent eq ':') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 unless ($self->_eventHandler->within_element('nhx_tag')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147 $self->_eventHandler->start_element( { 'Name' => 'branch_length'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149 $self->_eventHandler->end_element( {'Name' => 'branch_length'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151 $self->throw("malformed input; end of node ) before ] found");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154 $self->debug("id with no branchlength is $chars\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 $self->_eventHandler->start_element( { 'Name' => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 $self->_eventHandler->start_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158 $self->_eventHandler->end_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161 } elsif ( $lastevent ne ']' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 $self->_eventHandler->start_element( {'Name' => 'node'} );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164 my $leafstatus = ( $lastevent ne ')' ) ? 1 : 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165 $self->_eventHandler->start_element({'Name' => 'leaf'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166 $self->_eventHandler->characters($leafstatus);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167 $self->_eventHandler->end_element({'Name' => 'leaf'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169 $self->_eventHandler->end_element( {'Name' => 'node'} );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170 $self->_eventHandler->end_element( {'Name' => 'tree'} );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172 } elsif ( $ch eq ',' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 if( length $chars ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174 if( $lastevent eq ':' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 $self->_eventHandler->start_element( { 'Name' => 'branch_length'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177 $self->_eventHandler->end_element( {'Name' => 'branch_length'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 $lastevent = $prev_event;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180 $self->debug("id with no branchlength is $chars\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181 $self->_eventHandler->start_element( { 'Name' => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182 $self->_eventHandler->start_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184 $self->_eventHandler->end_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186 } elsif ( $lastevent ne ']' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187 $self->_eventHandler->start_element( { 'Name' => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 $self->_eventHandler->end_element( {'Name' => 'node'} );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 } elsif( $ch eq ':' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192 if ($self->_eventHandler->within_element('nhx_tag')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193 if ($lastevent eq '=') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 $self->_eventHandler->start_element( { Name => 'tag_value' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 $self->_eventHandler->end_element( { Name => 'tag_value' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199 if ($chars eq '&&NHX') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 $chars = ''; # get rid of &&NHX:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 $self->throw("Unrecognized, non \&\&NHX string: >>$chars<<");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205 } elsif ($lastevent ne ']') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206 $self->debug("id with a branchlength coming is $chars\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 $self->_eventHandler->start_element( { 'Name' => 'node' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 $self->_eventHandler->start_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 $self->_eventHandler->end_element( { 'Name' => 'id' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213 } elsif ( $ch eq '=' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214 if ($self->_eventHandler->within_element('nhx_tag')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215 $self->_eventHandler->start_element( { Name => 'tag_name' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 $self->_eventHandler->end_element( { Name => 'tag_name' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220 $chars .= $ch;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222 } elsif ( $ch eq ']' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223 if ($self->_eventHandler->within_element('nhx_tag') && $lastevent eq '=') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 $self->_eventHandler->start_element( { Name => 'tag_value' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225 $self->_eventHandler->characters($chars);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 $self->_eventHandler->end_element( { Name => 'tag_value' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227 $chars = '';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 $self->_eventHandler->end_element( { Name => 'nhx_tag' } );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 $chars .= $ch;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234 $chars .= $ch;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237 $prev_event = $lastevent;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238 $lastevent = $ch;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240 return undef;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243 =head2 write_tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245 Title : write_tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 Usage : $treeio->write_tree($tree);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247 Function: Write a tree out to data stream in nhx format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 Returns : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
249 Args : Bio::Tree::TreeI object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
250
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
251 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
252
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
253 sub write_tree{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
254 my ($self,@trees) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
255 foreach my $tree ( @trees ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
256 my @data = _write_tree_Helper($tree->get_root_node);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
257 if($data[-1] !~ /\)$/ ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
258 $data[0] = "(".$data[0];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
259 $data[-1] .= ")";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
260 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
261 $self->_print(join(',', @data), ";\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
262 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
263 $self->flush if $self->_flush_on_write && defined $self->_fh;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
264 return;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
265 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
266
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
267 sub _write_tree_Helper {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
268 my ($node) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
269 return () unless defined $node;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
270
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
271 my @data;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
272
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
273 foreach my $n ( $node->each_Descendent() ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
274 push @data, _write_tree_Helper($n);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
275 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
276
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
277 if( @data > 1 ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
278 $data[0] = "(" . $data[0];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
279 $data[-1] .= ")";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
280 $data[-1] .= ":". $node->branch_length if $node->branch_length;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
281 # this is to not print out an empty NHX for the root node which is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
282 # a convience for how we get a handle to the whole tree
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
283 if( $node->ancestor || $node->id || defined $node->branch_length ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
284 $data[-1] .= '[' .
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
285 join(":", "&&NHX",
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
286 map { "$_=" .join(',',$node->get_tag_values($_)) }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
287 $node->get_all_tags() ) . ']';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
288 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
289 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
290 push @data, $node->to_string; # a leaf
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
291 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
292 return @data;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
293 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
294
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
295
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
296 1;