use strict;
use warnings;
use CPAN;
use CPAN::Config;
use ExtUtils::Manifest;
use Cwd;
BEGIN {
    no warnings 'redefine';
    *CPAN::Shell::myprint = sub{};
}

$| = 1;
exit main( @ARGV );

sub main {
    our $startdir = cwd();
    our @packages =
        grep $_,
        map CPAN::Shell->expandany( $_ ),
        keys %{{ map +(parse_packages( $_ ), undef),
                 pms() }};

    for my $pkg ( @packages ) {
        # Using $_ here causes the object to be destroyed.
        $pkg->get;
    }

    our @dirs =
        map +(File::Spec->splitpath( $_ ))[2],
        glob
        File::Spec->catfile( $CPAN::Config->{'build_dir'}, '*' );

    for my $file ( map $_->cpan_file, @packages ) {
        my $dir =
            File::Spec->catdir( $CPAN::Config->{'build_dir'},
                                grep $file =~ /\Q$_/,
                                @dirs );
        my $cmd = "diff -ru $dir $startdir";
        print "$cmd\n";
        system $cmd;
    }
    return 0;
}

sub parse_packages {
    # This is stolen directly from cron/mldistwatch of pause release 4
+57
    my $pmfile = shift;
    open my $fh, "<", $pmfile or die "Couldn't open $pmfile for read: 
+$!";
    local $/ = "\n";
    local $_;
    my $inpod = 0;

    my @pkgs;
    PLINE: while (<$fh>) {
        chomp;
        my $pline = $_;
        $inpod = $pline =~ /^=(?!cut)/ ? 1 :
                 $pline =~ /^=cut/     ? 0 :
                 $inpod;
        next if $inpod;
        next if substr($pline,0,4) eq "=cut";

        $pline =~ s/\#.*//;
        next if $pline =~ /^\s*$/;
        last PLINE if $pline =~ /\b__(END|DATA)__\b/;

        my $pkg;
        if ( $pline =~ m{
                         (.*)
                         \bpackage\s+
                         ([\w\:\']+)
                         \s*
                         ( $ | [\}\;] )
                        }x) {
            $pkg = $2;
        }

        if ($pkg) {
            # Found something

            # from package
            $pkg =~ s/\'/::/;
            next PLINE unless $pkg =~ /^[A-Za-z]/;
            next PLINE unless $pkg =~ /\w$/;
            next PLINE if $pkg eq "main";
            next PLINE if length($pkg) > 64; #64
            #restriction
            push @pkgs, $pkg;
        }
    }

    close $fh;
    return @pkgs;
}

sub pms {
    return grep /\.pm$/i, keys %{ ExtUtils::Manifest::manifind() };
}