Change 34814 by [EMAIL PROTECTED] on 2008/11/10 23:28:35
add -t (tabular option) to Porting/corecpan.pl
This allows multiple source trees to be compared
Affected files ...
... //depot/perl/Porting/corecpan.pl#4 edit
Differences ...
==== //depot/perl/Porting/corecpan.pl#4 (text) ====
Index: perl/Porting/corecpan.pl
--- perl/Porting/corecpan.pl#3~31467~ 2007-06-26 00:22:36.000000000 -0700
+++ perl/Porting/corecpan.pl 2008-11-10 15:28:35.000000000 -0800
@@ -1,6 +1,7 @@
#!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;
@@ -8,18 +9,26 @@
use ExtUtils::MM_Unix;
use lib 'Porting';
use Maintainers qw(get_module_files %Modules);
+use Cwd;
+
+use List::Util qw(max);
our $packagefile = '02packages.details.txt';
sub usage () {
die <<USAGE;
-$0 - report which core modules are outdated.
+$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
}
@@ -30,8 +39,21 @@
or die "Failed to get package details\n";
}
-getopts('fhv');
+getopts('fhvt');
our $opt_h and usage;
+our $opt_t;
+
+my @sources = @ARGV ? @ARGV : '.';
+die "Too many directories speficied without -t option\n"
+ if @sources != 1 and ! $opt_t;
+
[EMAIL PROTECTED] = 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.
@@ -39,31 +61,97 @@
open my $fh, $packagefile or die $!;
while (<$fh>) {
my ($p, $v) = split ' ';
+ next if 1../^\s*$/; # skip header
$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";
+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";
+
+ for my $dist (sort keys %Modules) {
+ next unless $Modules{$dist}{CPAN};
+ for my $file (get_module_files($dist)) {
+ next if $file !~ /\.pm\z/ or $file =~ m{^t/} or $file =~ m{/t/};
+ my $vcore = '!EXIST';
+ $vcore = MM->parse_version($file) // 'undef' if -f $file;
+ 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} // '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 keys %results) {
+ for my $file (sort keys %{$results{$dist}}) {
+ my @versions = @[EMAIL PROTECTED];
+ 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 keys %results) {
+ next unless $changed{$dist};
+ print " " x $field_total, " $dist\n";
+ for my $file (sort keys %{$results{$dist}}) {
+ my @versions = @[EMAIL PROTECTED];
+ for (0..$#versions) {
+ printf "%*s ", $fields[$_], $versions[$_]//'!EXIST'
+ }
+ print " $file\n";
+ }
+ }
+}
+else {
+ for my $dist (sort keys %results) {
+ print "Module $dist...\n";
+ for my $file (sort keys %{$results{$dist}}) {
+ my ($vcpan, $vcore) = @[EMAIL PROTECTED];
+ if (our $opt_v or $vcore ne $vcpan) {
+ print " $file: core=$vcore, cpan=$vcpan\n";
+ }
}
}
}
End of Patch.
