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

lib/App/LintPrereqs.pm  view on Meta::CPAN

            $pkg =~ s/\.pm$//;
            $dist_pkgs{$pkg}++;
        },
    }, "t/lib") if -d "t/lib";
    log_trace("Dist packages (in tests): %s", \%test_dist_pkgs);

    my %mods_from_scanned = _scan_prereqs(
        scanner => $args{lite} ? 'lite' : $args{scanner},
        extra_runtime_dirs => $args{extra_runtime_dirs},
        extra_test_dirs    => $args{extra_test_dirs},
    );
    log_trace("mods_from_scanned: %s", \%mods_from_scanned);

    my $perlv_ini     = $mods_from_ini{Any}{perl};
    my $perlv_scanned = $mods_from_scanned{Any}{perl};
    if ($perlv_scanned) {
        if (!defined $perlv_ini) {
            push @errs, {
                module  => 'perl',
                req_v   => $perlv_scanned,
                is_core => 1,
                error   => "perl version specified in source code but not in dist.ini",
                remedy  => 'Add to dist.ini',
                remedy_cmds => [
                    ["pdrutil", "add-prereq", "perl", $perlv_scanned],
                ],
            };
        } elsif (version_ne($perlv_ini, $perlv_scanned)) {
            return [500, "Perl version from dist.ini ($perlv_ini) ".
                        "and scan_prereqs ($perlv_scanned) mismatch"];
        }
    } else {
        return [500, "Perl version not specified by source code but specified in dist.ini ".
                    "($perlv_ini)"] if $perlv_ini;
    }

    my $versions;
    {
        last unless $args{-cmdline_r};
        $versions = $args{-cmdline_r}{config}{versions};
    }

    my $perlv; # min perl v to use in x.yyyzzz (numified)format
    if ($args{perl_version}) {
        log_trace("Will assume perl %s (via perl_version argument)",
                     $args{perl_version});
        $perlv = $args{perl_version};
    } elsif ($mods_from_ini{Any}{perl}) {
        log_trace("Will assume perl %s (via dist.ini)",
                     $mods_from_ini{Any}{perl});
        $perlv = $mods_from_ini{Any}{perl};
    } elsif ($mods_from_scanned{Any}{perl}) {
        log_trace("Will assume perl %s (via scan_prereqs)",
                     $mods_from_scanned{Any}{perl});
        $perlv = $mods_from_scanned{Any}{perl};
    } else {
        log_trace("Will assume perl %s (from running interpreter's \$^V)",
                     $^V);
        if ($^V =~ /^v(\d+)\.(\d+)\.(\d+)/) {
            $perlv = sprintf("%d\.%03d%03d", $1, $2, $3)+0;
        } elsif (looks_like_number($^V)) {
            $perlv = $^V;
        } else {
            return [500, "Can't parse \$^V ($^V)"];
        }
    }

    # check modules that are specified in dist.ini but extraneous (unused) or
    # have mismatched version or phase
    {
        for my $mod (keys %{$mods_from_ini{Any}}) {
            my $v = $mods_from_ini{Any}{$mod};
            next if $mod eq 'perl';
            log_trace("Checking mod from dist.ini: %s (%s)", $mod, $v);
            my $is_core = Module::CoreList::More->is_still_core($mod, $v, $perlv);
            if (!$args{core_prereqs} && $is_core) {
                push @errs, {
                    module  => $mod,
                    req_v   => $v,
                    is_core => 1,
                    error   => "Core in perl ($perlv to latest) but ".
                        "mentioned in dist.ini",
                    remedy  => "Remove from dist.ini",
                    remedy_cmds => [
                        ["pdrutil", "remove-prereq", $mod],
                    ],
                };
            }
            my $scanv = $mods_from_scanned{Any}{$mod};
            if (defined($scanv) && $scanv != 0 && version_ne($v, $scanv)) {
                push @errs, {
                    module  => $mod,
                    req_v   => $v,
                    is_core => $is_core,
                    error   => "Version mismatch between dist.ini ($v) ".
                        "and from scanned_prereqs ($scanv)",
                    remedy  => "Fix either the code or version in dist.ini",
                };
            }
            if (defined($mods_from_scanned{Test}{$mod}) &&
                    !defined($mods_from_scanned{Runtime}{$mod}) &&
                    !defined($mods_from_ini{Test}{$mod}) &&
                    defined($mods_from_ini{Runtime}{$mod})) {
                push @errs, {
                    module  => $mod,
                    req_v   => $v,
                    is_core => $is_core,
                    error   => "Only used in test phase but listed under runtime prereq in dist.ini",
                    remedy  => "Move prereq from runtime to test prereq in dist.ini",
                    remedy_cmds => [
                        ["pdrutil", "remove-prereq", $mod],
                        ["pdrutil", "add-prereq", $mod, $v, "--phase", "test"],
                    ],
                };
            }
            if (defined($mods_from_scanned{Runtime}{$mod}) &&
                    defined($mods_from_ini{Test}{$mod}) &&
                    !defined($mods_from_ini{Runtime}{$mod})) {
                push @errs, {
                    module  => $mod,
                    req_v   => $v,