#!perl # Reports, in a perl source tree, which dual-lived core modules have not the # same version than the corresponding module on CPAN. # with -t option, can compare multiple source trees in tabular form. use 5.9.0; use strict; use Getopt::Std; use ExtUtils::MM_Unix; use lib 'Porting'; use Maintainers qw(get_module_files reload_manifest %Modules); use Cwd; use List::Util qw(max); our $packagefile = '02packages.details.txt'; sub usage () { die <<USAGE; $0 $0 -t home1[:label] home2[:label] ... 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) -t : display in tabular form CPAN vs one or more perl source trees 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('fhvt'); our $opt_h and usage; our $opt_t; my @sources = @ARGV ? @ARGV : '.'; die "Too many directories specified without -t option\n" if @sources != 1 and ! $opt_t; @sources = map { # handle /home/user/perl:bleed style labels my ($dir,$label) = split /:/; $label = $dir unless defined $label; [ $dir, $label ]; } @sources; our $opt_f || !-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 ' '; next if 1../^\s*$/; # skip header $cpanversions{$p} = $v; } close $fh; my %results; # scan source tree(s) and CPAN module list, and put results in %results foreach my $source (@sources) { my ($srcdir, $label) = @$source; my $olddir = getcwd(); chdir $srcdir or die "chdir $srcdir: $!\n"; # load the MANIFEST file in the new directory reload_manifest; for my $dist (sort keys %Modules) { next unless $Modules{$dist}{CPAN}; for my $file (get_module_files($dist)) { next if $file !~ /(\.pm|_pm.PL)\z/ or $file =~ m{^t/} or $file =~ m{/t/}; my $vcore = '!EXIST'; $vcore = MM->parse_version($file) // 'undef' if -f $file; # get module name from filename to lookup CPAN version my $module = $file; $module =~ s/\_pm.PL\z//; $module =~ s/\.pm\z//; # some heuristics to figure out the module name from the file name $module =~ s{^(lib|ext|dist|cpan)/}{} and $1 =~ /(?:ext|dist|cpan)/ and ( # ext/Foo-Bar/Bar.pm $module =~ s{^(\w+)-(\w+)/\2$}{$1/lib/$1/$2}, # ext/Encode/Foo/Foo.pm $module =~ s{^(Encode)/(\w+)/\2$}{$1/lib/$1/$2}, $module =~ s{^[^/]+/}{}, $module =~ s{^lib/}{}, ); $module =~ s{/}{::}g; my $vcpan = $cpanversions{$module} // 'undef'; $results{$dist}{$file}{$label} = $vcore; $results{$dist}{$file}{CPAN} = $vcpan; } } chdir $olddir or die "chdir $olddir: $!\n"; } # output %results in the requested format my @labels = ((map $_->[1], @sources), 'CPAN' ); if ($opt_t) { my %changed; my @fields; for my $dist (sort { lc $a cmp lc $b } keys %results) { for my $file (sort keys %{$results{$dist}}) { my @versions = @{$results{$dist}{$file}}{@labels}; for (0..$#versions) { $fields[$_] = max($fields[$_], length $versions[$_], length $labels[$_], length '!EXIST' ); } if (our $opt_v or grep $_ ne $versions[0], @versions) { $changed{$dist} = 1; } } } printf "%*s ", $fields[$_], $labels[$_] for 0..$#labels; print "\n"; printf "%*s ", $fields[$_], '-' x length $labels[$_] for 0..$#labels; print "\n"; my $field_total; $field_total += $_ + 1 for @fields; for my $dist (sort { lc $a cmp lc $b } keys %results) { next unless $changed{$dist}; print " " x $field_total, " $dist\n"; for my $file (sort keys %{$results{$dist}}) { my @versions = @{$results{$dist}{$file}}{@labels}; for (0..$#versions) { printf "%*s ", $fields[$_], $versions[$_]//'!EXIST' } print " $file\n"; } } } else { for my $dist (sort { lc $a cmp lc $b } keys %results) { my $distname_printed = 0; for my $file (sort keys %{$results{$dist}}) { my ($vcore, $vcpan) = @{$results{$dist}{$file}}{@labels}; if (our $opt_v or $vcore ne $vcpan) { print "\n$dist ($Modules{$dist}{MAINTAINER}):\n" unless ($distname_printed++); print "\t$file: core=$vcore, cpan=$vcpan\n"; } } } }