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';
use constant UNTAR_DIR => 'untarred';
use constant DIFF_CMD => 'diff';
-use constant WGET_CMD => 'wget';
sub usage {
print STDERR "\n@_\n\n" if @_;
-d/--diff Display file differences using diff(1), rather than just
listing which files have changed.
- The diff(1) command is assumed to be in your PATH.
--diffopts Options to pass to the diff command. Defaults to '-u'.
Must be run from the root of the perl source tree.
Module names must match the keys of %Modules in Maintainers.pl.
+
+The diff(1) command is assumed to be in your PATH and is used to diff files
+regardless of whether the --diff option has been chosen to display any file
+differences.
HERE
exit(1);
}
'x|crosscheck' => \$do_crosscheck,
) or usage;
+ @wanted_upstreams = map { $_ eq 'undef' ? undef : $_ } @wanted_upstreams;
+
my @modules;
usage("Cannot mix -a with module list") if $scan_all && @ARGV;
}
if ( defined $cache_dir ) {
- die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir;
+ die "ERROR: not a directory: '$cache_dir'\n"
+ if !-d $cache_dir && -e $cache_dir;
+ File::Path::mkpath($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 $test_file = "modules/03modlist.data.gz";
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, $mirror_url, $force, \@modules );
+ do_crosscheck(
+ $outfh, $cache_dir, $mirror_url,
+ $force, \@modules, \@wanted_upstreams
+ );
}
else {
do_compare(
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 = "authors/id/$1/$1$2/$distribution";
+ return cpan_url( $mirror_url, $path );
+}
+
# compare a list of modules against their CPAN equivalents
sub do_compare {
warn "WARNING: duplicate entry for $dist in $module\n";
}
- my $upstream = $m->{UPSTREAM} || 'UNKNOWN';
+ my $upstream = $m->{UPSTREAM};
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";
+ . ( $m->{UPSTREAM} // 'UNKNOWN!' ) . "\n";
my $cpan_dir;
eval {
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);
my $different =
file_diff( $outfh, $abs_cpan_file, $mapped_file, $reverse,
$diff_opts );
if ( $different && customized( $m, $relative_mapped_file ) ) {
- if ($verbose) {
- print $outfh " Customized: $relative_mapped_file\n";
+ if (! $use_diff ) {
+ print $outfh " Customized for blead: $relative_mapped_file\n";
}
}
elsif ($different) {
}
}
+ 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) {
if ( $cpan_file eq $relative_mapped_file ) {
print $outfh " Unchanged: $cpan_file\n";
}
}
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 {
# Maintainers.pl
sub do_crosscheck {
- my ( $outfh, $cache_dir, $mirror_url, $force, $modules ) = @_;
+ my (
+ $outfh, $cache_dir, $mirror_url,
+ $force, $modules, $wanted_upstreams,
+ ) = @_;
my $file = '02packages.details.txt';
my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 );
my $pdist = $m->{DISTRIBUTION};
die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist;
+ my $upstream = $m->{UPSTREAM};
+ next if @$wanted_upstreams and !( $upstream ~~ $wanted_upstreams );
+
my $cdist = $modules{$module};
( my $short_pdist = $pdist ) =~ s{^.*/}{};
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};
}
}
if ( -f $download_file and !-s $download_file ) {
- # wget can leave a zero-length file on failed download
+ # failed download might leave a zero-length file
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";
-
- 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";
}
my $path = catfile( $untar_dir, $filename );
$path =~ s/\.tar\.gz$//
+ or $path =~ s/\.tgz$//
or $path =~ s/\.zip$//
or die
"ERROR: downloaded file does not have a recognised suffix: $path\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;
https://perl5.git.perl.org / perl5.git / blobdiff