#!perl
use strict;
use warnings;
use utf8;
use 5.008001;

use version;
use CPAN::Meta;
use Getopt::Long;
use CPAN::Meta::Requirements ();
use File::Find qw(find);
use Module::CoreList;
use Module::CPANfile;
use File::Spec;
use File::Basename ();
use Module::Metadata;
use Perl::PrereqScanner::Lite;

our $VERSION = '1.03';

sub debugf {
    if ($ENV{SCAN_PREREQS_CPANFILE_DEBUG}) {
        require Data::Dumper;
        my $format = shift;
        no warnings 'once';
        local $Data::Dumper::Terse  = 1;
        local $Data::Dumper::Indent = 0;
        my $txt = sprintf($format, map { defined($_) ? Data::Dumper::Dumper($_) : '-' } @_);
        print $txt, "\n";
    }
}

my $version;
my $diff;
my $include_empty;
my $scan_test_requires;
my @ignore = qw(eg examples share fatlib _build .git blib local .build);
my $add_ignore;
my $p = Getopt::Long::Parser->new(
    config => [qw(posix_default no_ignore_case auto_help)]
);
$p->getoptions(
    'version!'       => \$version,
    'diff=s'         => \$diff,
    'ignore=s'       => \$add_ignore,
    'include-empty!' => \$include_empty,
    'scan-test-requires' => \$scan_test_requires,
);
push @ignore, split /,/,$add_ignore if $add_ignore;
if ($version) {
    printf "%s %s\n", File::Basename::basename($0), $VERSION;
    exit 0;
}

&main; exit;

sub main {
    my ($runtime_files, $test_files, $configure_files, $develop_files) = find_perl_files();
    debugf($develop_files);

    my @inner_packages = scan_inner_packages(@$test_files, @$runtime_files, @$configure_files, @$develop_files);
    my $meta_prereqs = $diff ? load_diff_src($diff) : +{};

    # runtime
    my $runtime_prereqs = scan($runtime_files, \@inner_packages, $meta_prereqs, [qw(runtime)], 'runtime', +{});

    # test
    my $test_prereqs = scan($test_files, \@inner_packages, $meta_prereqs, [qw(test runtime)], 'test', $runtime_prereqs);

    # configure
    my $configure_prereqs = scan($configure_files, \@inner_packages, $meta_prereqs, [qw(configure runtime)], 'configure', $runtime_prereqs);

    # develop
    my $develop_prereqs = scan($develop_files, \@inner_packages, $meta_prereqs, [qw(develop test runtime)], 'develop', +{ %{$runtime_prereqs||{}}, %{$test_prereqs||{}}});

    if ($scan_test_requires) {
        $develop_prereqs = scan_test_requires($develop_prereqs);
    }

    print Module::CPANfile->from_prereqs(
        {
            runtime => {
                requires => $runtime_prereqs,
            },
            configure => {
                requires => $configure_prereqs,
            },
            test => {
                requires => $test_prereqs,
            },
            develop => {
                requires => $develop_prereqs,
            },
        }
    )->to_string($include_empty);
}

sub scan {
    my ($files, $inner_packages, $meta_prereqs, $prereq_types, $type, $optional_prereqs) = @_;

    my $prereqs = scan_files(@$files);

    # Remove internal packages.
    remove_prereqs($prereqs, +{ map { $_ => 1 } @$inner_packages });

    # Remove from meta
    for my $type (@$prereq_types) {
        remove_prereqs($prereqs, $meta_prereqs->{$type}->{requires});
        remove_prereqs($prereqs, $meta_prereqs->{$type}->{recommends});
    }

    # Runtime prereqs.
    if ($optional_prereqs) {
        remove_prereqs($prereqs, $optional_prereqs);
    }

    # Remove core modules.
    my $perl_version = $meta_prereqs->{perl} || '5.008001';
    remove_prereqs($prereqs, blead_corelist($perl_version));

    return $prereqs;
}

sub scan_inner_packages {
    my @files = @_;
    my %uniq;
    my @list;
    for my $file (@files) {
        push @list, grep { !$uniq{$_}++ } Module::Metadata->new_from_file($file)->packages_inside();
    }
    return @list;
}

sub scan_files {
    my @files = @_;

    my $combined = CPAN::Meta::Requirements->new;
    for my $file (@files) {
        debugf("Reading %s", $file);

        my $scanner = Perl::PrereqScanner::Lite->new;
        $scanner->add_extra_scanner('Moose');
        my $prereqs = $scanner->scan_file($file);
        $combined->add_requirements($prereqs);
    }
    my $prereqs = $combined->as_string_hash;
}

sub blead_corelist {
    my $perl_version = shift;
    my %corelist = %{$Module::CoreList::version{$perl_version}};
    for my $module (keys %corelist) {
        my $upstream = $Module::CoreList::upstream{$module};
        if ($upstream && $upstream eq 'cpan') {
            delete $corelist{$module};
        }
    }
    return \%corelist;
}

sub remove_prereqs {
    my ($prereqs, $allowed) = @_;
    return unless $allowed;

    for my $module (keys %$allowed) {
        if (exists $allowed->{$module}) {
            if (parse_version($allowed->{$module}) >= parse_version($prereqs->{$module})) {
                debugf("Core: %s %s >= %s", $module, $allowed->{$module}, $prereqs->{$module});
                delete $prereqs->{$module}
            }
        }
    }
}

sub parse_version {
    my $v = shift;
    return version->parse(0) unless defined $v;
    return version->parse(''.$v);
}

sub load_diff_src {
    my $src = shift;
    if (File::Basename::basename($src) eq 'cpanfile') {
        return Module::CPANfile->load($src)->prereq_specs;
    } elsif ($src =~ /\.(yml|json)$/) {
        my $meta = CPAN::Meta->load_file($src);
        my $meta_prereqs = CPAN::Meta::Prereqs->new($meta->prereqs)->as_string_hash;
        return $meta_prereqs;
    } else {
        die "No META.json and cpanfile\n";
    }
}

sub read_from_file {
    my ($fname, $length) = @_;
    return q{} if !-f $fname;
    open my $fh, '<', $fname
        or Carp::croak("Can't open '$fname' for reading: '$!'");
    my $buf;
    read $fh, $buf, $length;
    return $buf;
}

sub find_perl_files {
    my (@runtime_files, @test_files, @configure_files, @develop_files);
    find(
        {
            no_chdir => 1,
            wanted   => sub {
                return if $_ eq '.';
                return if -S $_; # Ignore UNIX socket

                # Ignore files.
                my (undef, $topdir, ) = File::Spec->splitdir($_);
                my $basename = File::Basename::basename($_);
                return if $basename eq 'Build';

                # Ignore build dir like Dist-Name-0.01/.
                return if -f "$topdir/META.json";

                for my $ignored (@ignore) {
                    return if $topdir eq $ignored;
                }

                if ($basename eq 'Build.PL' || $basename eq 'Makefile.PL') {
                    push @configure_files, $_
                } elsif ($topdir eq 't') {
                    if (/\.(pl|pm|psgi|t)$/) {
                        if ($basename =~ /^(?:author|release)-/) {
                            # dzil creates author test files to t/author-XXX.t
                            push @develop_files, $_
                        } else {
                            push @test_files, $_
                        }
                    }
                } elsif ($topdir eq 'xt' || $topdir eq 'author' || $topdir eq 'benchmark') {
                    if (/\.(pl|pm|psgi|t)$/) {
                        push @develop_files, $_
                    }
                } else {
                    if (/\.(pl|pm|psgi)$/) {
                        push @runtime_files, $_
                    } else {
                        my $header = read_from_file($_, 1024);
                        if ($header && $header =~ /^#!.*perl/) {
                            # Skip fatpacked file.
                            if ($header =~ /This chunk of stuff was generated by App::FatPacker./) {
                                debugf("fatpacked %s", $_);
                                return;
                            }

                            push @runtime_files, $_
                        }
                    }
                }
            }
        },
        '.'
    );
    return (\@runtime_files, \@test_files, \@configure_files, \@develop_files);
}

sub scan_test_requires {
    my $develop_prereqs = shift;

    require Test::Requires::Scanner;

    my @test_files;
    find(
        {
            no_chdir => 1,
            wanted   => sub {
                return if $_ eq '.';
                return if -S $_; # Ignore UNIX socket

                my (undef, $topdir, ) = File::Spec->splitdir($_);
                if (($topdir eq 'xt' || $topdir eq 't') && /\.t$/ ) {
                    push @test_files, $_
                }
            },
        },
        '.'
    );
    my $test_requires_prereqs = Test::Requires::Scanner->scan_files(@test_files);

    for my $module (keys %$test_requires_prereqs) {
        my $version = $test_requires_prereqs->{$module};

        if (! exists $develop_prereqs->{$module} ||
            parse_version($version) > parse_version($develop_prereqs->{$module})
        ) {
            $develop_prereqs->{$module} = $version || 0;
        }
    }

    return $develop_prereqs;
}

__END__

=head1 NAME

scan-prereqs-cpanfile - Scan prerequisite modules and generate CPANfile

=head1 SYNOPSIS

    % scan-prereqs-cpanfile

        --diff=META.json      # Generate diff from META.json
        --diff=cpanfile       # Generate diff from cpanfile
        --ignore=extlib/

=head1 DESCRIPTION

This script scans prerequisite modules from your code, and generate CPANfile.
You can also list missing prerequisite modules.

=head1 SCANNING RULES

=over 4

=item Used modules in `Build.PL` or `Makefile.PL` as 'test' requires

=item Used modules in `t/` as 'test' requires

=item Used modules in `xt/`, `benchmark/` and `author/` as 'develop' requires

=item Used modules in other directories as 'runtime' requires

=back

=head1 OPTIONS

=over 4

=item --diff

        --diff=META.json      # Generate diff from META.json
        --diff=cpanfile       # Generate diff from cpanfile

Compare the scanning result with META.json, META.yml or cpanfile.
With this option, scan-prereqs-cpanfile displays missing prerequisite modules only.

=item --ignore

    --ignore=tools/

Ignore some directories.

=item --include-empty

By default, phases without any prereqs are not dumped, By giving this option, cpanfile will have an empty block such as:

    on test => sub {

    };

Defaults to false.

=item --scan-test-requires (EXPERIMENTAL)

Scan test files and include the modules specified by L<Test::Requires> as 'develop' requires.

=back

=head1 AUTHOR

Tokuhiro Matsuno

=head1 SEE ALSO

L<Module::CPANfile>, L<Perl::PrereqScanner::Lite>