File Coverage

blib/lib/Pod/Coverage/TrustMe/Parser.pm
Criterion Covered Total %
statement 81 84 96.4
branch 28 30 93.3
condition 25 30 83.3
subroutine 12 12 100.0
pod 5 5 100.0
total 151 161 93.7


line stmt bran cond sub pod time code
1             package Pod::Coverage::TrustMe::Parser;
2 24     24   132 use strict;
  24         65  
  24         758  
3 24     24   132 use warnings;
  24         39  
  24         1969  
4              
5             our $VERSION = '0.002002';
6             $VERSION =~ tr/_//d;
7              
8 24     24   13944 use Pod::Simple ();
  24         899436  
  24         1164  
9             our @ISA = qw(Pod::Simple);
10 24     24   191 use Carp qw(croak);
  24         38  
  24         30837  
11              
12             sub new {
13 84     84 1 199 my $class = shift;
14 84         525 my $self = $class->SUPER::new(@_);
15 84         3640 $self->accept_targets_as_text('Pod::Coverage');
16 84         1682 $self->{+__PACKAGE__} = {};
17 84         238 return $self;
18             }
19              
20             sub ignore_empty {
21 414     414 1 604 my $self = shift;
22 414         623 my $me = $self->{+__PACKAGE__};
23 414 100       840 if (@_) {
24 1         2 $me->{ignore_empty} = shift;
25             }
26 414         958 return $me->{ignore_empty};
27             }
28              
29             sub _handle_element_start {
30 2476     2476   648281 my $self = shift;
31 2476         3762 my $me = $self->{+__PACKAGE__};
32 2476         4143 my ($name, $attr) = @_;
33 2476 100 100     16180 if ($name eq 'for') {
    100 100        
    100 100        
    100 100        
34 9         19 push @{ $me->{in} }, $attr;
  9         33  
35             }
36             elsif ($name eq 'L' && $attr->{type} eq 'pod' && defined $attr->{to}) {
37 151         403 my $to = "$attr->{to}";
38 89         218 push @{ $me->{links} }, $to
39 151 100       2177 unless $me->{links_hash}{$to}++;
40             }
41             elsif ($name eq 'item-text' || $name eq 'item-bullet' || $name =~ /\Ahead[2-9]\z/) {
42 413         716 delete $me->{maybe_covered};
43 413         851 $me->{consider} = $name;
44 413         796 $me->{consider_text} = '';
45             }
46             elsif ($name =~ /\Ahead1\z/) {
47 157         307 delete $me->{maybe_covered};
48             }
49 2476         5649 $self->SUPER::_handle_element_start(@_);
50             }
51             sub _handle_element_end {
52 2476     2476   28897 my $self = shift;
53 2476         3393 my $me = $self->{+__PACKAGE__};
54 2476         3642 my ($name) = @_;
55 2476 100 100     7812 if ($name eq 'for') {
    100          
56 9         15 pop @{ $self->{+__PACKAGE__}{in} };
  9         21  
57             }
58             elsif ($name eq ($me->{consider}||'')) {
59 413         791 delete $me->{consider};
60 413         693 my $text = delete $me->{consider_text};
61 413         2124 my @covered = $text =~ /([^\s\|,\/]+)/g;
62 413         805 for my $covered ( @covered ) {
63             # looks like a method
64 897         1587 $covered =~ s/.*->//;
65             # looks fully qualified
66 897         1238 $covered =~ s/\A\w+(?:::\w+)*::(\w+)/$1/;
67             # looks like it includes parameters
68 897         2356 $covered =~ s/(\w+)[;\(].*/$1/;
69             }
70 413         2055 @covered = grep /\A\w+\z/, @covered;
71 413 100       952 if ($self->ignore_empty) {
72 2         3 push @{ $me->{maybe_covered} }, @covered;
  2         5  
73             }
74             else {
75 411         2242 push @{ $me->{covered} },
76 411         564 grep !$me->{covered_hash}{$_}++,
77             @covered;
78             }
79             }
80 2476         4740 $self->SUPER::_handle_element_end(@_);
81             }
82              
83             sub _handle_text {
84 2831     2831   26170 my $self = shift;
85 2831         3792 my $me = $self->{+__PACKAGE__};
86 2831         4369 my ($text) = @_;
87 2831         3890 my $in = $me->{in};
88 2831 100 100     8959 if ($in && @$in && $in->[-1]{target} =~ /\APod::Coverage(?:::Trust(?:Me|Pod))?\z/) {
    100 66        
    100          
89 10         81 for my $token ($text =~ /(\S+)/g) {
90 11         18 my $re;
91 11 100       33 if ($token eq '*EVERYTHING*') {
92 1         6 $re = qr{.?};
93             }
94             else {
95 10         20 $re = eval { qr{\A(?:$token)\z} };
  10         233  
96 10 50       38 if (!$re) {
97 0   0     0 my $file = $self->{source_filename} || '';
98 0   0     0 my $line = $in->[-1]{start_line} || '';
99 0         0 croak "Error compiling Pod::Coverage regex /$token/ at $file line $line: $@";
100             }
101             }
102 11         39 push @{ $me->{trusted} }, $re
103 11 50       71 unless $me->{trusted_hash}{$re}++;
104             }
105             }
106             elsif ($me->{consider}) {
107 545         1152 $me->{consider_text} .= $text;
108             }
109             elsif ($me->{maybe_covered}) {
110 1         2 push @{ $me->{covered} },
111             grep !$me->{covered_hash}{$_}++,
112 1         2 @{ delete $me->{maybe_covered} };
  1         4  
113             }
114 2831         5377 $self->SUPER::_handle_text(@_);
115             }
116              
117             sub links {
118 11     11 1 16 my $self = shift;
119 11   100     122 return $self->{+__PACKAGE__}{links} ||= [];
120             }
121              
122             sub trusted {
123 28     28 1 47 my $self = shift;
124 28   100     381 return $self->{+__PACKAGE__}{trusted} ||= [];
125             }
126              
127             sub covered {
128 82     82 1 142 my $self = shift;
129 82   100     858 return $self->{+__PACKAGE__}{covered} ||= [];
130             }
131              
132             1;
133             __END__