Add a tool to report dual-lived core modules that don't

have the same version than the corresponding module on CPAN.

p4raw-id: //depot/perl@22342

diff --git a/MANIFEST b/MANIFEST
index a0394b9..76f81e3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2474,6 +2474,7 @@ Porting/check83.pl        Check whether we are 8.3-friendly
 Porting/checkURL.pl    Check whether we have working URLs
 Porting/checkVERSION.pl        Check whether we have $VERSIONs
 Porting/cmpVERSION.pl  Compare whether two trees have changed modules
+Porting/corecpan.pl    Reports outdated dual-lived modules
 Porting/config_H       Sample config.h
 Porting/config.sh      Sample config.sh
 Porting/Contract       Social contract for contributed modules in Perl core

diff --git a/Porting/corecpan.pl b/Porting/corecpan.pl
new file mode 100644 (file)
index 0000000..48fb7d9
--- /dev/null
+++ b/Porting/corecpan.pl
@@ -0,0 +1,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/};
+       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";
+       }
+    }
+}