File Coverage

lib/Pod/Headings.pm
Criterion Covered Total %
statement 59 59 100.0
branch 11 12 91.6
condition 2 3 66.6
subroutine 10 10 100.0
pod 1 1 100.0
total 83 85 97.6


line stmt bran cond sub pod time code
1             package Pod::Headings;
2              
3 2     2   13 use strict;
  2         4  
  2         58  
4 2     2   9 use warnings;
  2         4  
  2         44  
5              
6 2     2   20 use v5.20;
  2         6  
7              
8 2     2   1318 use Pod::Simple;
  2         63842  
  2         123  
9             our @ISA = qw(Pod::Simple);
10             our $VERSION = '0.02';
11              
12 2     2   17 use feature 'signatures';
  2         5  
  2         216  
13 2     2   12 no warnings 'experimental::signatures';
  2         3  
  2         1180  
14              
15             #
16             # Can pass a list of handlers to new()
17             #
18 2     2 1 3 sub new ($class, @args) {
  2         3  
  2         6  
  2         11  
19 2         16 my $self = $class->SUPER::new();
20 2         61 $self->{handlers} = {@args}; # if scalar @args;
21 2         4 $self->{_elements} = [];
22 2         27 return $self;
23             }
24              
25 62     62   20464 sub _handle_element_start ($parser, $element_name, $attr_hash_r) {
  62         71  
  62         72  
  62         58  
  62         55  
26              
27 62 100       142 return unless defined $parser->{handlers}{$element_name};
28 52         52 push @{$parser->{_elements}}, { heading => $element_name, text => '', attrs=> $attr_hash_r };
  52         195  
29             }
30              
31 62     62   393 sub _handle_element_end ($parser, $element_name, $attr_hash_r = undef) {
  62         64  
  62         63  
  62         67  
  62         60  
32              
33 62 100 66     63 return unless scalar @{$parser->{_elements}} && ($element_name eq ${$parser->{_elements}}[-1]->{heading});
  62         129  
  52         149  
34            
35 52         63 my $propagate_text = 0;
36 52         53 my $this_element = pop @{$parser->{_elements}};
  52         64  
37 52 100       111 if (ref $parser->{handlers}{$element_name} eq 'CODE') {
38 44         125 $propagate_text = $parser->{handlers}{$element_name}->($parser, $element_name, $this_element->{attrs}, $this_element->{text});
39             } else {
40 8         10 $propagate_text = $parser->{handlers}{$element_name};
41             }
42              
43 52 50       95 if ($propagate_text) {
44 52 100       48 if (scalar @{$parser->{_elements}}) {
  52         142  
45 8         8 ${$parser->{_elements}}[-1]->{text} .= $this_element->{text};
  8         27  
46             }
47             }
48              
49             }
50              
51 63     63   489 sub _handle_text ($parser, $text) {
  63         71  
  63         70  
  63         57  
52              
53 63 100       75 ${$parser->{_elements}}[-1]->{text} .= $text if scalar @{$parser->{_elements}};
  56         138  
  63         132  
54              
55             }
56              
57             1;
58              
59             __END__