=head1 SYNOPSIS
- perl Porting/sync-with-cpan <module>
+ sh ./Configure
+ perl Porting/sync-with-cpan <module>
where <module> is the name it appears in the C<%Modules> hash
of F<Porting/Maintainers.pl>
use warnings;
use Getopt::Long;
use Archive::Tar;
+use File::Basename qw( basename );
use File::Path qw( remove_tree );
use File::Find;
-use File::Spec::Functions qw( tmpdir );
+use File::Spec::Functions qw( tmpdir rel2abs );
use Config qw( %Config );
$| = 1;
+use constant WIN32 => $^O eq 'MSWin32';
+
die "This does not look like a top level directory"
unless -d "cpan" && -d "Porting";
+# Check that there's a Makefile, if needed; otherwise, we'll do most of our
+# work only to fail when we try to run make, and the user will have to
+# either unpick everything we've done, or do the rest manually.
+die "Please run Configure before using $0\n"
+ if !WIN32 && !-f "Makefile";
+
our @IGNORABLE;
our %Modules;
use autodie;
-require "Porting/Maintainers.pl";
+require "./Porting/Maintainers.pl";
my $MAKE_LOG = 'make.log';
# Equivalent of `chmod a-x`
sub de_exec {
- for my $filename ( @_ ) {
- my $mode= (stat $filename)[2] & 0777;
- if( $mode & 0111 ) { # exec-bit set
- chmod $mode & 0666, $filename;
- };
+ my ($filename) = @_;
+ my $mode = (stat $filename)[2] & 0777;
+ if ($mode & 0111) { # exec-bit set
+ chmod $mode & 0666, $filename;
+ }
+}
+
+# Equivalent of `chmod +w`
+sub make_writable {
+ my ($filename) = @_;
+ my $mode = (stat $filename)[2] & 0777;
+ if (!($mode & 0222)) { # not writable
+ chmod $mode | (0222 & ~umask), $filename;
}
}
sub make {
my @args= @_;
unshift @args, "-j$make_jobs" if defined $make_jobs;
- if( $^O eq 'MSWin32') {
+ if (WIN32) {
chdir "Win32";
system "$Config{make} @args> ..\\$MAKE_LOG 2>&1"
and die "Running make failed, see $MAKE_LOG";
my $info = $Modules{$module};
if (!$info) {
- # Maybe the user said "Test-Simple" instead of "Test::Simple". See if we
- # can fix it up.
- (my $guess = $module) =~ s/-/::/g;
- $info = $Modules{$guess}
- or die "Cannot find module $module";
+ # Maybe the user said "Test-Simple" instead of "Test::Simple", or
+ # "IO::Compress" instead of "IO-Compress". See if we can fix it up.
+ my $guess = $module;
+ s/-/::/g or s/::/-/g for $guess;
+ $info = $Modules{$guess} or die <<"EOF";
+Cannot find module $module.
+The available options are listed in the %Modules hash in Porting/Maintainers.pl
+EOF
say "Guessing you meant $guess instead of $module";
$module = $guess;
}
+if ($info->{CUSTOMIZED}) {
+ print <<"EOF";
+$module has a CUSTOMIZED entry in Porting/Maintainers.pl.
+
+This program's behaviour is to copy every CUSTOMIZED file into the version
+of the module being imported. But that might not be the right thing: in some
+cases, the new CPAN version will supersede whatever changes had previously
+been made in blead, so it would be better to import the new CPAN files.
+
+If you've checked that the CUSTOMIZED versions are still correct, you can
+proceed now. Otherwise, you should abort and investigate the situation. If
+the blead customizations are no longer needed, delete the CUSTOMIZED entry
+for $module in Porting/Maintainers.pl (and you'll also need to regenerate
+t/porting/customized.dat in that case; see t/porting/customized.t).
+
+EOF
+ print "Hit return to continue; ^C to abort "; <STDIN>;
+}
+
my $cpan_mod = @ARGV ? shift : $module;
my $distribution = $$info {DISTRIBUTION};
say "--force is in effect, so we'll soldier on. Wish me luck!";
}
+use Cwd 'cwd';
+my $orig_pwd = cwd();
chdir "cpan";
$cpan_mod =~ s/-/::/g;
}
+sub wget {
+ my ($url, $saveas) = @_;
+ eval {
+ require HTTP::Tiny;
+ my $http= HTTP::Tiny->new();
+ $http->mirror( $url => $saveas );
+ 1
+ } or
+ # Some system do not have wget. Fall back to curl if we do not
+ # have it. On Windows, `which wget` is not going to work, so
+ # just use wget, as this script has always done.
+ WIN32 || -x substr(`which wget`, 0, -1)
+ ? system wget => $url, '-qO', $saveas
+ : system curl => $url, '-sSo', $saveas;
+}
+
#
# Find the information from CPAN.
#
my $new_file;
my $new_version;
-unless ($tarball) {
+if (defined $tarball) {
+ $tarball = rel2abs( $tarball, $orig_pwd ) ;
+ die "Tarball $tarball does not exist\n" if !-e $tarball;
+ die "Tarball $tarball is not a plain file\n" if !-f _;
+ $new_file = $tarball;
+ $new_version = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0];
+ die "Blead and that tarball both have version $new_version of $module\n"
+ if $new_version eq $old_version;
+}
+else {
#
# Poor man's cache
#
unless (-f $package_file && -M $package_file < 1) {
- eval {
- require HTTP::Tiny;
- my $http= HTTP::Tiny->new();
- $http->mirror( $package_url => $package_file );
- 1
- } or system wget => $package_url, '-qO', $package_file;
+ wget $package_url, $package_file;
}
open my $fh, '<', $package_file;
}
$new_file = (split '/', $new_path) [-1];
- my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
+ die "The latest version of $module is $new_version, but blead already has it\n"
+ if $new_version eq $old_version;
+
+ my $url = "https://cpan.metacpan.org/authors/id/$new_path";
say "Fetching $url";
#
# Fetch the new distro
#
- eval {
- require HTTP::Tiny;
- my $http= HTTP::Tiny->new();
- $http->mirror( $url => $new_file );
- 1
- } or system wget => $url, '-qO', $new_file;
-}
-else {
- $new_file = $tarball;
- $new_version = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0];
+ wget $url, $new_file;
}
my $old_dir = "$pkg_dir-$old_version";
say "Unpacking $new_file";
Archive::Tar->extract_archive( $new_file );
-(my $new_dir = $new_file) =~ s/\.tar\.gz//;
+(my $new_dir = basename($new_file)) =~ s/\.tar\.gz//;
# ensure 'make' will update all files
my $t= time;
for my $file (find_type_f($new_dir)) {
- open(my $fh,'>>',$file) || die "Cannot write $file:$!";
- close($fh);
+ make_writable($file); # for convenience if the user later edits it
utime($t,$t,$file);
};
@de_exec = grep {!$delete {$_}} @de_exec;
}
+#
+# Mustn't change the +x bit on files that are whitelisted
+#
+if (@de_exec) {
+ my %permitted = map { (my $x = $_) =~ tr/\n//d; $x => 1 } grep !/^#/,
+ do { local @ARGV = '../Porting/exec-bit.txt'; <> };
+ @de_exec = grep !$permitted{"cpan/$pkg_dir/$_"}, @de_exec;
+}
+
say "unlink $pkg_dir/$_" for @delete;
say "git add $pkg_dir/$_" for @commit;
say "git rm -f $pkg_dir/$_" for @gone;
# repeatedly.
if (@commit || @gone) {
say "Running regen/lib_cleanup.pl to handle potential added/deleted dirs";
- my $exe_dir = $^O eq 'MSWin32' ? ".\\" : './';
+ my $exe_dir = WIN32 ? ".\\" : './';
system "${exe_dir}perl$Config{_exe}", "-Ilib", "regen/lib_cleanup.pl"
and die "regen/lib_cleanup.pl failed\n";
}
chdir "t";
say "Running module tests";
my @test_files = grep { /\.t$/ } find_type_f( "../cpan/$pkg_dir" );
-my $exe_dir= $^O =~ /MSWin/ ? "..\\" : './';
+my $exe_dir = WIN32 ? "..\\" : './';
my $output = `${exe_dir}perl$Config{_exe} TEST @test_files`;
unless ($output =~ /All tests successful/) {
say $output;
}
}
- if (/^ }/) {
+ if (/^ \}/) {
$in_mod_section = 0;
}
}
- if (/\Q$cpan_mod/) {
+ if (/\Q$module/) {
$in_mod_section = 1;
}
}
https://perl5.git.perl.org / perl5.git / blobdiff