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() };
}
|