The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

use File::Slurp;
use List::Util 'first';
use IPC::Run3;

sub run ($);
sub run_and_check ($);
sub file_found ($@);
sub file_contains ($$);

sub check_deps {
    system('rm -f /tmp/deps.txt');
    for my $dir (qw( lib t script bin )) {
        next if !-d $dir;
        my $cmd =
            q{ grep -E '^\s*use (\w+::)*\w+' -r } .
            $dir .
            q{ | grep -Ev 'use strict|use warnings|~:' | }.
            q{ sed 's/^[^:]*:\s*use //g' | }.
            q{ sed 's/^base ''//' | }.
            q{ sed 's/^base qw//' | }.
            q{ sed 's/^base "//' | }.
            q{ sed 's/L<//g' | }.
            q{ sed 's/>.*//g' | }.
            q{ sed 's/ qw.*//g' | sed 's/ ''.*//' | sed 's/[^A-Za-z0-9_:]*//g' | sort | uniq | }.
            q{ grep -vE '^(constant|subs|overload|lib|Cwd|Carp|List::Util|Encode|FindBin|vars|utf8|File::Copy|Clone|File::Spec|File::stat|File::Temp|Getopt::Std|Getopt::Long|Exporter|Data::Dumper)$' }.
            q{ >> /tmp/deps.txt };
        #warn $cmd, "\n";
        system($cmd);
    }
    my $cmd = "cat /tmp/deps.txt | sort | uniq";
    my $output = `$cmd`;
    my @mod = split /\n/, $output;
    my @deps;
    for my $mod (@mod) {
        $mod =~ s/^qw//g;
        (my $path = $mod) =~ s/::/\//g;
        my $found = undef;
        for my $dir (qw(lib inc . t/lib)) {
            my $file = "$dir/$path.pm";
            #warn $file, "\n";
            if (-f $file) {
                $found = 1;
                last;
            }
        }
        push @deps, $mod unless $found;
    }
    for my $dep (@deps) {
        #print $dep, "\n";
        if (!file_contains('Makefile.PL', qr/^[^#]*['"]\Q$dep\E['"]/)) {
            warn "WARNING: Prereq $dep not mentioned in Makefile.PL\n";
        }
    }
    #write_file('/tmp/deps.txt', join "\n", @deps);
    #system(q{ grep -f /tmp/deps.txt Makefile.PL });
}

my ($stdout, $stderr);

if ($ENV{USER} =~ /^agentz/) {
    system("rm -rf inc/ META.yml");
}
#
# check missing files
file_found 'Makefile.PL';
file_found 'MANIFEST';
file_found 'Changes', 'ChangeLog';
file_found 't/pod.t', 't/00-pod.t', 't/99-pod.t';
file_found 't/pod-coverage.t', 't/00-pod-coverage.t', 't/99-pod-coverage.t';

##
# check META.yml related issues
system('rm -rf *.tar.gz');
run 'make veryclean';
run_and_check 'perl Makefile.PL releng';
file_found 'META.yml';

##
# check missing items in MENIFEST:
run_and_check 'make distcheck';
#print $stderr;
my @lines = grep {
    !/\.swp$/ and !/\.vim/
} split '\n', $stderr;
warn join("\n", @lines), "\n" if @lines;

my $main_pm;
{ # get main .pm file from Makefile.PL
    open my $in, 'Makefile.PL' or
        die "ERROR: Can't open Makefile.PL for reading: $!";
    my @lines = <$in>;
    close $in;

    my $line = first {
        m{(?x) ^ \s* \w+_from .*? \b(lib/[\w\/]+\.pm)} && ($main_pm = $1)
    } @lines;
    if (!$main_pm) {
        die "ERROR: Can't find the main .pm file for your distribution from your Makefile.PL. It's often serve as an argument to functions like 'all_from'.\n";
    }
    #warn $main_pm;
}

my $version;
for my $file (map glob, qw{ lib/*.pm lib/*/*.pm lib/*/*/*.pm lib/*/*/*/*.pm lib/*/*/*/*/*.pm META.yml }) {
    # Check the sanity of each .pm file
    open my $in, $file or
        die "ERROR: Can't open $file for reading: $!\n";
    while (<$in>) {
        my ($ver, $skipping);
        if (/(?x) \$VERSION \s* = .*? ([\d\.]*\d+) (.*? SKIP)?/) {
            my $orig_ver = $ver = $1;
            $skipping = $2;
            $ver =~ s{^(\d+)\.(\d{3})(\d{3})$}{join '.', int($1), int($2), int($3)}e;
            warn "$file: $orig_ver ($ver)\n";
        } elsif (/This document describes \S+ ([\d\.]*\d+)/) {
            my $orig_ver = $ver = $1;
            $ver =~ s{^(\d+)\.(\d{3})(\d{3})$}{join '.', int($1), int($2), int($3)}e;
            warn "$file: $orig_ver ($ver)\n";
        } elsif (/^version: (\d+.*)$/) {
            $ver = $1;
            warn "$file: $ver\n";
        }

        if ($ver and $version and !$skipping) {
            if ($version ne $ver) {
                die "$file: $ver != $version\n";
            }
        } elsif ($ver and !$version) {
            $version = $ver;
        }
    }
    close $in;
}

$version =~ s{^(\d+)\.(\d{3})(\d{3})$}{join '.', int($1), int($2), int($3)}e;
if (! file_contains 'Changes', qr/\b\Q$version\E\b/) {
    die "ERROR: File 'Changes' has nothing regarding release $version\n";
}
run_and_check "pod2text $main_pm > README";

my $bin = -d 'bin' ? 'bin' : (-d 'script' ? 'script' : '');

system(
    q{grep -E '^\\s*use Smart::Comments' } .
    ($bin ? "`ls $bin/* | grep -v '~\$' | grep -v '.swp\$'`" : " ") .
    q{ `find -name '*.pm'` `find -name '*.t'`}
);

check_deps();

my ($tests, $dist_tests);

##
# make test
run_and_check 'make test';
# print $stdout;
if ($stdout =~ /(?xms) \n Files=\d+, \s+ Tests=(\d+)/) {
    $tests = $1;
} else {
    die "ERROR: Unknown 'make test' output format: '$stdout'\n";
}

##
# make disttest
run_and_check 'make disttest';
if ($stdout =~ /(?xms) \n Files=\d+, \s+ Tests=(\d+)/) {
    $dist_tests = $1;
} else {
    die "ERROR: Unknown 'make disttest' output format: '$stdout'\n";
}

##
# check if test counts mismatch
if ($tests != $dist_tests) {
    my $diff = $dist_tests - $tests;
    warn "WARNING: The number of tests from 'make test' doesn't match the one from 'make disttest': $tests <> $dist_tests ($diff)\n";
}

run_and_check "make dist";

##############################################
# utility functions
#
sub run_and_check ($) {
    my $cmd = shift;
    run($cmd);
    if ($? != 0) {
        warn $stderr;
        die "ERROR: command '$cmd' returns non-zero code.\n";
    }
}

sub run ($) {
    my $cmd = shift;
    run3 $cmd, \undef, \$stdout, \$stderr;
}

sub file_found ($@) {
    my ($missing, $empty);
    for my $file (@_) {
        $missing++ if !-f $file;
        $empty++ if !-s $file;
    }
    die "ERROR: File(s) @_ are missing.\n" if $missing && $missing == @_;
    die "ERROR: File(s) @_ are empty.\n" if $missing && $empty == @_;
}

sub file_contains ($$) {
    my ($file, $regex) = @_;
    my $content = read_file($file);
    return $content =~ /$regex/ms;
}