core-cpan-diff: various enhancements
authorDavid Golden <dagolden@cpan.org>
Sun, 18 Jul 2010 23:10:55 +0000 (19:10 -0400)
committerDavid Golden <dagolden@cpan.org>
Sun, 18 Jul 2010 23:10:55 +0000 (19:10 -0400)
* Extracted directories are cached and re-used
* Perl vs CPAN version mismatches shown in summary output
* Various minor code cleanup

Some diagnostic output was surpressed in diff mode, but not all.
I found the output confusing to follow in diff mode as a result
so I enabled some of the previously surpressed output.

Porting/core-cpan-diff

index 0f303c2..d35d173 100755 (executable)
@@ -14,12 +14,12 @@ use File::Basename ();
 use File::Copy ();
 use File::Temp ();
 use File::Path ();
-use File::Spec;
-use File::Spec::Unix ();
+use File::Spec::Functions;
 use Archive::Extract;
 use IO::Uncompress::Gunzip ();
 use File::Compare ();
 use ExtUtils::Manifest;
+use ExtUtils::MakeMaker ();
 
 BEGIN { die "Must be run from root of perl source tree\n" unless -d 'Porting' }
 use lib 'Porting';
@@ -36,20 +36,9 @@ $Module::Load::Conditional::CHECK_INC_HASH = 1;
 # stop Archive::Extract whinging about lack of Archive::Zip
 $Archive::Extract::WARN = 0;
 
-
-# Files, which if they exist in CPAN but not in perl, will not generate
-# an 'Only in CPAN' listing
-#
-our %IGNORABLE = map { ($_ => 1) }
-       qw(.cvsignore .dualLivedDiffConfig .gitignore
-             ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL
-             CHANGELOG ChangeLog CHANGES Changes COPYING Copying CREDITS
-             GOALS HISTORY INSTALL INSTALL.SKIP LICENSE Makefile.PL
-             MANIFEST MANIFEST.SKIP META.yml NEW NOTES ppport.h README
-             SIGNATURE THANKS TODO Todo VERSION WHATSNEW);
-
+# where, under the cache dir, to download tarballs to
+use constant SRC_DIR   => 'tarballs';
 # where, under the cache dir, to untar stuff to
-
 use constant UNTAR_DIR => 'untarred';
 
 use constant DIFF_CMD  => 'diff';
@@ -163,10 +152,13 @@ sub run {
     if (defined $cache_dir) {
        die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir;
     }
+    else {
+      $cache_dir = File::Temp::tempdir( CLEANUP => 1 );
+    }
 
     $mirror_url .= "/" unless substr($mirror_url,-1) eq "/";
     my $test_file = "modules/07mirror.yml";
-    my_getstore(cpan_url($mirror_url, $test_file), local_path($cache_dir, $test_file))
+    my_getstore(cpan_url($mirror_url, $test_file), catfile($cache_dir, $test_file))
        or die "ERROR: not a CPAN mirror '$mirror_url'\n";
 
     if ($do_crosscheck) {
@@ -178,14 +170,6 @@ sub run {
     }
 }
 
-# construct a local path either in cache dir or tempdir
-
-sub local_path {
-    my ($cache_dir, @path) = @_;
-    my $local_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
-    return File::Spec->catfile($local_dir, @path);
-}
-
 # construct a CPAN url
 
 sub cpan_url {
@@ -205,18 +189,11 @@ sub do_compare {
 
     # first, make sure we have a directory where they can all be untarred,
     # and if its a permanent directory, clear any previous content
-    my $untar_dir;
-    if ($cache_dir) {
-       $untar_dir = File::Spec->catdir($cache_dir, UNTAR_DIR);
-       if (-d $untar_dir) {
-           File::Path::rmtree($untar_dir)
-                   or die "failed to remove $untar_dir\n";
-       }
-       mkdir $untar_dir
-           or die "mkdir $untar_dir: $!\n";
-    }
-    else {
-       $untar_dir = File::Temp::tempdir( CLEANUP => 1 );
+    my $untar_dir = catdir($cache_dir, UNTAR_DIR);
+    my $src_dir = catdir($cache_dir, SRC_DIR);
+    for my $d ( $src_dir, $untar_dir ) {
+      next if -d $d;
+      mkdir $d or die "mkdir $d: $!\n";
     }
 
     my %ignorable = map { ($_ => 1) } @Maintainers::IGNORABLE;
@@ -236,20 +213,19 @@ sub do_compare {
        my $dist = $m->{DISTRIBUTION};
        die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $dist;
 
-       if ($seen_dist{$dist}) {
+       if ($seen_dist{$dist}++) {
            warn "WARNING: duplicate entry for $dist in $module\n"
        }
 
        my $upstream = $m->{UPSTREAM} || 'UNKNOWN';
        next if @$wanted_upstreams and ! ($upstream ~~ $wanted_upstreams);
-       print $outfh "\n$module - ".$Maintainers::Modules{$module}->{DISTRIBUTION}."\n" unless $use_diff;
-       print $outfh "  upstream is: ".($m->{UPSTREAM} || 'UNKNOWN!')."\n";
 
-       $seen_dist{$dist}++;
+        print $outfh "\n$module - ".$Maintainers::Modules{$module}->{DISTRIBUTION}."\n";
+        print $outfh "  upstream is: ".($m->{UPSTREAM} || 'UNKNOWN!')."\n";
 
        my $cpan_dir;
        eval {
-           $cpan_dir = get_distribution($cache_dir, $mirror_url, $untar_dir, $module, $dist)
+           $cpan_dir = get_distribution($src_dir, $mirror_url, $untar_dir, $module, $dist)
        };
        if ($@) {
            print $outfh "  ", $@;
@@ -259,12 +235,15 @@ sub do_compare {
 
        my @perl_files = Maintainers::get_module_files($module);
 
-       my $manifest = File::Spec->catfile($cpan_dir, 'MANIFEST');
+       my $manifest = catfile($cpan_dir, 'MANIFEST');
        die "ERROR: no such file: $manifest\n" unless  -f $manifest;
 
        my $cpan_files = ExtUtils::Manifest::maniread($manifest);
        my @cpan_files = sort keys %$cpan_files;
 
+        (my $main_pm = $module) =~ s{::}{/}g;
+        $main_pm .= ".pm";
+
        my ($excluded, $map) =  get_map($m, $module, \@perl_files);
 
        my %perl_unseen;
@@ -311,7 +290,7 @@ EOF
            }
 
 
-           my $abs_cpan_file = File::Spec->catfile($cpan_dir, $cpan_file);
+           my $abs_cpan_file = catfile($cpan_dir, $cpan_file);
 
            # should never happen
            die "ERROR: can't find file $abs_cpan_file\n" unless -f $abs_cpan_file;
@@ -322,8 +301,17 @@ EOF
                next;
            }
 
-                       my $relative_mapped_file = $mapped_file;
-                       $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///;
+            my $relative_mapped_file = $mapped_file;
+            $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///;
+
+            for my $f ( catfile('lib', $main_pm), $main_pm ) {
+              next unless $f eq $relative_mapped_file;
+              my $pv = MM->parse_version($mapped_file) || '(unknown)';
+              my $cv = MM->parse_version($abs_cpan_file) || '(unknown)';
+              if ( $pv ne $cv ) {
+                print $outfh "  Version mismatch: $cv (cpan) vs $pv (perl)\n";
+              }
+            }
 
            if (File::Compare::compare($abs_cpan_file, $mapped_file)) {
 
@@ -375,7 +363,7 @@ sub do_crosscheck {
 
     my $file = '02packages.details.txt';
     my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
-    my $path = File::Spec->catfile($download_dir, $file);
+    my $path = catfile($download_dir, $file);
     my $gzfile = "$path.gz";
 
     # grab 02packages.details.txt
@@ -570,14 +558,13 @@ sub my_getstore {
 # dist:       name of the distribution
 
 sub get_distribution {
-    my ($cache_dir, $mirror_url, $untar_dir, $module, $dist) = @_;
+    my ($src_dir, $mirror_url, $untar_dir, $module, $dist) = @_;
 
     $dist =~ m{.+/([^/]+)$}
        or die "ERROR: $module: invalid DISTRIBUTION name (no AUTHOR/ prefix): $dist\n";
     my $filename = $1;
 
-    my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
-    my $download_file = File::Spec->catfile($download_dir, $filename);
+    my $download_file = catfile($src_dir, $filename);
 
     # download distribution
 
@@ -596,20 +583,21 @@ sub get_distribution {
            or die "ERROR: Could not fetch '$url'\n";
     }
 
-    # extract distribution
+    # get the expected name of the extracted distribution dir
 
-    my $ae = Archive::Extract->new( archive => $download_file);
-    $ae->extract( to => $untar_dir )
-       or die "ERROR: failed to extract distribution '$download_file to temp. dir: " . $ae->error() . "\n";
-
-    # get the name of the extracted distribution dir
-
-    my $path = File::Spec->catfile($untar_dir, $filename);
+    my $path = catfile($untar_dir, $filename);
 
     $path =~ s/\.tar\.gz$// or
     $path =~ s/\.zip$// or
       die "ERROR: downloaded file does not have a recognised suffix: $path\n";
 
+    # extract it unless we already have it cached or tarball is newer
+    if ( ! -d $path || ( -M $download_file < -M $path ) ) {
+      my $ae = Archive::Extract->new( archive => $download_file);
+      $ae->extract( to => $untar_dir )
+          or die "ERROR: failed to extract distribution '$download_file to temp. dir: " . $ae->error() . "\n";
+    }
+
     die "ERROR: Extracted tarball does not appear as $path\n" unless -d $path;
 
     return $path;