package App::LintPrereqs;

our $DATE = '2016-01-29'; # DATE
our $VERSION = '0.33'; # VERSION

use 5.010001;
use strict;
use warnings;
use Log::Any::IfLOG qw($log);

use Config::IniFiles;
use File::Find;
use File::Which;
use Filename::Backup qw(check_backup_filename);
use Module::CoreList::More;
use Scalar::Util 'looks_like_number';
use Version::Util qw(version_gt version_ne);

our %SPEC;
require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(lint_prereqs);

sub _scan_prereqs {
    my %args = @_;

    my $scanner = do {
        if ($args{lite}) {
            require Perl::PrereqScanner::Lite;
            my $scanner = Perl::PrereqScanner::Lite->new;
            $scanner->add_extra_scanner('Moose');
            $scanner->add_extra_scanner('Version');
            $scanner;
        } else {
            require Perl::PrereqScanner;
            Perl::PrereqScanner->new;
        }
    };
    require File::Find;
    my @files;

    {
        my @dirs = (grep {-d} (
            "lib", "bin", "script", "scripts",
            #"sample", "samples", "example", "examples" # decidedly not included
            #"share", # decidedly not included
        ));
        last unless @dirs;
        find(
            sub {
                return unless -f;
                return if check_backup_filename(filename=>$_);
                push @files, "$File::Find::dir/$_";
            },
            @dirs
        );
    }

    {
        my @dirs = (grep {-d} ("t", "xt"));
        last unless @dirs;
        find(
            sub {
                return unless -f;
                return if check_backup_filename(filename=>$_);
                return unless /\.(t|pl|pm)$/;
                push @files, "$File::Find::dir/$_";
            },
            @dirs
        );
    }

    my %res;
    for my $file (@files) {
        my $scanres = $scanner->scan_file($file);
        unless ($scanres) {
            $log->tracef("Scanned %s, got nothing", $file);
        }
        my $reqs = $scanres->{requirements};
        $log->tracef("Scanned %s, got: %s", $file, [keys %$reqs]);
        #$log->tracef("TMP:reqs=%s", $reqs);
        for my $req (keys %$reqs) {
            my $v = $reqs->{$req}{minimum}{original};;
            if (exists $res{$req}) {
                $res{$req} = $v if version_gt($v, $res{$req});
            } else {
                $res{$req} = $v;
            }
        }
    }
    %res;
}

$SPEC{lint_prereqs} = {
    v => 1.1,
    summary => 'Check extraneous/missing prerequisites in dist.ini',
    description => <<'_',

Check `[Prereqs / *]` (as well as `OSPrereqs`, `Extras/lint-prereqs/Assume-*`)
sections in your `dist.ini` against what's actually being used in your Perl code
(using `Perl::PrereqScanner::Lite`) and what's in Perl core list of modules.
Will complain if your prerequisites are not actually used (extraneous
dependencies), or if there are missing prerequisites. Will also complain if a
prerequisite is already in Perl core (but this can be configured).

Designed to work with prerequisites that are manually written. Does not work if
you use AutoPrereqs.

Sometimes there are prerequisites that you know are used but can't be detected
by scan_prereqs, or you want to include anyway. If this is the case, you can
instruct lint_prereqs to assume 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
you know are already provided by some other modules. So to make lint-prereqs
ignore them:

    [Extras / lint-prereqs / assume-provided]
    Qux::Quux=0

By default, core modules are not allowed to be specified. Sometimes though you
need to specify because on some systems some core modules are not available
(e.g. they are split into separate OS packages). In this case, you can specify:

 ;!lint_prereqs allow-core
 Data::Dumper=0

_
    args => {
        perl_version => {
            schema => ['str*'],
            summary => 'Perl version to use (overrides scan_prereqs/dist.ini)',
        },
        lite => {
            schema => ['bool*'],
            default => 1,
            summary => 'Use Perl::PrereqScanner::Lite instead of Perl::PrereqScanner',
            "summary.alt.bool.not" =>
                'Use Perl::PrereqScanner instead of Perl::PrereqScanner::Lite',
            description => <<'_',

Lite is faster but it might still miss detecting some modules.

_
        },
        core_prereqs => {
            schema => ['bool*'],
            default => 0,
            summary => 'Whether or not prereqs to core modules are allowed',
            description => <<'_',

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.

_
        },
    },
};
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 $/;
        ~~<$fh>;
    };
    return [200, "Not run (no-lint-prereqs)"] if $ct =~ /^;!no[_-]lint[_-]prereqs$/m;

    my $cfg = Config::IniFiles->new(-file => "dist.ini", -fallback => "ALL");
    $cfg or return [
        500, "Can't open dist.ini: ".join(", ", @Config::IniFiles::errors)];

    my %mods_from_ini;
    my %assume_used;
    my %assume_provided;
    my %allow_core;
    for my $section (grep {
        m!^(
              osprereqs \s*/\s* .+ |
              osprereqs(::\w+)+ |
              prereqs (?: \s*/\s* \w+)? |
              extras \s*/\s* lint[_-]prereqs \s*/\s* (allow-core|assume-(?:provided|used))
          )$!ix}
                         $cfg->Sections) {
        for my $param ($cfg->Parameters($section)) {
            my $v   = $cfg->val($section, $param);
            my $cmt = $cfg->GetParameterComment($section, $param) // "";
            #$log->tracef("section=$section, param=$param, v=$v, cmt=$cmt");
            if ($section =~ /allow-core/ || $cmt =~ /^;!lint[_-]prereqs\s+allow-core\b/m) {
                $allow_core{$param} = $v;
            } else {
                $mods_from_ini{$param}   = $v unless $section =~ /assume-provided/;
                $assume_provided{$param} = $v if     $section =~ /assume-provided/;
                $assume_used{$param}     = $v if     $section =~ /assume-used/ ||
                    $cmt =~ /^;!lint[_-]prereqs\s+assume-used\b/m;
            }
        }
    }
    $log->tracef("mods_from_ini: %s", \%mods_from_ini);
    $log->tracef("assume_used: %s", \%assume_used);
    $log->tracef("assume_provided: %s", \%assume_provided);
    $log->tracef("allow_core: %s", \%allow_core);

    # assume package names from filenames, should be better and scan using PPI
    my %pkgs;
    find({
        #no_chdir => 1,
        wanted => sub {
            return unless /\.pm$/;
            my $pkg = $File::Find::dir;
            #$log->errorf("TMP:pkg=%s",$pkg);
            $pkg =~ s!^lib/?!!;
            $pkg =~ s!/!::!g;
            $pkg .= (length($pkg) ? "::" : "") . $_;
            $pkg =~ s/\.pm$//;
            $pkgs{$pkg}++;
        },
    }, "lib");
    $log->tracef("Packages: %s", \%pkgs);

    my %mods_from_scanned = _scan_prereqs(lite=>$args{lite});
    $log->tracef("mods_from_scanned: %s", \%mods_from_scanned);

    if ($mods_from_ini{perl} && $mods_from_scanned{perl}) {
        if (version_ne($mods_from_ini{perl}, $mods_from_scanned{perl})) {
            return [500, "Perl version from dist.ini ($mods_from_ini{perl}) ".
                        "and scan_prereqs ($mods_from_scanned{perl}) mismatch"];
        }
    }

    my $perlv; # min perl v to use in x.yyyzzz (numified)format
    if ($args{perl_version}) {
        $log->tracef("Will assume perl %s (via perl_version argument)",
                     $args{perl_version});
        $perlv = $args{perl_version};
    } elsif ($mods_from_ini{perl}) {
        $log->tracef("Will assume perl %s (via dist.ini)",
                     $mods_from_ini{perl});
        $perlv = $mods_from_ini{perl};
    } elsif ($mods_from_scanned{perl}) {
        $log->tracef("Will assume perl %s (via scan_prereqs)",
                     $mods_from_scanned{perl});
        $perlv = $mods_from_scanned{perl};
    } else {
        $log->tracef("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)"];
        }
    }

    my @errs;
    for my $mod (keys %mods_from_ini) {
        my $v = $mods_from_ini{$mod};
        next if $mod eq 'perl';
        $log->tracef("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 && !exists($allow_core{$mod})) {
            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",
            };
        }
        my $scanv = $mods_from_scanned{$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",
            };
        }
        unless (defined($scanv) || exists($assume_used{$mod})) {
            push @errs, {
                module  => $mod,
                req_v   => $v,
                is_core => $is_core,
                error   => "Unused but listed in dist.ini",
                remedy  => "Remove from dist.ini",
            };
        }
    }

    {
        no strict 'refs';
        my %lumped_mods;
        for my $mod (keys %mods_from_ini) {
            next unless $mod =~ /::Lumped$/;
            my $mod_pm = $mod;
            $mod_pm =~ s!::!/!g;
            $mod_pm .= ".pm";
            require $mod_pm;
            my $lm = \@{"$mod\::LUMPED_MODULES"};
            for (@$lm) { $lumped_mods{$_} = $mod }
        }
        last unless %lumped_mods;
        $log->tracef("Checking lumped modules");
        for my $mod (keys %lumped_mods) {
            my $v = $mods_from_ini{$mod};
            my $is_core = Module::CoreList::More->is_still_core($mod, $v, $perlv);
            if (exists $mods_from_ini{$mod}) {
                push @errs, {
                    module  => $mod,
                    req_v   => $v,
                    is_core => $is_core,
                    error   => "Listed in dist.ini but already lumped in $lumped_mods{$mod}",
                    remedy  => "Remove one of $mod or $lumped_mods{$mod} from dist.ini",
                };
            }
        }
    }

    for my $mod (keys %mods_from_scanned) {
        next if $mod eq 'perl';
        my $v = $mods_from_scanned{$mod};
        $log->tracef("Checking mod from scanned: %s (%s)", $mod, $v);
        my $is_core = Module::CoreList::More->is_still_core($mod, $v, $perlv);
        next if exists $pkgs{$mod};
        unless (exists($mods_from_ini{$mod}) ||
                    exists($assume_provided{$mod}) ||
                        ($args{core_prereqs} ? 0 : $is_core)) {
            push @errs, {
                module  => $mod,
                req_v   => $v,
                is_core => $is_core,
                error   => "Used but not listed in dist.ini",
                remedy  => "Put '$mod=$v' in dist.ini",
            };
        }
    }

    my $resmeta = {
        "cmdline.exit_code" => @errs ? 500-300:0,
        "table.fields" => [qw/module req_v is_core error remedy/],
    };
    [200, @errs ? "Extraneous/missing dependencies" : "OK", \@errs, $resmeta];
}

1;
# ABSTRACT: Check extraneous/missing prerequisites in dist.ini

__END__

=pod

=encoding UTF-8

=head1 NAME

App::LintPrereqs - Check extraneous/missing prerequisites in dist.ini

=head1 VERSION

This document describes version 0.33 of App::LintPrereqs (from Perl distribution App-LintPrereqs), released on 2016-01-29.

=head1 SYNOPSIS

 # Use via lint-prereqs CLI script

=head1 FUNCTIONS


=head2 lint_prereqs(%args) -> [status, msg, result, meta]

Check extraneous/missing prerequisites in dist.ini.

Check C<[Prereqs / *]> (as well as C<OSPrereqs>, C<Extras/lint-prereqs/Assume-*>)
sections in your C<dist.ini> against what's actually being used in your Perl code
(using C<Perl::PrereqScanner::Lite>) and what's in Perl core list of modules.
Will complain if your prerequisites are not actually used (extraneous
dependencies), or if there are missing prerequisites. Will also complain if a
prerequisite is already in Perl core (but this can be configured).

Designed to work with prerequisites that are manually written. Does not work if
you use AutoPrereqs.

Sometimes there are prerequisites that you know are used but can't be detected
by scan_prereqs, or you want to include anyway. If this is the case, you can
instruct lint_prereqs to assume 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
you know are already provided by some other modules. So to make lint-prereqs
ignore them:

 [Extras / lint-prereqs / assume-provided]
 Qux::Quux=0

By default, core modules are not allowed to be specified. Sometimes though you
need to specify because on some systems some core modules are not available
(e.g. they are split into separate OS packages). In this case, you can specify:

 ;!lint_prereqs allow-core
 Data::Dumper=0

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<core_prereqs> => I<bool> (default: 0)

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<lite> => I<bool> (default: 1)

Use Perl::PrereqScanner::Lite instead of Perl::PrereqScanner.

Lite is faster but it might still miss detecting some modules.

=item * B<perl_version> => I<str>

Perl version to use (overrides scan_prereqs/dist.ini).

=back

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

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/sharyanto/perl-App-LintPrereqs>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-LintPrereqs>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
