#!/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;
}