use File::Compare ();
use ExtUtils::Manifest;
use ExtUtils::MakeMaker ();
+use HTTP::Tiny;
BEGIN { die "Must be run from root of perl source tree\n" unless -d 'Porting' }
use lib 'Porting';
if ( $reverse || $use_diff || $diff_opts || $verbose );
}
else {
- $diff_opts = '-u' unless defined $diff_opts;
+ $diff_opts = '-u -b' unless defined $diff_opts;
usage("can't use -f without --crosscheck") if $force;
}
}
$mirror_url .= "/" unless substr( $mirror_url, -1 ) eq "/";
- my $test_file = "modules/07mirror.yml";
+ my $test_file = "modules/03modlist.data.gz";
my_getstore(
cpan_url( $mirror_url, $test_file ),
catfile( $cache_dir, $test_file )
return $mirror_url . $cpan_path;
}
+# construct a CPAN URL for a author/distribution string like:
+# BINGOS/Archive-Extract-0.52.tar.gz
+
+sub cpan_url_distribution {
+ my ( $mirror_url, $distribution ) = @_;
+ $distribution =~ /^([A-Z])([A-Z])/
+ or die "ERROR: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $distribution\n";
+ my $path = "modules/by-authors/id/$1/$1$2/$distribution";
+ return cpan_url( $mirror_url, $path );
+}
+
# compare a list of modules against their CPAN equivalents
sub do_compare {
( my $main_pm = $module ) =~ s{::}{/}g;
$main_pm .= ".pm";
- my ( $excluded, $map ) = get_map( $m, $module, \@perl_files );
+ my ( $excluded, $map, $customized ) =
+ get_map( $m, $module, \@perl_files );
my %perl_unseen;
@perl_unseen{@perl_files} = ();
my %perl_files = %perl_unseen;
foreach my $cpan_file (@cpan_files) {
- my $mapped_file = cpan_to_perl( $excluded, $map, $cpan_file );
+ my $mapped_file =
+ cpan_to_perl( $excluded, $map, $customized, $cpan_file );
unless ( defined $mapped_file ) {
print $outfh " Excluded: $cpan_file\n" if $verbose;
next;
print $outfh " CPAN only: $cpan_file",
( $cpan_file eq $mapped_file )
? "\n"
- : " (expected $mapped_file)\n";
+ : " (missing $mapped_file)\n";
}
next;
}
next;
}
- my $relative_mapped_file = $mapped_file;
- $relative_mapped_file =~ s/^(cpan|dist|ext)\/.*?\///;
+ my $relative_mapped_file = relatively_mapped($mapped_file);
- 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";
+ my $different =
+ file_diff( $outfh, $abs_cpan_file, $mapped_file, $reverse,
+ $diff_opts );
+ if ( $different && customized( $m, $relative_mapped_file ) ) {
+ if (! $use_diff ) {
+ print $outfh " Customized for blead: $relative_mapped_file\n";
}
}
-
- if ( File::Compare::compare( $abs_cpan_file, $mapped_file ) ) {
-
+ elsif ($different) {
if ($use_diff) {
- file_diff( $outfh, $abs_cpan_file, $mapped_file, $reverse,
- $diff_opts );
+ $different =~ s{^(--- |\+\+\+ )/tmp/[^/]+/}{$1}gm;
+ print $outfh $different;
}
else {
if ( $cpan_file eq $relative_mapped_file ) {
print $outfh
" Modified: $cpan_file $relative_mapped_file\n";
}
+
+ if ( $cpan_file =~ m{\.pm\z} ) {
+ 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 in '$cpan_file':\n $cv (cpan) vs $pv (perl)\n";
+ }
+ }
+
+ }
+ }
+ elsif ( customized( $m, $relative_mapped_file ) ) {
+ # Maintainers.pl says we customized it, but it looks the
+ # same as CPAN so maybe we lost the customization, which
+ # could be bad
+ if ( $cpan_file eq $relative_mapped_file ) {
+ print $outfh " Blead customization missing: $cpan_file\n";
+ }
+ else {
+ print $outfh
+ " Blead customization missing: $cpan_file $relative_mapped_file\n";
}
}
elsif ($verbose) {
}
}
for ( sort keys %perl_unseen ) {
- print $outfh " Perl only: $_\n" unless $use_diff;
+ my $relative_mapped_file = relatively_mapped($_);
+ if ( customized( $m, $relative_mapped_file ) ) {
+ print $outfh " Customized for blead: $_\n";
+ }
+ else {
+ print $outfh " Perl only: $_\n" unless $use_diff;
+ }
}
}
}
+sub relatively_mapped {
+ my $relative = shift;
+ $relative =~ s/^(cpan|dist|ext)\/.*?\///;
+ return $relative;
+}
+
# given FooBar-1.23_45.tar.gz, return FooBar
sub distro_base {
sub get_map {
my ( $m, $module_name, $perl_files ) = @_;
- my ( $excluded, $map ) = @$m{qw(EXCLUDED MAP)};
+ my ( $excluded, $map, $customized ) = @$m{qw(EXCLUDED MAP CUSTOMIZED)};
- $excluded ||= [];
+ $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)???
'' => "$base/",
};
}
- return $excluded, $map;
+ return $excluded, $map, $customized;
}
# Given an exclude list and a mapping hash, convert a CPAN filename
# 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) {
+ next if $exclude ~~ $customized;
# may be a simple string to match exactly, or a pattern
if ( ref $exclude ) {
return $perl_file;
}
-# do LWP::Simple::getstore, possibly without LWP::Simple being available
-
-my $lwp_simple_available;
+# fetch a file from a URL and store it in a file given by a filename
sub my_getstore {
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 ) );
- }
- elsif ( $url =~ qr{\Afile://(?:localhost)?/} ) {
+ if ( $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;
+ } else {
+ my $http = HTTP::Tiny->new;
+ my $response = $http->mirror($url, $file);
+ return $response->{success};
}
}
unless ( -f $download_file ) {
# not cached
- $dist =~ /^([A-Z])([A-Z])/
- or die
-"ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist\n";
-
- my $url =
- cpan_url( $mirror_url, "modules/by-authors/id/$1/$1$2/$dist" );
+ my $url = cpan_url_distribution( $mirror_url, $dist );
my_getstore( $url, $download_file )
or die "ERROR: Could not fetch '$url'\n";
}
or die
"ERROR: failed to extract distribution '$download_file to temp. dir: "
. $ae->error() . "\n";
+
+ $path = $ae->extract_path;
}
die "ERROR: Extracted tarball does not appear as $path\n" unless -d $path;
else {
push @cmd, $cpan_file, $perl_file;
}
- my $result = `@cmd`;
+ return `@cmd`;
- $result =~ s{^(--- |\+\+\+ )/tmp/[^/]+/}{$1}gm;
+}
- print $outfh $result;
+sub customized {
+ my ( $module_data, $file ) = @_;
+ return grep { $file eq $_ } @{ $module_data->{CUSTOMIZED} };
}
run();
https://perl5.git.perl.org / perl5.git / blobdiff