File Coverage

blib/lib/Pod/Simple/SimpleTree.pm
Criterion Covered Total %
statement 35 39 89.7
branch 3 4 75.0
condition n/a
subroutine 8 9 88.8
pod n/a
total 46 52 88.4


line stmt bran cond sub pod time code
1             package Pod::Simple::SimpleTree;
2 2     2   137014 use strict;
  2         4  
  2         84  
3 2     2   10 use warnings;
  2         10  
  2         95  
4 2     2   77 use Carp ();
  2         3  
  2         31  
5 2     2   736 use Pod::Simple ();
  2         5  
  2         180  
6             our $VERSION = '3.47';
7             BEGIN {
8 2     2   40 our @ISA = ('Pod::Simple');
9 2 50       960 *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
10             }
11              
12             __PACKAGE__->_accessorize(
13             'root', # root of the tree
14             );
15              
16             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
17              
18             sub _handle_element_start { # self, tagname, attrhash
19 7     7   14 DEBUG > 2 and print STDERR "Handling $_[1] start-event\n";
20 7         19 my $x = [$_[1], $_[2]];
21 7 100       19 if($_[0]{'_currpos'}) {
22 1         3 push @{ $_[0]{'_currpos'}[0] }, $x; # insert in parent's child-list
  1         4  
23 1         3 unshift @{ $_[0]{'_currpos'} }, $x; # prefix to stack
  1         4  
24             } else {
25 6         10 DEBUG and print STDERR " And oo, it gets to be root!\n";
26 6         20 $_[0]{'_currpos'} = [ $_[0]{'root'} = $x ];
27             # first event! set to stack, and set as root.
28             }
29             DEBUG > 3 and print STDERR "Stack is now: ",
30 7         13 join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
31 7         19 return;
32             }
33              
34             sub _handle_element_end { # self, tagname
35 7     7   8 DEBUG > 2 and print STDERR "Handling $_[1] end-event\n";
36 7         10 shift @{$_[0]{'_currpos'}};
  7         17  
37             DEBUG > 3 and print STDERR "Stack is now: ",
38 7         13 join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
39 7         19 return;
40             }
41              
42             sub _handle_text { # self, text
43 0     0   0 DEBUG > 2 and print STDERR "Handling $_[1] text-event\n";
44 0         0 push @{ $_[0]{'_currpos'}[0] }, $_[1];
  0         0  
45 0         0 return;
46             }
47              
48              
49             # A bit of evil from the black box... please avert your eyes, kind souls.
50             sub _traverse_treelet_bit {
51 6     6   11 DEBUG > 2 and print STDERR "Handling $_[1] paragraph event\n";
52 6         25 my $self = shift;
53 6         11 push @{ $self->{'_currpos'}[0] }, [@_];
  6         36  
54 6         23 return;
55             }
56             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57             1;
58             __END__