Porting/corecpan.pl

   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;
  35 our $opt_f || !-f $packagefile and get_package_details;
  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)) {
  50         next if $file !~ /\.pm\z/ or $file =~ m{^t/} or $file =~ m{/t/};
  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 }