In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f0ce33d74d4adc7a8b004fe6b4266de0f326c253?hp=8bca5c8a8bf440bd153c3cead9b89ad997975d66>
- Log ----------------------------------------------------------------- commit f0ce33d74d4adc7a8b004fe6b4266de0f326c253 Author: David Mitchell <[email protected]> Date: Wed Jun 24 13:38:27 2009 +0100 core-cpan-diff: include author path in distro version comparison and display. (Also show module names being processed when using -o) M Porting/core-cpan-diff commit 8c814d1a540c5a07adc0648dc9d2b879bab3d772 Author: David Mitchell <[email protected]> Date: Wed Jun 24 13:03:12 2009 +0100 core-cpan-diff: continue with next distro on download failure M Porting/core-cpan-diff ----------------------------------------------------------------------- Summary of changes: Porting/core-cpan-diff | 49 ++++++++++++++++++++++++++--------------------- 1 files changed, 27 insertions(+), 22 deletions(-) diff --git a/Porting/core-cpan-diff b/Porting/core-cpan-diff index 80d6b7d..1b38a94 100755 --- a/Porting/core-cpan-diff +++ b/Porting/core-cpan-diff @@ -141,11 +141,11 @@ sub run { my $outfh; if (defined $output_file) { open $outfh, '>', $output_file - or die "ERROR: could not open file '$output_file' for writing: $!"; + or die "ERROR: could not open file '$output_file' for writing: $!\n"; } else { open $outfh, ">&STDOUT" - or die "ERROR: can't dup STDOUT: $!"; + or die "ERROR: can't dup STDOUT: $!\n"; } if (defined $cache_dir) { @@ -156,7 +156,7 @@ sub run { do_crosscheck($outfh, $cache_dir, $force, \...@modules); } else { - do_compare(\...@modules, $outfh, $cache_dir, $verbose, $use_diff, + do_compare(\...@modules, $outfh, $output_file, $cache_dir, $verbose, $use_diff, $reverse, $diff_opts); } } @@ -166,7 +166,7 @@ sub run { # compare a list of modules against their CPAN equivalents sub do_compare { - my ($modules, $outfh, $cache_dir, $verbose, + my ($modules, $outfh, $output_file, $cache_dir, $verbose, $use_diff, $reverse, $diff_opts) = @_; @@ -190,6 +190,7 @@ sub do_compare { my %seen_dist; for my $module (@$modules) { + warn "Processing $module ...\n" if defined $output_file; print $outfh "\n$module\n" unless $use_diff; my $m = $Maintainers::Modules{$module} @@ -208,8 +209,15 @@ sub do_compare { } $seen_dist{$dist}++; - my $cpan_dir = get_distribution($cache_dir, $untar_dir, $module, $dist); - + my $cpan_dir; + eval { + $cpan_dir = get_distribution($cache_dir, $untar_dir, $module, $dist) + }; + if ($@) { + print $outfh " ", $@; + print $outfh " (skipping)\n"; + next; + } my @perl_files = Maintainers::get_module_files($module); @@ -356,12 +364,13 @@ sub do_crosscheck { warn "WARNING: $file:$.: line doesn't have three fields (skipping)\n"; next; } - $modules{$f[0]} = $f[2]; - my $distro = $f[2]; - $distro =~ s{^.*/}{}; + $distro =~ s{^[A-Z]/[A-Z]{2}/}{}; # strip leading A/AB/ + $modules{$f[0]} = $distro; - $distros{distro_base($distro)}{$distro} = 1; + (my $short_distro = $distro) =~ s{^.*/}{}; + + $distros{distro_base($short_distro)}{$distro} = 1; } for my $module (@$modules) { @@ -373,23 +382,19 @@ sub do_crosscheck { next; } - - # given an try like + # given an entry like # Foo::Bar 1.23 foo-bar-1.23.tar.gz, # first compare the module name against Foo::Bar, and failing that, # against foo-bar my $pdist = $m->{DISTRIBUTION}; die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist; - $pdist =~ s{^.*/}{}; my $cdist = $modules{$module}; + (my $short_pdist = $pdist) =~ s{^.*/}{}; - if (defined $cdist) { - $cdist =~ s{^.*/}{}; - } - else { - my $d = $distros{distro_base($pdist)}; + unless (defined $cdist) { + my $d = $distros{distro_base($short_pdist)}; unless (defined $d) { print $outfh "\n$module: Can't determine current CPAN entry\n"; next; @@ -520,7 +525,7 @@ sub get_distribution { my ($cache_dir, $untar_dir, $module, $dist) = @_; $dist =~ m{.+/([^/]+)$} - or die "ERROR: $module: invalid DISTRIBUTION name (no AUTHOR/ prefix): $dist"; + 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 ); @@ -536,18 +541,18 @@ sub get_distribution { unless (-f $download_file) { # not cached $dist =~ /^([A-Z])([A-Z])/ - or die "ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist"; + or die "ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist\n"; my $url = "http://www.cpan.org/modules/by-authors/id/$1/$1$2/$dist";; my_getstore($url, $download_file) - or die "ERROR: Could not fetch '$url'"; + or die "ERROR: Could not fetch '$url'\n"; } # extract distribution 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(); + or die "ERROR: failed to extract distribution '$download_file to temp. dir: " . $ae->error() . "\n"; # get the name of the extracted distribution dir -- Perl5 Master Repository
