view release on metacpan or  search on metacpan

lib/Dist/Conformance/Check/CriticProfile.pm  view on Meta::CPAN

sub config_schema ($) {
    return {
        required   => [qw{file template}],
        properties => {
            file     => $Dist::Conformance::Schema::PATH,
            template => $Dist::Conformance::Schema::PATH,
            replace  => { type => 'boolean', default   => 0 },
            header   => { type => 'string',  minLength => 1 },
            outdated => { type => 'array',   items     => { type => 'string', minLength => 1 } },
        },
    };
}


sub policies ( $text, $where ) {
    my $profile = Config::Tiny->read_string($text) // die( "$where does not parse as a perlcritic profile: " . Config::Tiny->errstr . "\n" );
    my %policies;
    for my $section ( grep { $_ ne q{_} } keys %$profile ) {
        my ( $off, $name ) = $section =~ m/\A(-?)(?:Perl::Critic::Policy::)?(.+)\z/;
        $policies{$name} = $off ? 'disabled' : 'enabled';
    }
    return \%policies;
}


sub missing_policies ( $self, $text ) {
    my ( $file, $template ) = @{ $self->config }{qw{file template}};
    my $want    = policies( ( $self->template($template) )[0], $template );
    my $have    = policies( $text,                             $file );
    my @missing = sort grep { $want->{$_} eq 'enabled' && !exists $have->{$_} } keys %$want;
    return @missing;
}


sub lacks (@missing) {
    return 'lacks the ' . ( @missing == 1 ? 'policy ' : 'policies ' ) . join ', ', @missing;
}


sub verdict ( $self, $text ) {
    my ( $file, $template ) = @{ $self->config }{qw{file template}};
    my @missing = eval { $self->missing_policies($text) };
    if ($@) {
        my $detail = Dist::Conformance::Schema::first_line($@);
        return ( 'fail', $detail, "$detail: fix it by hand, or set replace: true to overwrite it" );
    }
    return ( 'pass', "has every policy of $template" ) if !@missing;
    my $detail = lacks(@missing) . " of $template";
    return ( 'fail', $detail, "$file $detail: add each one to it by hand, or add it as [-Name] to turn it off on purpose, or set replace: true to overwrite it" );
}


sub check ( $self, $snapshot ) {
    my $file = $self->config->{file};
    my $text = $snapshot->content($file) // return ( 'fail', "$file is missing" );
    my ( $status, $detail ) = $self->verdict($text);
    return ( $status, $detail );
}


sub update ( $self, $update ) {
    my ( $file, $template ) = @{ $self->config }{qw{file template}};
    my $text = $update->snapshot->content($file);
    if ( defined $text ) {
        my ( $status, undef, $by_hand ) = $self->verdict($text);
        return                            if $status eq 'pass';
        return $update->by_hand($by_hand) if !$self->config->{replace};
    }
    $self->write_template( $update, $file, $template );
    return;
}

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Conformance::Check::CriticProfile - The perlcritic profile enables or turns off every policy of its template

=head1 VERSION

version 0.003

=head1 DESCRIPTION

A profile is compared with its template by the policies that each names.  Both
are read as Perl::Critic reads a profile, with L<Config::Tiny>: each section
C<[Name]> enables the policy C<Name>, a section C<[-Name]> turns it off, and the
keys before the first section are global settings.  A name with the prefix
C<Perl::Critic::Policy::> is the same policy as the name without it.

The check passes when the file names each policy that the template enables,
either as C<[Name]>, which enables it, or as C<[-Name]>, which turns it off on
purpose.  It fails when the file is missing, when it does not parse, and when
it does not name a policy that the template enables.  The detail names each
such policy.  So when the template gains a policy, every profile that does not
have it yet fails, by the name of that policy.

What else the file says is the distribution's own business, and does not
change the result:

=over

=item the parameters of a policy

A policy that the template configures, and the file configures differently or
not at all, is there.  An exemption or a threshold of its own is a choice of
the distribution, not a policy that it lacks.

=item a policy that the template does not enable

A policy of the distribution's own, or one that the template has dropped or
turns off, can stay.

=item the global settings and the comments

The first line among them, so a header says nothing about whether a profile
is current.