File Coverage

blib/lib/Dancer2/Plugin/RoutePodCoverage.pm
Criterion Covered Total %
statement 68 72 94.4
branch 17 22 77.2
condition 5 12 41.6
subroutine 9 9 100.0
pod n/a
total 99 115 86.0


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::RoutePodCoverage;
2              
3 3     3   1010086 use strict;
  3         16  
  3         93  
4 3     3   17 use warnings;
  3         6  
  3         78  
5              
6 3     3   1662 use Dancer2::Plugin;
  3         478654  
  3         21  
7 3     3   95271 use Pod::Simple::Search;
  3         18826  
  3         106  
8 3     3   1400 use Pod::Simple::SimpleTree;
  3         93107  
  3         103  
9 3     3   24 use Carp 'croak';
  3         6  
  3         2236  
10              
11             our $VERSION = '0.071';
12              
13             my $PACKAGES_TO_COVER = [];
14              
15             register 'packages_to_cover' => sub {
16 2     2   15 my ( $dsl, $packages_to_cover ) = @_;
17 2 50 33     21 croak "no package(s) provided for 'packages_to_cover' "
      33        
18             if ( !$packages_to_cover
19             || ref $packages_to_cover ne 'ARRAY'
20             || !@$packages_to_cover );
21 2         7 $PACKAGES_TO_COVER = $packages_to_cover;
22             };
23              
24             register 'routes_pod_coverage' => sub {
25 3     3   123 return _get_routes(@_);
26             };
27              
28             sub _get_routes {
29 3     3   8 my ($dsl) = @_;
30 3         6 my @apps = @{ $dsl->runner->apps };
  3         11  
31 3         91 my $all_routes = {};
32              
33 3         18 for my $app (@apps) {
34             next
35 9 100 100     30 if ( @$PACKAGES_TO_COVER && !grep { $app->name eq $_ }
  6         29  
36             @$PACKAGES_TO_COVER );
37 5         126 my $routes = $app->routes;
38 5         45 my $available_routes = [];
39 5         29 foreach my $method ( sort { $b cmp $a } keys %$routes ) {
  52         87  
40 30         45 foreach my $r ( @{ $routes->{$method} } ) {
  30         60  
41              
42             # we don't need pod coverage for head
43 10 100       27 next if $method eq 'head';
44 8         36 push @$available_routes, $method . ' ' . $r->spec_route;
45             }
46             }
47 5 100       24 next unless @$available_routes;
48              
49             ## copy unreferenced array
50 4         19 $all_routes->{ $app->name }{routes} = [@$available_routes];
51              
52 4         9 my $undocumented_routes = [];
53 4         25 my $file = Pod::Simple::Search->new->find( $app->name );
54 4 50       12910 if ($file) {
55 4         20 $all_routes->{ $app->name }{ has_pod } = 1;
56 4         35 my $parser = Pod::Simple::SimpleTree->new->parse_file($file);
57 4         7467 my $pod_dataref = $parser->root;
58 4         34 my $found_routes = {};
59 4         18 for ( my $i = 0 ; $i < @$available_routes ; $i++ ) {
60              
61 8         16 my $r = $available_routes->[$i];
62 8         16 my $app_string = lc $r;
63 8         15 $app_string =~ s/\*/_REPLACED_STAR_/g;
64              
65 8         20 for ( my $idx = 0 ; $idx < @$pod_dataref ; $idx++ ) {
66 64         132 my $pod_part = $pod_dataref->[$idx];
67              
68 64 100       146 next if ref $pod_part ne 'ARRAY';
69 48         89 foreach my $ref_part (@$pod_part) {
70 148 100       281 if (ref($ref_part) eq "ARRAY") {
71 8         18 push @$pod_dataref, $ref_part;
72             }
73             }
74              
75 48         89 my $pod_string = lc $pod_part->[2];
76 48         134 $pod_string =~ s/['|"|\s]+/ /g;
77 48         95 $pod_string =~ s/\s$//g;
78 48         75 $pod_string =~ s/\*/_REPLACED_STAR_/g;
79 48 100       269 if ( $pod_string =~ m/^$app_string$/ ) {
80 4         9 $found_routes->{$app_string} = 1;
81 4         10 next;
82             }
83             }
84 8 100       50 if ( !$found_routes->{$app_string} ) {
85 6         34 push @$undocumented_routes, $r;
86             }
87             }
88             }
89             else { ### no POD found
90 0         0 $all_routes->{ $app->name }{ has_pod } = 0;
91             }
92 4 50 0     14 if (@$undocumented_routes) {
    0          
93 4         21 $all_routes->{ $app->name }{undocumented_routes} = $undocumented_routes;
94             }
95             elsif (! $all_routes->{ $app->name }{ has_pod }
96 0         0 && @{$all_routes->{ $app->name }{routes}} ){
97             ## copy dereferenced array
98 0         0 $all_routes->{ $app->name }{undocumented_routes} = [@{$all_routes->{ $app->name }{routes}}];
  0         0  
99             }
100             }
101 3         22 return $all_routes;
102             }
103              
104             register_plugin;
105              
106             1;
107              
108             __END__
109              
110             =pod
111              
112             =head1 NAME
113              
114             Dancer2::Plugin::RoutePodCoverage - Plugin to verify pod coverage in our app routes.
115              
116             =head1 SYNOPSYS
117              
118             package MyApp::Route;
119              
120             use Dancer2;
121             use Dancer2::Plugin::RoutePodCoverage;
122              
123             get '/' => sub {
124             my $routes_couverage = routes_pod_coverage();
125              
126             # or
127              
128             packages_to_cover(['MYAPP::Routes','MYAPP::Routes::Something']);
129             my $routes_couverage = routes_pod_coverage();
130              
131             };
132              
133             =head1 DESCRIPTION
134              
135             Plugin to verify pod coverage in our app routes.
136              
137             =head1 KEYWORDS
138              
139             =head2 packages_to_cover
140              
141             Keyword to define which packages to check coverage
142              
143             =head2 routes_pod_coverage
144              
145             Keyword that returns all routes e all undocumented routes for each package of the app or packages defined with 'packages_to_cover'
146              
147             =head1 LICENSE
148              
149             This module is released under the same terms as Perl itself.
150              
151             =head1 AUTHOR
152              
153             Dinis Rebolo C<< <drebolo@cpan.org> >>
154              
155             =cut