| 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 |