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