File Coverage

Bio/TreeIO/tabtree.pm
Criterion Covered Total %
statement 8 27 29.6
branch 0 12 0.0
condition 0 5 0.0
subroutine 3 6 50.0
pod 3 3 100.0
total 14 53 26.4


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::TreeIO::tabtree
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
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::tabtree - A simple output format which displays a tree as an ASCII drawing
17              
18             =head1 SYNOPSIS
19              
20             use Bio::TreeIO;
21             my $in = Bio::TreeIO->new(-file => 'input', -format => 'newick');
22             my $out = Bio::TreeIO->new(-file => '>output', -format => 'tabtree');
23              
24             while( my $tree = $in->next_tree ) {
25             $out->write_tree($tree);
26             }
27              
28             =head1 DESCRIPTION
29              
30             This is a made up format just for outputting trees as an ASCII drawing.
31              
32             =head1 FEEDBACK
33              
34             =head2 Mailing Lists
35              
36             User feedback is an integral part of the evolution of this and other
37             Bioperl modules. Send your comments and suggestions preferably to
38             the Bioperl mailing list. Your participation is much appreciated.
39              
40             bioperl-l@bioperl.org - General discussion
41             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
42              
43             =head2 Support
44              
45             Please direct usage questions or support issues to the mailing list:
46              
47             I
48              
49             rather than to the module maintainer directly. Many experienced and
50             reponsive experts will be able look at the problem and quickly
51             address it. Please include a thorough description of the problem
52             with code and data examples if at all possible.
53              
54             =head2 Reporting Bugs
55              
56             Report bugs to the Bioperl bug tracking system to help us keep track
57             of the bugs and their resolution. Bug reports can be submitted via the
58             web:
59              
60             https://github.com/bioperl/bioperl-live/issues
61              
62             =head1 AUTHOR - Jason Stajich
63              
64             Email jason@bioperl.org
65              
66             =head1 APPENDIX
67              
68             The rest of the documentation details each of the object methods.
69             Internal methods are usually preceded with a _
70              
71             =cut
72              
73              
74             # Let the code begin...
75              
76              
77             package Bio::TreeIO::tabtree;
78 1     1   3 use strict;
  1         1  
  1         27  
79              
80             # Object preamble - inherits from Bio::Root::Root
81              
82              
83              
84 1     1   2 use base qw(Bio::TreeIO);
  1         1  
  1         321  
85              
86             =head2 new
87              
88             Title : new
89             Usage : my $obj = Bio::TreeIO::tabtree->new();
90             Function: Builds a new Bio::TreeIO::tabtree object
91             Returns : Bio::TreeIO::tabtree
92             Args :
93              
94              
95             =cut
96              
97             sub new {
98 1     1 1 2 my($class,@args) = @_;
99              
100 1         5 my $self = $class->SUPER::new(@args);
101              
102             }
103              
104             =head2 write_tree
105              
106             Title : write_tree
107             Usage : $treeio->write_tree($tree);
108             Function: Write a tree out to data stream in newick/phylip format
109             Returns : none
110             Args : Bio::Tree::TreeI object
111              
112             =cut
113              
114             sub write_tree{
115 0     0 1   my ($self,$tree) = @_;
116 0           my $line = _write_tree_Helper($tree->get_root_node,"");
117 0           $self->_print($line. "\n");
118 0 0 0       $self->flush if $self->_flush_on_write && defined $self->_fh;
119 0           return;
120             }
121              
122             sub _write_tree_Helper {
123 0     0     my ($node,$indent) = @_;
124 0 0         return unless defined $node;
125              
126 0           my @d = $node->each_Descendent();
127 0           my $line = "";
128 0           my ($i,$lastchild) = (0,scalar @d - 1);
129 0           for my $n ( @d ) {
130 0 0         if( $n->is_Leaf ) {
131 0   0       $line .= sprintf("%s| \n%s\\-%s\n",
132             $indent,$indent,$n->id || '');
133             } else {
134 0 0         $line .= sprintf("$indent| %s\n",( $n->id ?
135             sprintf("(%s)",$n->id) : ''));
136             }
137 0 0         my $new_indent = $indent . (($i == $lastchild) ? "| " : " ");
138 0 0         if( $n != $node ) {
139             # avoid the unlikely case of cycles
140 0           $line .= _write_tree_Helper($n,$new_indent);
141             }
142             }
143 0           return $line;
144             }
145              
146             =head2 next_tree
147              
148             Title : next_tree
149             Usage :
150             Function: Sorry not possible with this format
151             Returns : none
152             Args : none
153              
154              
155             =cut
156              
157             sub next_tree{
158 0     0 1   $_[0]->throw("Sorry the format 'tabtree' can only be used as an output format at this time");
159             }
160              
161             1;