view release on metacpan or  search on metacpan

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

        my $skipped = $self->skipped;
        my %merged  = %{ $flavor->checks };
        Dist::Conformance::Flavor::merge_checks( \%merged, $self->config->{checks} );
        my %variables = ( %{ $flavor->variables }, %{ $self->config->{variables} } );
        [
            map  { $self->make_check( $_, $merged{$_}, \%variables ) }
            grep { !$skipped->{$_} } $flavor->check_names
        ];
    };
}


sub make_check ( $self, $name, $config, $variables ) {
    my $flavor = $self->flavor->name;
    my $module = $config->{module} // $name;
    my $class  = index( $module, '::' ) >= 0 ? $module : "Dist::Conformance::Check::$module";
    if ( !Dist::Conformance::Schema::matches( $Dist::Conformance::Check::MODULE, $class ) ) {
        die "The flavor $flavor runs the check $name, but $class is not the name of a module\n";
    }
    if ( !eval { Module::Runtime::require_module($class); 1 } ) {
        die( "The flavor $flavor runs the check $name, but its module $class does not load: " . Dist::Conformance::Schema::first_line($@), "\n" );
    }
    die "The flavor $flavor runs the check $name, but $class is not a Dist::Conformance::Check\n" if !$class->isa('Dist::Conformance::Check');
    my $repo = exists $self->config->{checks}{$name} ? " with $Dist::Conformance::Config::FILE" : q{};
    return $class->from_config(
        name      => $name,
        config    => $config,
        source    => $self->source,
        variables => $variables,
        where     => "the check $name of the flavor $flavor$repo",
    );
}

our %STATUSES = map { $_ => 1 } qw{pass fail info};


sub check ($self) {
    my $snapshot = $self->snapshot;
    my %run      = map { $_->name => $_ } @{ $self->checks };
    my @results;
    for my $name ( $self->flavor->check_names ) {
        my $check = $run{$name};
        if ( !$check ) {
            push @results, { check => $name, status => 'skip', detail => "skipped by $Dist::Conformance::Config::FILE" };
            next;
        }
        my ( $status, $detail ) = eval { $check->check($snapshot) };
        if ( !defined $status ) {
            ( $status, $detail ) = ( 'fail', 'the check died: ' . Dist::Conformance::Schema::first_line($@) );
        }
        elsif ( !$STATUSES{$status} ) {
            ( $status, $detail ) = ( 'fail', "the check returned the status $status, which is not pass, fail or info" );
        }
        $status = 'info' if $status eq 'fail' && $check->config->{level} eq 'info';
        push @results, { check => $name, status => $status, detail => $detail // q{} };
    }
    return \@results;
}


sub update ( $self, %options ) {
    my @results;
    for my $check ( @{ $self->checks } ) {
        my $update = Dist::Conformance::Update->new( snapshot => $self->snapshot, dry_run => $options{dry_run} // 0 );
        if ( !eval { $check->update($update); 1 } ) {
            $update->by_hand( 'The update died: ' . Dist::Conformance::Schema::first_line($@) );
        }
        push @results, { check => $check->name, changes => $update->changes, manual => $update->manual };
    }
    return \@results;
}


sub failed ($results) {
    return List::Util::any { $_->{status} eq 'fail' } @$results;
}

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Conformance - Whether the development harness of a repository conforms to its standards, and bringing it up to date

=head1 VERSION

version 0.003

=head1 SYNOPSIS

    use 5.040;
    use Dist::Conformance;

    my $conformance = Dist::Conformance->new( root => '/bogus/checkout' );
    for my $result ( @{ $conformance->check } ) {
        say join "\t", @{$result}{qw{status check detail}};
    }

    my $plan = $conformance->update( dry_run => 1 );
    say "$_->{action} $_->{path}" for map { @{ $_->{changes} } } @$plan;

=head1 DESCRIPTION

Dist::Conformance answers one question about a repository: does its
development harness conform to the standards of an organization, and if not,
can the tool bring it up to date?

The harness is everything around the code that makes working on it safe: the
agent's instructions in F<CLAUDE.md>, the perlcritic profile and the
configuration of the other tools, the git hooks that run them, the files that
the build needs, and the Claude Code settings that load the right plugin.

Four pieces answer the question:

=over

=item The standards