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