view release on metacpan or  search on metacpan

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

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