view release on metacpan or  search on metacpan

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

            schema => 'str*',
        },
        show_core => {
            schema => ['bool*'],
            default => 1,
            summary => 'Whether or not to show core prerequisites',
        },
        show_noncore => {
            schema => ['bool*'],
            default => 1,
            summary => 'Whether or not to show non-core prerequisites',
        },
    },
    examples => [
        {
            summary => 'By default scan current directory',
            args => {},
            test => 0,
            'x.doc.show_result' => 0,
        },
    ],
};
sub scan_prereqs {
    require Filename::Type::Backup;
    require File::Find;

    my %args = @_;

    my $perlver = version->parse($args{perlver} // $^V);

    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;
        }
    };

    my %mods;
    my %excluded_mods;

    require File::Find;
    File::Find::find(
        sub {
            no warnings 'once';

            return unless -f;
            my $path = "$File::Find::dir/$_";
            if (Filename::Type::Backup::check_backup_filename(filename=>$_)) {
                log_debug("Skipping backup file %s ...", $path);
                return;
            }
            if (/\A(\.git)\z/) {
                log_debug("Skipping %s ...", $path);
                return;
            }
            log_debug("Scanning file %s ...", $path);
            my $scanres = $scanner->scan_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 $prereqs = $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) {
                    $prereqs->{$_} ||= $sugs->{$_};
                }
            }

            for my $mod (keys %$prereqs) {
                next if $excluded_mods{$mod};
                my $v = $prereqs->{$mod};
                if ($mod eq 'perl') {
                } elsif (!$args{show_core} || $args{show_noncore}) {
                    require Module::CoreList;
                    my $ans = Module::CoreList->is_core(
                        $mod, $v, $perlver);
                    if ($ans && !$args{show_core}) {
                        log_debug("Skipped prereq %s %s (core)", $mod, $v);
                        $excluded_mods{$mod} = 1;
                        next;
                    } elsif (!$ans && !$args{show_noncore}) {
                        log_debug("Skipped prereq %s %s (non-core)", $mod, $v);
                        $excluded_mods{$mod} = 1;
                        next;
                    }
                }
                if (defined $mods{$mod}) {
                    $mods{$mod} = $v if
                        version->parse($v) > version->parse($mods{$mod});
                } else {
                    log_info("Added prereq %s (from %s)", $mod, $path);
                    $mods{$mod} = $v;
                }
            }

        },
        @{ $args{files} },
    );

    my @rows;
    my %resmeta = (
        'table.fields' => [qw/module version/],
    );