blob: 1327483f1d4cca6f5226b622bb680cedf5a390f6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#!perl
# Reports, in a perl source tree, which dual-lived core modules have not the
# same version than the corresponding module on CPAN.
use 5.9.0;
use strict;
use Getopt::Std;
use ExtUtils::MM_Unix;
use lib 'Porting';
use Maintainers qw(get_module_files %Modules);
our $packagefile = '02packages.details.txt';
sub usage () {
die <<USAGE;
$0 - report which core modules are outdated.
To be run at the root of a perl source tree.
Options :
-h : help
-v : verbose (print all versions of all files, not only those which differ)
-f : force download of $packagefile from CPAN
(it's expected to be found in the current directory)
USAGE
}
sub get_package_details () {
my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz';
unlink $packagefile;
system("wget $url && gunzip $packagefile.gz") == 0
or die "Failed to get package details\n";
}
getopts('fhv');
our $opt_h and usage;
our $opt_f or !-f $packagefile and get_package_details;
# Load the package details. All of them.
my %cpanversions;
open my $fh, $packagefile or die $!;
while (<$fh>) {
my ($p, $v) = split ' ';
$cpanversions{$p} = $v;
}
close $fh;
for my $dist (sort keys %Modules) {
next unless $Modules{$dist}{CPAN};
print "Module $dist...\n";
for my $file (get_module_files($dist)) {
next if $file !~ /\.pm\z/ or $file =~ m{^t/} or $file =~ m{/t/};
my $vcore = MM->parse_version($file) // 'undef';
my $module = $file;
$module =~ s/\.pm\z//;
# some heuristics to figure out the module name from the file name
$module =~ s{^(lib|ext)/}{}
and $1 eq 'ext'
and ( $module =~ s{^(.*)/lib/\1\b}{$1},
$module =~ s{(\w+)/\1\b}{$1},
$module =~ s{^Encode/encoding}{encoding},
$module =~ s{^MIME/Base64/QuotedPrint}{MIME/QuotedPrint},
$module =~ s{^List/Util/lib/Scalar}{Scalar},
);
$module =~ s{/}{::}g;
my $vcpan = $cpanversions{$module} // 'not found';
if (our $opt_v or $vcore ne $vcpan) {
print " $file: core=$vcore, cpan=$vcpan\n";
}
}
}
|
