File Coverage

blib/lib/Test2/Tools/Pod.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	22	22	100.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	102	102	100.0

use v5.42;

package Test2::Tools::Pod v0.1.0;

use Exporter 'import';
use Path::Iterator::Rule;
use Path::Tiny;
use Pod::Simple;
use Test2::API 'context';

our @EXPORT = qw/ pod_ok all_pod_ok /;
our @Ignore = qw/ .git .hg /;

sub pod_ok ($file, $name = undef, $should_skip = true)
{
    my $ctx = context;
    $name = "POD syntax ok for $file" unless defined $name;

    unless (-f $file) {
        $ctx->fail_and_release($name);
        return false;
    }

    my $parser = Pod::Simple->new;
    $parser->output_string( \ my $null );
    $parser->parse_file($file);

    unless ($parser->content_seen) {
        # no POD in this file
        $ctx->skip($name, 'no POD found') if $should_skip;
        $ctx->release;
        return;
    }

    if ($parser->any_errata_seen) {
        # problems
        my %errors = $parser->errata_seen->%*;

        # %errors:
        #    => [
        #           "",
        #           ...
        #       ],
        #       ...
        # We need it flattened:
        #   "$file:: "
        #   "$file:: "
        #   ...
        $ctx->fail_and_release(
            $name,
            map {
                my $line = $_;
                map { "$file:$line: $_" } $errors{$_}->@*
            }
            sort { $a <=> $b } keys %errors
        );
        return false;
    } else {
        # syntax OK
        $ctx->pass_and_release($name);
        return true;
    }
}

sub all_pod_ok (@locations)
{
    @locations = -d 'blib' ? 'blib' : 'lib' unless @locations;

    my @candidates = _POD_candidates(@locations);
    my $tested = 0;
    my $ctx = context;

    for my $file (@candidates) {
        my $result = pod_ok($file, undef, false);
        ++$tested if defined $result;
    }

    unless ($tested) {
        # no file with POD was found, emit a skip event
        $ctx->skip('POD syntax ok', 'no POD files found');
    }

    $ctx->release;
    return $tested;
}

sub _POD_candidates (@locations)
{
    return () unless @locations;

    my $r = Path::Iterator::Rule->new;
    $r->skip_dirs(@Ignore) if @Ignore;
    $r->file;
    $r->or(
            $r->new->name(qr/\.(?:pl|pm|pod|psgi|t)$/i),
            $r->new->shebang(qr/#!.*\bperl\b/),
        );

    my %seen;
    grep { not $seen{$_}++ } $r->all(@locations);
}

1;

__END__