App-LintPrereqs
view release on metacpan or search on metacpan
lib/App/LintPrereqs.pm view on Meta::CPAN
package App::LintPrereqs;
use 5.010001;
use strict;
use warnings;
use Log::ger;
use Config::IOD;
use Exporter 'import';
use Fcntl qw(:DEFAULT);
use File::Find;
use File::Which;
use Filename::Type::Backup qw(check_backup_filename);
use IPC::System::Options 'system', -log=>1;
use Module::CoreList::More;
use Proc::ChildError qw(explain_child_error);
use Scalar::Util 'looks_like_number';
use Sort::Sub qw(prereq_ala_perlancar);
use Version::Util qw(version_gt version_ne);
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-12-21'; # DATE
our $DIST = 'App-LintPrereqs'; # DIST
our $VERSION = '0.544'; # VERSION
our %SPEC;
our @EXPORT_OK = qw(lint_prereqs);
# create a merged list of prereqs from any phase
sub _create_prereqs_for_Any_phase {
my $prereqs = shift;
$prereqs->{Any} = {};
for my $phase (grep {$_ ne 'Any'} keys %$prereqs) {
for my $mod (keys %{ $prereqs->{$phase} }) {
my $v = $prereqs->{$phase}{$mod};
if (exists $prereqs->{Any}{$mod}) {
$prereqs->{Any}{$mod} = $v
if version_gt($v, $prereqs->{Any}{$mod});
} else {
$prereqs->{Any}{$mod} = $v;
}
}
}
}
sub _scan_prereqs {
my %args = @_;
my $scanner = do {
if ($args{scanner} eq 'lite') {
require Perl::PrereqScanner::Lite;
my $scanner = Perl::PrereqScanner::Lite->new;
$scanner->add_extra_scanner('Moose');
$scanner->add_extra_scanner('Version');
$scanner;
} elsif ($args{scanner} eq 'nqlite') {
require Perl::PrereqScanner::NotQuiteLite;
my $scanner = Perl::PrereqScanner::NotQuiteLite->new(
parsers => [qw/:installed -UniversalVersion/],
suggests => 1,
);
$scanner;
} else {
require Perl::PrereqScanner;
Perl::PrereqScanner->new;
}
};
require File::Find;
my %files; # key=phase, val=[file, ...]
{
$files{Runtime} = [];
my @dirs = (grep {-d} (
"lib", "bin", "script", "scripts",
#"sample", "samples", "example", "examples" # decidedly not included
#"share", # decidedly not included
@{ $args{extra_runtime_dirs} // [] },
));
last unless @dirs;
find(
sub {
return unless -f;
return if check_backup_filename(filename=>$_);
push @{$files{Runtime}}, "$File::Find::dir/$_";
},
@dirs
);
}
{
my @dirs = (grep {-d} (
"t", "xt",
@{ $args{extra_test_dirs} // [] },
));
last unless @dirs;
find(
sub {
return unless -f;
return if check_backup_filename(filename=>$_);
return unless /\.(t|pl|pm)$/;
push @{$files{Test}}, "$File::Find::dir/$_";
},
@dirs
);
}
my %res; # key=phase, value=hash of {mod=>version , ...}
for my $phase (keys %files) {
$res{$phase} = {};
for my $file (@{$files{$phase}}) {
my $scanres = $scanner->scan_file($file);
unless ($scanres) {
log_trace("Scanned %s, got nothing", $file);
}
# if we use PP::NotQuiteLite, it returns PPN::Context which supports
# a 'requires' method to return a CM:Requirements like the other
# scanners
my $reqs = $scanres->can("requires") ?
$scanres->requires->as_string_hash : $scanres->as_string_hash;
if ($scanres->can("suggests") && (my $sugs = $scanres->suggests)) {
# currently it's not clear what makes PP:NotQuiteLite determine
# something as a suggests requirement, so we include suggests as
# a normal requires requirement.
$sugs = $sugs->as_string_hash;
for (keys %$sugs) {
$reqs->{$_} ||= $sugs->{$_};
}
}
log_trace("Scanned %s, got: %s", $file, $reqs);
for my $req (keys %$reqs) {
my $v = $reqs->{$req};
if (exists $res{$phase}{$req}) {
$res{$phase}{$req} = $v
if version_gt($v, $res{$phase}{$req});
} else {
$res{$phase}{$req} = $v;
}
}
} # for file
} # for phase
_create_prereqs_for_Any_phase(\%res);
%res;
}
$SPEC{lint_prereqs} = {
v => 1.1,
summary => 'Check extraneous/missing/incorrect prerequisites in dist.ini',
description => <<'MARKDOWN',
lint-prereqs can improve your prereqs specification in `dist.ini` by reporting
prereqs that are extraneous (specified but unused), missing (used/required but
not specified), or incorrect (mismatching version between what's specified in
`dist.ini` vs in source code, incorrect phase like test prereqs specified in
runtime, etc).
lib/App/LintPrereqs.pm view on Meta::CPAN
summary => 'Add extra directories to scan for runtime requirements',
},
extra_test_dirs => {
'x.name.is_plural' => 1,
schema => ['array*', of=>'str*'],
summary => 'Add extra directories to scan for test requirements',
},
scanner => {
schema => ['str*', in=>['regular','lite','nqlite']],
default => 'regular',
summary => 'Which scanner to use',
description => <<'MARKDOWN',
`regular` means <pm:Perl::PrereqScanner> which is PPI-based and is the slowest
but has the most complete support for Perl syntax.
`lite` means <pm:Perl::PrereqScanner::Lite> has uses an XS-based lexer and is
the fastest but might miss some Perl syntax (i.e. miss some prereqs) or crash if
given some weird code.
`nqlite` means <pm:Perl::PrereqScanner::NotQuiteLite> which is faster than
`regular` but not as fast as `lite`.
MARKDOWN
},
lite => {
schema => ['bool*'],
default => 0,
summary => 'Use Perl::PrereqScanner::Lite instead of Perl::PrereqScanner',
"summary.alt.bool.not" =>
'Use Perl::PrereqScanner instead of Perl::PrereqScanner::Lite',
description => <<'MARKDOWN',
This option is deprecated and has been replaced by `scanner`.
Lite is faster but it might still miss detecting some modules.
MARKDOWN
tags => ['deprecated', 'hidden'],
},
core_prereqs => {
schema => ['bool*'],
default => 1,
summary => 'Whether or not prereqs to core modules are allowed',
description => <<'MARKDOWN',
If set to 0 (the default), will complain if there are prerequisites to core
modules. If set to 1, prerequisites to core modules are required just like other
modules.
MARKDOWN
},
fix => {
schema => 'bool',
summary => 'Attempt to automatically fix the errors',
cmdline_aliases => {F=>{}},
description => <<'MARKDOWN',
`lint-prereqs` can attempt to automatically fix the errors by
adding/removing/moving prereqs in `dist.ini`. Not all errors can be
automatically fixed. When modifying `dist.ini`, a backup in `dist.ini~` will be
created.
MARKDOWN
},
},
};
sub lint_prereqs {
my %args = @_;
(-f "dist.ini")
or return [412, "No dist.ini found. ".
"Are you in the right dir (dist top-level)? ".
"Is your dist managed by Dist::Zilla?"];
my $ct = do {
open my($fh), "<", "dist.ini" or die "Can't open dist.ini: $!";
local $/;
binmode $fh, ":encoding(utf8)";
scalar <$fh>;
};
return [200, "Not run (no-lint-prereqs)"] if $ct =~ /^;!no[_-]lint[_-]prereqs$/m;
my @errs;
my $ciod = Config::IOD->new(
ignore_unknown_directive => 1,
);
my $cfg = $ciod->read_string($ct);
my %mods_from_ini;
my %assume_used;
my %assume_provided;
for my $section ($cfg->list_sections) {
$section =~ m!^(
osprereqs \s*/\s* .+ |
osprereqs(::\w+)+ |
prereqs (?: \s*/\s* (?<prereqs_phase_rel>\w+))? |
extras \s*/\s* lint[_-]prereqs \s*/\s* (assume-(?:provided|used))
)$!ix or next;
#$log->errorf("TMP: section=%s, %%+=%s", $section, {%+});
my ($phase, $rel);
if (my $pr = $+{prereqs_phase_rel}) {
if ($pr =~ /^(develop|configure|build|test|runtime|x_\w+)(requires|recommends|suggests|x_\w+)$/i) {
$phase = ucfirst(lc($1));
$rel = ucfirst(lc($2));
} else {
return [400, "Invalid section '$section' (invalid phase/rel $pr)"];
}
} else {
$phase = "Runtime";
$rel = "Requires";
}
my %params;
for my $param ($cfg->list_keys($section)) {
my $v = $cfg->get_value($section, $param);
if ($param =~ /^-phase$/) {
$phase = ucfirst(lc($v));
lib/App/LintPrereqs.pm view on Meta::CPAN
}
} # END check modules from scanned
# check minimum versions specified in [versions] in our config
{
last unless $versions;
log_trace("Checking minimum versions ...");
for my $mod (keys %{$mods_from_ini{Any}}) {
next if $mod eq 'perl';
my $v = $mods_from_ini{Any}{$mod};
my $is_core = Module::CoreList::More->is_still_core($mod, $v, $perlv);
my $min_v = $versions->{$mod};
if (defined($min_v) && version_gt($min_v, $v)) {
push @errs, {
module => $mod,
req_v => $v,
is_core => $is_core,
error => "Less than specified minimum version ($min_v) in lint-prereqs.conf",
remedy => "Increase version to $min_v",
remedy_cmds => [
["pdrutil", "inc-prereq-version-to", $mod, $min_v],
],
};
}
}
} # END check minimum versions
return [200, "OK", []] unless @errs;
@errs = sort {prereq_ala_perlancar($a->{module}, $b->{module})} @errs;
my $resmeta = {};
$resmeta->{'table.fields'} = [qw/module req_v is_core error remedy/];
if ($args{fix}) {
# there is an unfixable error
if (grep {!$_->{remedy_cmds}} @errs) {
for my $e (@errs) {
$e->{remedy} = " (CAN'T FIX AUTOMATICALLY) $e->{remedy}" unless $e->{remedy_cmds};
}
$resmeta->{'cmdline.exit_code'} = 112;
} else {
# create dist.ini~ first
if (-f "dist.ini~") { unlink "dist.ini~" or return [500, "Can't unlink dist.ini~: $!"] }
sysopen my($fh), "dist.ini~", O_WRONLY|O_CREAT|O_EXCL or return [500, "Can't create dist.ini~: $!"];
binmode $fh, ":encoding(utf8)"; print $fh $ct; close $fh or return [500, "Can't write to dist.ini~: $!"];
# run the commands
FIX:
{
# add sort-prereqs at the end
push @{ $errs[-1]{remedy_cmds} }, ["pdrutil", "sort-prereqs"];
ERR:
for my $e (@errs) {
for my $cmd (@{ $e->{remedy_cmds} }) {
system @$cmd;
if ($?) {
$e->{remedy} = "(FIX FAILED: ".explain_child_error().") $e->{remedy}";
$resmeta->{'cmdline.exit_code'} = 1;
# restore dist.ini from backup
rename "dist.ini~", "dist.ini";
last FIX;
}
}
}
for my $e (@errs) {
$e->{remedy} = "(DONE) $e->{remedy}";
}
$resmeta->{'cmdline.exit_code'} = 0;
# remove dist.ini~
#unlink "dist.ini~";
}
}
for my $e (@errs) { delete $e->{$_} for qw/remedy_cmds/ }
return [200, "OK", \@errs, $resmeta];
} else {
for my $e (@errs) { delete $e->{$_} for qw/remedy_cmds/ }
$resmeta->{'cmdline.exit_code'} = 200;
return [200, "OK", \@errs, $resmeta];
}
}
1;
# ABSTRACT: Check extraneous/missing/incorrect prerequisites in dist.ini
__END__
=pod
=encoding UTF-8
=head1 NAME
App::LintPrereqs - Check extraneous/missing/incorrect prerequisites in dist.ini
=head1 VERSION
This document describes version 0.544 of App::LintPrereqs (from Perl distribution App-LintPrereqs), released on 2024-12-21.
=head1 SYNOPSIS
# Use via lint-prereqs CLI script
=head1 FUNCTIONS
=head2 lint_prereqs
Usage:
lint_prereqs(%args) -> [$status_code, $reason, $payload, \%result_meta]
Check extraneousE<sol>missingE<sol>incorrect prerequisites in dist.ini.
lint-prereqs can improve your prereqs specification in C<dist.ini> by reporting
prereqs that are extraneous (specified but unused), missing (used/required but
not specified), or incorrect (mismatching version between what's specified in
C<dist.ini> vs in source code, incorrect phase like test prereqs specified in
runtime, etc).
lib/App/LintPrereqs.pm view on Meta::CPAN
whatever modules are detected by the scanner.)
Sometimes there are prerequisites that you know are used but can't be detected
by the scanner, or you want to include anyway. If this is the case, you can
instruct lint_prereqs to assume that the prerequisite is used.
;!lint_prereqs assume-used "even though we know it is not currently used"
Foo::Bar=0
;!lint_prereqs assume-used "we are forcing a certain version"
Baz=0.12
Sometimes there are also prerequisites that are detected by scan_prereqs, but
are false positives (L<Perl::PrereqScanner::Lite> sometimes does this because
its parser is simpler) or you know are already provided by some other modules.
So to make lint-prereqs ignore them:
[Extras / lint-prereqs / assume-provided]
Qux::Quux=0
You can also add a C<[versions]> section in your C<lint-prereqs.conf>
configuration containing minimum versions that you want for certain modules,
e.g.:
[versions]
Bencher=0.30
Log::ger=0.19
...
then if there is a prereq specified less than the minimum versions,
C<lint-prereqs> will also complain.
This function is not exported by default, but exportable.
Arguments ('*' denotes required arguments):
=over 4
=item * B<core_prereqs> => I<bool> (default: 1)
Whether or not prereqs to core modules are allowed.
If set to 0 (the default), will complain if there are prerequisites to core
modules. If set to 1, prerequisites to core modules are required just like other
modules.
=item * B<extra_runtime_dirs> => I<array[str]>
Add extra directories to scan for runtime requirements.
=item * B<extra_test_dirs> => I<array[str]>
Add extra directories to scan for test requirements.
=item * B<fix> => I<bool>
Attempt to automatically fix the errors.
C<lint-prereqs> can attempt to automatically fix the errors by
adding/removing/moving prereqs in C<dist.ini>. Not all errors can be
automatically fixed. When modifying C<dist.ini>, a backup in C<dist.ini~> will be
created.
=item * B<perl_version> => I<str>
Perl version to use (overrides scan_prereqsE<sol>dist.ini).
=item * B<scanner> => I<str> (default: "regular")
Which scanner to use.
C<regular> means L<Perl::PrereqScanner> which is PPI-based and is the slowest
but has the most complete support for Perl syntax.
C<lite> means L<Perl::PrereqScanner::Lite> has uses an XS-based lexer and is
the fastest but might miss some Perl syntax (i.e. miss some prereqs) or crash if
given some weird code.
C<nqlite> means L<Perl::PrereqScanner::NotQuiteLite> which is faster than
C<regular> but not as fast as C<lite>.
=back
Returns an enveloped result (an array).
First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (any)
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-LintPrereqs>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-LintPrereqs>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTOR
=for stopwords Steven Haryanto
Steven Haryanto <stevenharyanto@gmail.com>
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
( run in 1.956 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )