File Coverage

blib/lib/Tree/Simple/View/ASCII.pm
Criterion Covered Total %
statement 54 61 88.5
branch 27 38 71.0
condition 8 12 66.6
subroutine 12 12 100.0
pod 3 3 100.0
total 104 126 82.5


line stmt bran cond sub pod time code
1             package Tree::Simple::View::ASCII;
2              
3 2     2   131776 use strict;
  2         21  
  2         56  
4 2     2   10 use warnings;
  2         4  
  2         107  
5 2     2   812 use Tree::Simple::View::Exceptions;
  2         5  
  2         72  
6              
7 2     2   936 use parent 'Tree::Simple::View';
  2         520  
  2         9  
8              
9             our $VERSION = '0.20';
10              
11             sub expandPathSimple {
12 4     4 1 12 my ( $self, $tree, @full_path ) = @_;
13              
14 4         7 my $output = '';
15 4         7 my @vert_dashes;
16              
17             my $traversal = sub {
18 12     12   70 my ( $t, $redo, $current_path, @path ) = @_;
19 12 100       25 $output .= $self->_processNode( $t, \@vert_dashes ) unless $t->isRoot;
20 12         46 my @children = $t->getAllChildren;
21 12         89 for my $i ( 0 .. $#children ) {
22 36         51 my $subcat = $children[$i];
23 36         52 my $is_last = $i == $#children;
24 36         69 $output .=
25             $self->_handle_child( $subcat, $redo, \@path, $current_path,
26             \@vert_dashes, $is_last );
27             }
28 4         18 };
29              
30             $output .= $self->_processNode( $tree, \@vert_dashes )
31 4 100       26 if $self->{include_trunk};
32              
33             shift @full_path
34             if ( $self->{include_trunk}
35 4 50 66     31 && defined $full_path[0]
      66        
36             && $self->_compareNodeToPath( $full_path[0], $tree ) );
37              
38             # Its the U combinator baby!
39 4         20 $traversal->( $tree, $traversal, @full_path );
40              
41 4         32 return $output;
42             }
43              
44             sub expandAllSimple {
45 4     4 1 11 my ($self) = @_;
46              
47 4         18 my $output = '';
48 4         6 my @vert_dashes;
49              
50             $output .= $self->_processNode( $self->{tree}, \@vert_dashes )
51 4 100       20 if $self->{include_trunk};
52             $self->{tree}->traverse(
53             sub {
54 60     60   975 my $t = shift;
55 60         112 my @siblings = $t->getParent->getAllChildren;
56 60 100       405 $output .=
57             $self->_processNode( $t, \@vert_dashes,
58             $t == $siblings[-1] ? 1 : 0 );
59             }
60 4         31 );
61              
62 4         92 return $output;
63             }
64              
65             sub expandPathComplex {
66 2     2 1 5 my ( $self, $tree, undef, @full_path ) = @_;
67              
68             # complex stuff is not supported here ...
69 2         6 $self->expandPathSimple( $tree, @full_path );
70             }
71              
72             *expandAllComplex = \&expandAllSimple;
73              
74             sub _processNode {
75 100     100   192 my ( $self, $t, $vert_dashes, $is_last ) = @_;
76 100         152 my $depth = $t->getDepth;
77 100 100       279 my $sibling_count = $t->isRoot ? 1 : $t->getParent->getChildCount;
78              
79 100 100       913 $depth++ if $self->{include_trunk};
80              
81 100         141 my $chars = $self->_merge_characters;
82             my @indents =
83 100 50       175 map { $vert_dashes->[$_] || $chars->{indent} } 0 .. $depth - 1;
  136         302  
84              
85             @$vert_dashes =
86 100 100       220 ( @indents, ( $sibling_count == 1 ? $chars->{indent} : $chars->{pipe} ) );
87             $vert_dashes->[$depth] = $chars->{indent}
88 100 100       177 if ( $sibling_count == ( $t->getIndex + 1 ) );
89              
90             my $node =
91             exists $self->{config}->{node_formatter}
92 100 100       1440 ? $self->{config}->{node_formatter}->($t)
93             : $t->getNodeValue;
94              
95             return (
96             ( join "" => @indents[ 1 .. $#indents ] )
97             . (
98             $depth
99             ? ( $is_last ? $chars->{last_branch} : $chars->{branch} )
100 100 100       758 : ""
    100          
101             )
102             . $node . "\n"
103             );
104             }
105              
106             sub _handle_child {
107 36     36   63 my ( $self, $child, $redo, $path, $current_path, $vert_dashes, $is_last ) =
108             @_;
109 36 100 100     97 return $redo->( $child, $redo, @$path )
110             if ( defined $current_path
111             && $self->_compareNodeToPath( $current_path, $child ) );
112 28         113 return $self->_processNode( $child, $vert_dashes, $is_last );
113             }
114              
115             sub _merge_characters {
116 100     100   169 my ($self) = shift;
117              
118             return {
119             pipe => ' | ',
120             indent => ' ',
121             last_branch => ' \---',
122             branch => ' |---',
123             }
124 100 50 33     431 if ( !defined $self->{config} || !defined $self->{config}->{characters} );
125              
126 0           my $chars = { @{ $self->{config}->{characters} } };
  0            
127 0 0         $chars->{pipe} = ' | ' unless $chars->{pipe};
128 0 0         $chars->{indent} = ' ' unless $chars->{indent};
129 0 0         $chars->{last_branch} = ' \---' unless $chars->{last_branch};
130 0 0         $chars->{branch} = ' |---' unless $chars->{branch};
131 0           return $chars;
132             }
133              
134             1;
135              
136             __END__