In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/388a738468888624b9ee18ce319fa7082b2df529?hp=ce1e4fda3931f9c330397927c4dd769f3d89fcce>
- Log ----------------------------------------------------------------- commit 388a738468888624b9ee18ce319fa7082b2df529 Author: David Golden <[email protected]> Date: Sun Jul 18 22:34:07 2010 -0400 Maintainers.pl: podlators Makefile.PL is CUSTOMIZED M Porting/Maintainers.pl commit 36d390b4d90fa6c1a5133f6eeb406b87be43c681 Author: David Golden <[email protected]> Date: Sun Jul 18 22:29:35 2010 -0400 Maintainers.pl: CPANPLUS Makefile.PL is CUSTOMIZED M Porting/Maintainers.pl commit d43babf1b11b2ba5315a4be1ff489211de43acf0 Author: David Golden <[email protected]> Date: Sun Jul 18 21:36:39 2010 -0400 Add libnet Makefile.PL to CUSTOMIZED in Maintainers M Porting/Maintainers.pl commit 4ba81d112a36521ecf4b1e6a21e979df3bbd0c47 Author: David Golden <[email protected]> Date: Sun Jul 18 21:34:54 2010 -0400 Add support for CUSTOMIZED in Maintainers.PL Some dual-life modules have custom files in core that differ from CPAN. (e.g. Makefile.PL in libnet) These files need to be listed in EXCLUDED, but also in CUSTOMIZED so that we don't flag them incorrectly as "only in Perl" M Porting/core-cpan-diff commit 9b09acf88be8f0d59770885ae39ec143722a5777 Author: David Golden <[email protected]> Date: Sun Jul 18 20:56:33 2010 -0400 Removed Archive-Tar Makefile.PL so it autogenerates M MANIFEST M Porting/Maintainers.pl D cpan/Archive-Tar/Makefile.PL commit ef9dbfd81928becb09f9819cad411d8b62defab6 Author: David Golden <[email protected]> Date: Sun Jul 18 20:51:30 2010 -0400 Added t/porting/dual-life.t Because we manually generate Makefiles, any executables need to be generated from .PL files in utils/. This test checks if dual-life executables show up in utils/. A t/porting/dual-life.t commit 360b85604cef450c7dccc87fe5fa44dcf82f3c7d Author: David Golden <[email protected]> Date: Sun Jul 18 20:25:22 2010 -0400 core-cpan-diff: improve detection of version mismatches M Porting/core-cpan-diff commit 779432187c22649ffc8c6364b6391041904254bf Author: David Golden <[email protected]> Date: Sun Jul 18 20:14:44 2010 -0400 List libnet Makefile.PL as excluded M Porting/Maintainers.pl commit 333797b2d34ca073a569145bb5d4307e540cf2b7 Author: David Golden <[email protected]> Date: Sun Jul 18 19:20:53 2010 -0400 core-cpan-diff: perltidy with default settings M Porting/core-cpan-diff commit c4940a93ad28ec2d21b2e7db2171a06a7712952e Author: David Golden <[email protected]> Date: Sun Jul 18 19:10:55 2010 -0400 core-cpan-diff: various enhancements * 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. M Porting/core-cpan-diff commit a08d2aaddd0e34ad9ca2b286dd71de3a8d53e3df Author: David Golden <[email protected]> Date: Sun Jul 18 16:02:49 2010 -0400 core-cpan-diff: fix handling of file:/// urls M Porting/core-cpan-diff commit e66db76dc0d5c287207937130fcf4ceed0804242 Author: David Golden <[email protected]> Date: Sun Jul 18 14:50:14 2010 -0400 core-cpan-diff: remove trailing spaces M Porting/core-cpan-diff commit 10be9a51c4a4ea44f3cf2d486e6b63b8f45b6c1c Author: David Golden <[email protected]> Date: Sun Jul 18 14:47:47 2010 -0400 core-cpan-diff: add option for local CPAN mirror M Porting/core-cpan-diff ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 - Porting/Maintainers.pl | 13 +- Porting/core-cpan-diff | 737 +++++++++++++++++++++++------------------- cpan/Archive-Tar/Makefile.PL | 11 - t/porting/dual-life.t | 29 ++ 5 files changed, 437 insertions(+), 354 deletions(-) delete mode 100644 cpan/Archive-Tar/Makefile.PL create mode 100644 t/porting/dual-life.t diff --git a/MANIFEST b/MANIFEST index cea013e..74e8c46 100644 --- a/MANIFEST +++ b/MANIFEST @@ -48,7 +48,6 @@ cpan/Archive-Tar/bin/ptardiff the ptardiff utility cpan/Archive-Tar/lib/Archive/Tar/Constant.pm Archive::Tar cpan/Archive-Tar/lib/Archive/Tar/File.pm Archive::Tar cpan/Archive-Tar/lib/Archive/Tar.pm Archive::Tar -cpan/Archive-Tar/Makefile.PL Achive::Tar cpan/Archive-Tar/t/01_use.t Archive::Tar tests cpan/Archive-Tar/t/02_methods.t Archive::Tar tests cpan/Archive-Tar/t/03_file.t Archive::Tar tests diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 32e5b5f..3d5a714 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -144,6 +144,11 @@ use File::Glob qw(:case); # full pathname (eg 't/foo.t') or a pattern (e.g. qr{^t/}). # It defaults to the empty list. +# CUSTOMIZED is a list of files that have been customized within the +# Perl core. They should also be listed in EXCLUDED, but this will +# additionally suppress core-cpan-diff warnings that they differ from +# the CPAN tarballs + # DEPRECATED contains the *first* version of Perl in which the module # was considered deprecated. It should only be present if the module is # actually deprecated. Such modules should use deprecated.pm to @@ -194,6 +199,7 @@ use File::Glob qw(:case); 'MAINTAINER' => 'kane', 'DISTRIBUTION' => 'BINGOS/Archive-Tar-1.64.tar.gz', 'FILES' => q[cpan/Archive-Tar], + 'EXCLUDED' => [ qw(Makefile.PL) ], 'UPSTREAM' => 'cpan', 'BUGS' => '[email protected]', }, @@ -406,7 +412,9 @@ use File::Glob qw(:case); t/031_CPANPLUS-Internals-Source-SQLite.t t/032_CPANPLUS-Internals-Source-via-sqlite.t }, + qw{ Makefile.PL }, ], + 'CUSTOMIZED' => [ qw{ Makefile.PL } ], 'UPSTREAM' => 'cpan', 'BUGS' => '[email protected]', }, @@ -782,7 +790,8 @@ use File::Glob qw(:case); 'MAINTAINER' => 'gbarr', 'DISTRIBUTION' => 'GBARR/libnet-1.22.tar.gz', 'FILES' => q[cpan/libnet], - 'EXCLUDED' => [ qw{Configure install-nomake} ], + 'EXCLUDED' => [ qw{Configure install-nomake Makefile.PL} ], + 'CUSTOMIZED' => [ qw{Makefile.PL} ], 'UPSTREAM' => undef, }, @@ -1206,6 +1215,8 @@ use File::Glob qw(:case); pod/pod2man.PL pod/pod2text.PL ], + 'EXCLUDED' => [ qw{ Makefile.PL } ], + 'CUSTOMIZED' => [ qw{ Makefile.PL } ], 'MAP' => { '' => 'cpan/podlators/', 'scripts/' => 'pod/', }, diff --git a/Porting/core-cpan-diff b/Porting/core-cpan-diff index 4b34a2e..b169855 100755 --- a/Porting/core-cpan-diff +++ b/Porting/core-cpan-diff @@ -3,20 +3,23 @@ # core-cpan-diff: Compare CPAN modules with their equivalent in core # Originally based on App::DualLivedDiff by Steffen Mueller. - + use strict; use warnings; use 5.010; use Getopt::Long; -use File::Temp (); -use File::Path (); -use File::Spec; +use File::Basename (); +use File::Copy (); +use File::Temp (); +use File::Path (); +use File::Spec::Functions; use Archive::Extract; use IO::Uncompress::Gunzip (); -use File::Compare (); +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'; @@ -30,27 +33,18 @@ use Archive::Tar; use IPC::Open3; use IO::Select; $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'; -use constant WGET_CMD => 'wget'; +use constant DIFF_CMD => 'diff'; +use constant WGET_CMD => 'wget'; sub usage { print STDERR "\...@_\n\n" if @_; @@ -71,6 +65,9 @@ Usage: $0 [opts] [ -d | -v | -x ] [ -a | module ... ] -f|force Force download from CPAN of new 02packages.details.txt file (with --crosscheck only). +-m|mirror Preferred CPAN mirror URI (http:// or file:///) + (Local mirror must be a complete mirror, not minicpan) + -o/--output File name to write output to (defaults to STDOUT). -r/--reverse Reverses the diff (perl to CPAN). @@ -94,13 +91,13 @@ HERE exit(1); } - sub run { my $scan_all; my $diff_opts; - my $reverse = 0; + my $reverse = 0; my @wanted_upstreams; my $cache_dir; + my $mirror_url = "http://www.cpan.org/";; my $use_diff; my $output_file; my $verbose; @@ -108,222 +105,263 @@ sub run { my $do_crosscheck; GetOptions( - 'a|all' => \$scan_all, - 'c|cachedir=s' => \$cache_dir, - 'd|diff' => \$use_diff, - 'diffopts:s' => \$diff_opts, - 'f|force' => \$force, - 'h|help' => \&usage, - 'o|output=s' => \$output_file, - 'r|reverse' => \$reverse, - 'u|upstream=s@'=> \...@wanted_upstreams, - 'v|verbose' => \$verbose, - 'x|crosscheck' => \$do_crosscheck, + 'a|all' => \$scan_all, + 'c|cachedir=s' => \$cache_dir, + 'd|diff' => \$use_diff, + 'diffopts:s' => \$diff_opts, + 'f|force' => \$force, + 'h|help' => \&usage, + 'm|mirror=s' => \$mirror_url, + 'o|output=s' => \$output_file, + 'r|reverse' => \$reverse, + 'u|upstream=s@' => \...@wanted_upstreams, + 'v|verbose' => \$verbose, + 'x|crosscheck' => \$do_crosscheck, ) or usage; - my @modules; usage("Cannot mix -a with module list") if $scan_all && @ARGV; if ($do_crosscheck) { - usage("can't use -r, -d, --diffopts, -v with --crosscheck") - if ($reverse || $use_diff || $diff_opts || $verbose); + usage("can't use -r, -d, --diffopts, -v with --crosscheck") + if ( $reverse || $use_diff || $diff_opts || $verbose ); } else { - $diff_opts = '-u' unless defined $diff_opts; - usage("can't use -f without --crosscheck") if $force; + $diff_opts = '-u' unless defined $diff_opts; + usage("can't use -f without --crosscheck") if $force; } - @modules = $scan_all - ? grep $Maintainers::Modules{$_}{CPAN}, - (sort {lc $a cmp lc $b } keys %Maintainers::Modules) - : @ARGV; + @modules = + $scan_all + ? grep $Maintainers::Modules{$_}{CPAN}, + ( sort { lc $a cmp lc $b } keys %Maintainers::Modules ) + : @ARGV; usage("No modules specified") unless @modules; - my $outfh; - if (defined $output_file) { - open $outfh, '>', $output_file - or die "ERROR: could not open file '$output_file' for writing: $!\n"; + if ( defined $output_file ) { + open $outfh, '>', $output_file + or die "ERROR: could not open file '$output_file' for writing: $!\n"; } else { - open $outfh, ">&STDOUT" - or die "ERROR: can't dup STDOUT: $!\n"; + open $outfh, ">&STDOUT" + or die "ERROR: can't dup STDOUT: $!\n"; } - if (defined $cache_dir) { - die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir; + 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 ), + catfile( $cache_dir, $test_file ) + ) or die "ERROR: not a CPAN mirror '$mirror_url'\n"; + if ($do_crosscheck) { - do_crosscheck($outfh, $cache_dir, $force, \...@modules); + do_crosscheck( $outfh, $cache_dir, $mirror_url, $force, \...@modules ); } else { - do_compare(\...@modules, $outfh, $output_file, $cache_dir, $verbose, $use_diff, - $reverse, $diff_opts, \...@wanted_upstreams); + do_compare( + \...@modules, $outfh, $output_file, + $cache_dir, $mirror_url, $verbose, + $use_diff, $reverse, $diff_opts, + \...@wanted_upstreams + ); } } +# construct a CPAN url +sub cpan_url { + my ( $mirror_url, @path ) = @_; + return $mirror_url unless @path; + my $cpan_path = join( "/", map { split "/", $_ } @path ); + $cpan_path =~ s{\A/}{}; # remove leading slash since url has one trailing + return $mirror_url . $cpan_path; +} # compare a list of modules against their CPAN equivalents sub do_compare { - my ($modules, $outfh, $output_file, $cache_dir, $verbose, - $use_diff, $reverse, $diff_opts, $wanted_upstreams) = @_; - + my ( + $modules, $outfh, $output_file, $cache_dir, + $mirror_url, $verbose, $use_diff, $reverse, + $diff_opts, $wanted_upstreams + ) = @_; # 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; + my %ignorable = map { ( $_ => 1 ) } @Maintainers::IGNORABLE; my %seen_dist; for my $module (@$modules) { - warn "Processing $module ...\n" if defined $output_file; - - my $m = $Maintainers::Modules{$module} - or die "ERROR: No such module in Maintainers.pl: '$module'\n"; - - unless ($m->{CPAN}) { - print $outfh "WARNING: $module is not dual-life; skipping\n"; - next; - } - - my $dist = $m->{DISTRIBUTION}; - die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $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}++; - - 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); - - my $manifest = File::Spec->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 ($excluded, $map) = get_map($m, $module, \...@perl_files); - - my %perl_unseen; - @perl_unse...@perl_files} = (); - my %perl_files = %perl_unseen; - - foreach my $cpan_file (@cpan_files) { - my $mapped_file = cpan_to_perl($excluded, $map, $cpan_file); - unless (defined $mapped_file) { - print $outfh " Excluded: $cpan_file\n" if $verbose; - next; - } - - if (exists $perl_files{$mapped_file}) { - delete $perl_unseen{$mapped_file}; - } - else { - # some CPAN files foo are stored in core as foo.packed, - # which are then unpacked by 'make test_prep' - my $packed_file = "$mapped_file.packed"; - if (exists $perl_files{$packed_file} ) { - if (! -f $mapped_file and -f $packed_file) { - print $outfh <<EOF; + warn "Processing $module ...\n" if defined $output_file; + + my $m = $Maintainers::Modules{$module} + or die "ERROR: No such module in Maintainers.pl: '$module'\n"; + + unless ( $m->{CPAN} ) { + print $outfh "WARNING: $module is not dual-life; skipping\n"; + next; + } + + my $dist = $m->{DISTRIBUTION}; + die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $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"; + print $outfh " upstream is: " + . ( $m->{UPSTREAM} || 'UNKNOWN!' ) . "\n"; + + my $cpan_dir; + eval { + $cpan_dir = + get_distribution( $src_dir, $mirror_url, $untar_dir, $module, + $dist ); + }; + if ($@) { + print $outfh " ", $@; + print $outfh " (skipping)\n"; + next; + } + + my @perl_files = Maintainers::get_module_files($module); + + 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, $customized) = get_map( $m, $module, \...@perl_files ); + + my %perl_unseen; + @perl_unse...@perl_files} = (); + my %perl_files = %perl_unseen; + + foreach my $cpan_file (@cpan_files) { + my $mapped_file = cpan_to_perl( $excluded, $map, $customized, $cpan_file ); + unless ( defined $mapped_file ) { + print $outfh " Excluded: $cpan_file\n" if $verbose; + next; + } + + if ( exists $perl_files{$mapped_file} ) { + delete $perl_unseen{$mapped_file}; + } + else { + + # some CPAN files foo are stored in core as foo.packed, + # which are then unpacked by 'make test_prep' + my $packed_file = "$mapped_file.packed"; + if ( exists $perl_files{$packed_file} ) { + if ( !-f $mapped_file and -f $packed_file ) { + print $outfh <<EOF; WARNING: $mapped_file not found, but .packed variant exists. Perhaps you need to run 'make test_prep'? EOF - next; - } - delete $perl_unseen{$packed_file}; - } - else { - if ($ignorable{$cpan_file}) { - print $outfh " Ignored: $cpan_file\n" if $verbose; - next; - } - - unless ($use_diff) { - print $outfh " CPAN only: $cpan_file", - ($cpan_file eq $mapped_file) ? "\n" - : " (expected $mapped_file)\n"; - } - next; - } - } - - - my $abs_cpan_file = File::Spec->catfile($cpan_dir, $cpan_file); - - # should never happen - die "ERROR: can't find file $abs_cpan_file\n" unless -f $abs_cpan_file; - - # might happen if the FILES entry in Maintainers.pl is wrong - unless (-f $mapped_file) { - print $outfh "WARNING: perl file not found: $mapped_file\n"; - next; - } - - my $relative_mapped_file = $mapped_file; - $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///; - - if (File::Compare::compare($abs_cpan_file, $mapped_file)) { - - - if ($use_diff) { - file_diff($outfh, $abs_cpan_file, $mapped_file, - $reverse, $diff_opts); - } - else { - if ($cpan_file eq $relative_mapped_file) { - print $outfh " Modified: $relative_mapped_file\n"; - } - else { - print $outfh " Modified: $cpan_file $relative_mapped_file\n"; - } - } - } - elsif ($verbose) { - if ($cpan_file eq $relative_mapped_file) { - print $outfh " Unchanged: $cpan_file\n"; - } - else { - print $outfh " Unchanged: $cpan_file $relative_mapped_file\n"; - } - } - } - for (sort keys %perl_unseen) { - print $outfh " Perl only: $_\n" unless $use_diff; - } + next; + } + delete $perl_unseen{$packed_file}; + } + else { + if ( $ignorable{$cpan_file} ) { + print $outfh " Ignored: $cpan_file\n" if $verbose; + next; + } + + unless ($use_diff) { + print $outfh " CPAN only: $cpan_file", + ( $cpan_file eq $mapped_file ) + ? "\n" + : " (expected $mapped_file)\n"; + } + next; + } + } + + 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; + + # might happen if the FILES entry in Maintainers.pl is wrong + unless ( -f $mapped_file ) { + print $outfh "WARNING: perl file not found: $mapped_file\n"; + next; + } + + my $relative_mapped_file = $mapped_file; + $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///; + + for my $f ( catfile( 'lib', $main_pm ), File::Basename::basename($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"; + } + } + + my $different = File::Compare::compare( $abs_cpan_file, $mapped_file ); + if ( $different && customized( $m, $relative_mapped_file) ) { + if ($verbose) { + print $outfh " Customized: $relative_mapped_file\n"; + } + } + elsif ( $different ) { + if ($use_diff) { + file_diff( $outfh, $abs_cpan_file, $mapped_file, $reverse, + $diff_opts ); + } + else { + if ( $cpan_file eq $relative_mapped_file ) { + print $outfh " Modified: $relative_mapped_file\n"; + } + else { + print $outfh + " Modified: $cpan_file $relative_mapped_file\n"; + } + } + } + elsif ($verbose) { + if ( $cpan_file eq $relative_mapped_file ) { + print $outfh " Unchanged: $cpan_file\n"; + } + else { + print $outfh + " Unchanged: $cpan_file $relative_mapped_file\n"; + } + } + } + for ( sort keys %perl_unseen ) { + print $outfh " Perl only: $_\n" unless $use_diff; + } } } @@ -342,245 +380,259 @@ sub distro_base { # Maintainers.pl sub do_crosscheck { - my ($outfh, $cache_dir, $force, $modules) = @_; + my ( $outfh, $cache_dir, $mirror_url, $force, $modules ) = @_; - my $file = '02packages.details.txt'; + my $file = '02packages.details.txt'; my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 ); - my $path = File::Spec->catfile($download_dir, $file); - my $gzfile = "$path.gz"; + my $path = catfile( $download_dir, $file ); + my $gzfile = "$path.gz"; # grab 02packages.details.txt - my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz'; + my $url = cpan_url( $mirror_url, "modules/02packages.details.txt.gz" ); - if (! -f $gzfile or $force) { - unlink $gzfile; - my_getstore($url, $gzfile); + if ( !-f $gzfile or $force ) { + unlink $gzfile; + my_getstore( $url, $gzfile ); } unlink $path; - IO::Uncompress::Gunzip::gunzip($gzfile, $path) - or die "ERROR: failed to ungzip $gzfile: $IO::Uncompress::Gunzip::GunzipError\n"; + IO::Uncompress::Gunzip::gunzip( $gzfile, $path ) + or die + "ERROR: failed to ungzip $gzfile: $IO::Uncompress::Gunzip::GunzipError\n"; # suck in the data from it - + open my $fh, '<', $path - or die "ERROR: open: $file: $!\n"; + or die "ERROR: open: $file: $!\n"; my %distros; my %modules; while (<$fh>) { - next if 1../^$/; - chomp; - my @f = split ' ', $_; - if (@f != 3) { - warn "WARNING: $file:$.: line doesn't have three fields (skipping)\n"; - next; - } - my $distro = $f[2]; - $distro =~ s{^[A-Z]/[A-Z]{2}/}{}; # strip leading A/AB/ - $modules{$f[0]} = $distro; - - (my $short_distro = $distro) =~ s{^.*/}{}; - - $distros{distro_base($short_distro)}{$distro} = 1; + next if 1 .. /^$/; + chomp; + my @f = split ' ', $_; + if ( @f != 3 ) { + warn + "WARNING: $file:$.: line doesn't have three fields (skipping)\n"; + next; + } + my $distro = $f[2]; + $distro =~ s{^[A-Z]/[A-Z]{2}/}{}; # strip leading A/AB/ + $modules{ $f[0] } = $distro; + + ( my $short_distro = $distro ) =~ s{^.*/}{}; + + $distros{ distro_base($short_distro) }{$distro} = 1; } for my $module (@$modules) { - my $m = $Maintainers::Modules{$module} - or die "ERROR: No such module in Maintainers.pl: '$module'\n"; - - unless ($m->{CPAN}) { - print $outfh "\nWARNING: $module is not dual-life; skipping\n"; - next; - } - - # 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; - - my $cdist = $modules{$module}; - (my $short_pdist = $pdist) =~ s{^.*/}{}; - - 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; - } - if (keys %$d > 1) { - print $outfh "\n$module: (found more than one CPAN candidate):\n"; - print $outfh " perl: $pdist\n"; - print $outfh " CPAN: $_\n" for sort keys %$d; - next; - } - $cdist = (keys %$d)[0]; - } - - if ($cdist ne $pdist) { - print $outfh "\n$module:\n Perl: $pdist\n CPAN: $cdist\n"; - } + my $m = $Maintainers::Modules{$module} + or die "ERROR: No such module in Maintainers.pl: '$module'\n"; + + unless ( $m->{CPAN} ) { + print $outfh "\nWARNING: $module is not dual-life; skipping\n"; + next; + } + + # 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; + + my $cdist = $modules{$module}; + ( my $short_pdist = $pdist ) =~ s{^.*/}{}; + + 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; + } + if ( keys %$d > 1 ) { + print $outfh + "\n$module: (found more than one CPAN candidate):\n"; + print $outfh " perl: $pdist\n"; + print $outfh " CPAN: $_\n" for sort keys %$d; + next; + } + $cdist = ( keys %$d )[0]; + } + + if ( $cdist ne $pdist ) { + print $outfh "\n$module:\n Perl: $pdist\n CPAN: $cdist\n"; + } } } - - # get the EXCLUDED and MAP entries for this module, or # make up defauts if they don't exist sub get_map { - my ($m, $module_name, $perl_files) = @_; + my ( $m, $module_name, $perl_files ) = @_; - my ($excluded, $map) = @$m{qw(EXCLUDED MAP)}; + my ( $excluded, $map, $customized ) = @$m{qw(EXCLUDED MAP CUSTOMIZED)}; $excluded ||= []; + $customized ||= []; - return $excluded, $map if $map; + return $excluded, $map, $customized if $map; # all files under ext/foo-bar (plus maybe some under t/lib)??? my $ext; for (@$perl_files) { - if (m{^((?:ext|dist|cpan)/[^/]+/)}) { - if (defined $ext and $ext ne $1) { - # more than one ext/$ext/ - undef $ext; - last; - } - $ext = $1; - } - elsif (m{^t/lib/}) { - next; - } - else { - undef $ext; - last; - } + if (m{^((?:ext|dist|cpan)/[^/]+/)}) { + if ( defined $ext and $ext ne $1 ) { + + # more than one ext/$ext/ + undef $ext; + last; + } + $ext = $1; + } + elsif (m{^t/lib/}) { + next; + } + else { + undef $ext; + last; + } } - - if (defined $ext) { - $map = { '' => $ext }, + + if ( defined $ext ) { + $map = { '' => $ext },; } else { - (my $base = $module_name) =~ s{::}{/}g; - $base ="lib/$base"; - $map = { - 'lib/' => 'lib/', - '' => "$base/", - }; + ( my $base = $module_name ) =~ s{::}{/}g; + $base = "lib/$base"; + $map = { + 'lib/' => 'lib/', + '' => "$base/", + }; } - return $excluded, $map; + return $excluded, $map, $customized; } - # Given an exclude list and a mapping hash, convert a CPAN filename # (eg 't/bar.t') to the equivalent perl filename (eg 'lib/Foo/Bar/t/bar.t'). # Returns an empty list for an excluded file sub cpan_to_perl { - my ($excluded, $map, $cpan_file) = @_; + my ( $excluded, $map, $customized, $cpan_file ) = @_; for my $exclude (@$excluded) { - # may be a simple string to match exactly, or a pattern - if (ref $exclude) { - return if $cpan_file =~ $exclude; - } - else { - return if $cpan_file eq $exclude; - } + next if $exclude ~~ $customized; + # may be a simple string to match exactly, or a pattern + if ( ref $exclude ) { + return if $cpan_file =~ $exclude; + } + else { + return if $cpan_file eq $exclude; + } } my $perl_file = $cpan_file; # try longest prefix first, then alphabetically on tie-break - for my $prefix (sort { length($b) <=> length($a) || $a cmp $b } keys %$map) + for + my $prefix ( sort { length($b) <=> length($a) || $a cmp $b } keys %$map ) { - last if $perl_file =~ s/^\Q$prefix/$map->{$prefix}/; + last if $perl_file =~ s/^\Q$prefix/$map->{$prefix}/; } return $perl_file; } - - # do LWP::Simple::getstore, possibly without LWP::Simple being available my $lwp_simple_available; sub my_getstore { - my ($url, $file) = @_; - unless (defined $lwp_simple_available) { - eval { require LWP::Simple }; - $lwp_simple_available = $@ eq ''; + my ( $url, $file ) = @_; + File::Path::mkpath( File::Basename::dirname($file) ); + unless ( defined $lwp_simple_available ) { + eval { require LWP::Simple }; + $lwp_simple_available = $@ eq ''; } if ($lwp_simple_available) { - return LWP::Simple::is_success(LWP::Simple::getstore($url, $file)); + return LWP::Simple::is_success( LWP::Simple::getstore( $url, $file ) ); + } + elsif ( $url =~ qr{\Afile://(?:localhost)?/} ) { + ( my $local_path = $url ) =~ s{\Afile://(?:localhost)?}{}; + File::Copy::copy( $local_path, $file ); } else { - return system(WGET_CMD, "-O", $file, $url) == 0; + return system( WGET_CMD, "-O", $file, $url ) == 0; } } - # download and unpack a distribution # Returns the full pathname of the extracted directory # (eg '/tmp/XYZ/Foo_bar-1.23') -# cache_dir: where to dowenload the .tar.gz file to -# untar_dir: where to untar or unzup the file -# module: name of module -# dist: name of the distribution +# cache_dir: where to download the .tar.gz file to +# mirror_url: CPAN mirror to download from +# untar_dir: where to untar or unzup the file +# module: name of module +# dist: name of the distribution sub get_distribution { - my ($cache_dir, $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"; + 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 - if (-f $download_file and ! -s $download_file ) { - # wget can leave a zero-length file on failed download - unlink $download_file; + if ( -f $download_file and !-s $download_file ) { + + # wget can leave a zero-length file on failed download + unlink $download_file; } - unless (-f $download_file) { - # not cached - $dist =~ /^([A-Z])([A-Z])/ - or die "ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist\n"; + unless ( -f $download_file ) { - 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'\n"; - } + # not cached + $dist =~ /^([A-Z])([A-Z])/ + or die +"ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist\n"; - # extract distribution + my $url = + cpan_url( $mirror_url, "modules/by-authors/id/$1/$1$2/$dist" ); + my_getstore( $url, $download_file ) + or die "ERROR: Could not fetch '$url'\n"; + } - 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 expected name of the extracted distribution dir - # get the name of the extracted distribution dir + my $path = catfile( $untar_dir, $filename ); - my $path = File::Spec->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"; - $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; } - # produce the diff of a single file sub file_diff { my $outfh = shift; @@ -589,13 +641,12 @@ sub file_diff { my $reverse = shift; my $diff_opts = shift; - - my @cmd = (DIFF_CMD, split ' ', $diff_opts); + my @cmd = ( DIFF_CMD, split ' ', $diff_opts ); if ($reverse) { - push @cmd, $perl_file, $cpan_file; + push @cmd, $perl_file, $cpan_file; } else { - push @cmd, $cpan_file, $perl_file; + push @cmd, $cpan_file, $perl_file; } my $result = `...@cmd`; @@ -604,6 +655,10 @@ sub file_diff { print $outfh $result; } +sub customized { + my ($module_data, $file) = @_; + return grep { $file eq $_ } @{ $module_data->{CUSTOMIZED} }; +} run(); diff --git a/cpan/Archive-Tar/Makefile.PL b/cpan/Archive-Tar/Makefile.PL deleted file mode 100644 index b412d30..0000000 --- a/cpan/Archive-Tar/Makefile.PL +++ /dev/null @@ -1,11 +0,0 @@ -use strict; -use ExtUtils::MakeMaker; - -WriteMakefile ( - NAME => 'Archive::Tar', - VERSION_FROM => 'lib/Archive/Tar.pm', # finds $VERSION - EXE_FILES => ['bin/ptar', 'bin/ptardiff'], - INSTALLDIRS => ( $] >= 5.009003 ? 'perl' : 'site' ), - AUTHOR => 'Jos Boumans <kane[at]cpan.org>', - ABSTRACT => 'Manipulates TAR archives' -); diff --git a/t/porting/dual-life.t b/t/porting/dual-life.t new file mode 100644 index 0000000..cf3c337 --- /dev/null +++ b/t/porting/dual-life.t @@ -0,0 +1,29 @@ +#!/perl -w +use strict; + +# This tests properties of dual-life modules: +# +# * Are all dual-life programs being generated in utils/? + +use File::Basename; +use File::Find; +use File::Spec::Functions; +use Test::More; END { done_testing } + +my @programs; + +find( + sub { + my $name = $File::Find::name; + return if $name =~ /blib/; + return unless $name =~ m{/(?:bin|scripts?)/\S+\z}; + + push @programs, $name; + }, + qw( ../cpan ../dist ../ext ), +); + +for my $f ( @programs ) { + ok( -f catfile('..', 'utils', basename($f)), "$f" ); +} + -- Perl5 Master Repository
