File Coverage

blib/lib/Test/Perl/Lint.pm

Criterion	Covered	Total	%
statement	57	63	90.4
branch	10	20	50.0
condition	3	9	33.3
subroutine	11	11	100.0
pod	1	1	100.0
total	82	104	78.8

package Test::Perl::Lint;
use strict;
use warnings;
use utf8;
use parent qw/Test::Builder::Module/;

my @test_more_exports;
BEGIN { @test_more_exports = (qw/done_testing/) }
use Test::More import => \@test_more_exports;
use Carp ();
use Path::Tiny 0.068 qw/path/;
use Perl::Lint;

our $VERSION = "0.24";

our @EXPORT = (@test_more_exports, qw/all_policies_ok/);

sub all_policies_ok {
    local $Test::Builder::Level = $Test::Builder::Level + 2;

    my ($args) = @_;

    my $targets = $args->{targets} // Carp::croak "Targets must not be empty";
    my $ignore_files = $args->{ignore_files};

    if (defined $targets && ref $targets ne 'ARRAY') {
        Carp::croak 'Target directories are must be an array reference';
    }

    if (defined $ignore_files && ref $ignore_files ne 'ARRAY') {
        Carp::croak 'Ignore files are must be an array reference';
    }

    my $linter = Perl::Lint->new({
        ignore => $args->{ignore_policies},
        filter => $args->{filter},
    });

    my @paths;
    for my $target (@$targets) {
        if (-d $target) {
            path($target)->visit(sub {
                my ($path) = @_;
                if ($path->is_file) {
                    my $path_string = $path->stringify;
                    if (!grep {$_ eq $path_string} @$ignore_files) {
                        push @paths, $path_string;
                    }
                }
            }, {recurse => 1});
        }
        elsif (-f $target) {
            if (!grep {$_ eq $target} @$ignore_files) {
                push @paths, $target;
            }
        }
        else {
            Carp::carp "'$target' doesn't exist";
        }
    }
    @paths = sort {$a cmp $b} @paths;

    for my $path_string (@paths) {
        my $violations = $linter->lint($path_string);
        if (scalar @$violations == 0) {
            Test::More::pass(__PACKAGE__ . ' for ' . $path_string);
        }
        else {
            my $package = __PACKAGE__;
            my $error_msg = <<"...";

$package found these violations in "$path_string":
...

            for my $violation (@$violations) {
                my $explanation = $violation->{explanation};
                if (ref $explanation eq 'ARRAY') {
                    $explanation = 'See page ' . join(', ', @$explanation) . ' of PBP';
                }
                $error_msg .= <<"...";
$violation->{description} at line $violation->{line}. $explanation.
...
            }

            Test::More::ok(0, "$package for $path_string") or Test::More::diag($error_msg);
        }
    }

    return;
}

1;

__END__