-#!/usr/bin/perl
+#!/usr/bin/env perl
-#
-# Script to help out with syncing cpan distros.
-#
-# Does the following:
-# - Fetches the package list from CPAN. Finds the current version of
-# the given package.
-# - Downloads the relevant tarball; unpacks the tarball;.
-# - Clean out the old directory (git clean -dfx)
-# - Moves the old directory out of the way, moves the new directory in place.
-# - Restores any .gitignore file.
-# - Removes files from @IGNORE and EXCLUDED
-# - git add any new files.
-# - git rm any files that are gone.
-# - Remove the +x bit on files in t/
-# - Adds new files to MANIFEST
-# - Runs a "make" (assumes a configure has been run)
-# - Cleans up
-# - Runs the porting tests
-#
-# TODO: - Restore files from CUSTOMIZED
-# - Delete files from MANIFEST
-# - Update Porting/Maintainers.pl
-# - Run the tests for the package
-# - Optional, run a full test suite
-#
-# This is an initial version; no attempt has been made yet to make this
-# portable. It shells out instead of trying to find a Perl solution.
-# In particular, it assumes wget, git, tar, chmod, perl, make, and rm
-# to be available.
-#
-# Usage: perl Porting/sync-with-cpan <module>
-# where <module> is the name it appears in the %Modules hash
-# of Porting/Maintainers.pl
-#
+=head1 NAME
+
+Porting/sync-with-cpan - Synchronize with CPAN distributions
+
+=head1 SYNOPSIS
+
+ perl Porting/sync-with-cpan <module>
+
+where <module> is the name it appears in the C<%Modules> hash
+of F<Porting/Maintainers.pl>
+
+=head1 DESCRIPTION
+
+Script to help out with syncing cpan distros.
+
+Does the following:
+
+=over 4
+
+=item *
+
+Fetches the package list from CPAN. Finds the current version of the given
+package. [1]
+
+=item *
+
+Downloads the relevant tarball; unpacks the tarball. [1]
+
+=item *
+
+Clean out the old directory (C<git clean -dfx>)
+
+=item *
+
+Moves the old directory out of the way, moves the new directory in place.
+
+=item *
+
+Restores any F<.gitignore> file.
+
+=item *
+
+Removes files from C<@IGNORE> and C<EXCLUDED>
+
+=item *
+
+C<git add> any new files.
+
+=item *
+
+C<git rm> any files that are gone.
+
+=item *
+
+Remove the +x bit on files in F<t/>
+
+=item *
+
+Remove the +x bit on files that don't have it enabled in the current dir
+
+=item *
+
+Restore files mentioned in C<CUSTOMIZED>
+
+=item *
+
+Adds new files to F<MANIFEST>
+
+=item *
+
+Runs a C<make> (assumes a configure has been run)
+
+=item *
+
+Cleans up
+
+=item *
+
+Runs tests for the package
+
+=item *
+
+Runs the porting tests
+
+=back
+
+[1] If the C<--tarball> option is given, then CPAN is not consulted.
+C<--tarball> should be the path to the tarball; the version is extracted
+from the filename -- but can be overwritten by the C<--version> option.
+
+=head1 TODO
+
+=over 4
+
+=item *
+
+Delete files from F<MANIFEST>
+
+=item *
+
+Update F<Porting/Maintainers.pl>
+
+=item *
+
+Optional, run a full test suite
+
+=item *
+
+Handle complicated C<FILES>
+
+=back
+
+This is an initial version; no attempt has been made yet to make this
+portable. It shells out instead of trying to find a Perl solution.
+In particular, it assumes git, chmod, perl, and make
+to be available.
+
+=cut
+
+
+package Maintainers;
use 5.010;
use strict;
use warnings;
-no warnings 'syntax';
+use Getopt::Long;
+use Archive::Tar;
+use File::Path qw( remove_tree );
+use File::Find;
$| = 1;
-die "This does not like top level directory"
+die "This does not look like a top level directory"
unless -d "cpan" && -d "Porting";
-package Maintainers;
-
our @IGNORABLE;
our %Modules;
require "Porting/Maintainers.pl";
-chdir "cpan";
-
my %IGNORABLE = map {$_ => 1} @IGNORABLE;
+my $tmpdir= $ENV{ TEMP } // '/tmp';
+
my $package = "02packages.details.txt";
my $package_url = "http://www.cpan.org/modules/$package";
-my $package_file = "/tmp/$package";
+my $package_file = "$tmpdir/$package"; # this is a cache
+
+my @problematic = (
+ 'podlators', # weird CUSTOMIZED section due to .PL files
+);
-#
-# Poor man's cache
-#
-unless (-f $package_file && -M $package_file < 1) {
- system wget => $package_url, '-qO', $package_file;
-}
-die "Usage: $0 module" unless @ARGV == 1;
+GetOptions ('tarball=s' => \my $tarball,
+ 'version=s' => \my $version,
+ force => \my $force,)
+ or die "Failed to parse arguments";
+
+die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
+
+sub find_type_f {
+ my @res;
+ find( { no_chdir => 1, wanted => sub {
+ my $file= $File::Find::name;
+ return unless -f $file;
+ push @res, $file
+ }}, @_ );
+ @res
+};
+
+my ($module) = shift;
+my $cpan_mod = @ARGV ? shift : $module;
-my ($module) = @ARGV;
my $info = $Modules {$module} or die "Cannot find module $module";
my $distribution = $$info {DISTRIBUTION};
-my $pkg_dir = $$info {FILES};
+
+my @files = glob $$info {FILES};
+if (!-d $files [0] || grep { $_ eq $module } @problematic) {
+ say "This looks like a setup $0 cannot handle (yet)";
+ unless ($force) {
+ say "Will not continue without a --force option";
+ exit 1;
+ }
+ say "--force is in effect, so we'll soldier on. Wish me luck!";
+}
+
+
+chdir "cpan";
+
+my $pkg_dir = $files[0];
$pkg_dir =~ s!.*/!!;
my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
my $o_module = $module;
-if ($module =~ /-/ && $module !~ /::/) {
- $module =~ s/-/::/g;
+if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) {
+ $cpan_mod =~ s/-/::/g;
}
#
# Find the information from CPAN.
#
-my $new_line = `grep '^$module ' $package_file`
- or die "Cannot find $module on CPAN\n";
-chomp $new_line;
-my (undef, $new_version, $new_path) = split ' ', $new_line;
-my $new_file = (split '/', $new_path) [-1];
+my $new_file;
+my $new_version;
+unless ($tarball) {
+ #
+ # 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;
+ }
+
+ my $new_line = `grep '^$cpan_mod ' $package_file`
+ or die "Cannot find $cpan_mod on CPAN\n";
+ chomp $new_line;
+ (undef, $new_version, my $new_path) = split ' ', $new_line;
+ if (defined $version) {
+ $new_path =~ s/-$new_version\./-$version\./;
+ $new_version = $version;
+ }
+ $new_file = (split '/', $new_path) [-1];
+
+ my $url = "http://search.cpan.org/CPAN/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._]+)\.tar\.gz/) [0];
+}
my $old_dir = "$pkg_dir-$old_version";
-my $new_dir = "$pkg_dir-$new_version";
say "Cleaning out old directory";
system git => 'clean', '-dfxq', $pkg_dir;
+say "Unpacking $new_file";
+Archive::Tar->extract_archive( $new_file );
+(my $new_dir = $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);
+ utime($t,$t,$file);
+};
-my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
+say "Renaming directories";
+rename $pkg_dir => $old_dir;
-say "Fetching $url";
+say "Creating new package directory";
+mkdir $pkg_dir;
-#
-# Fetch the new distro
-#
-system wget => $url, '-qO', $new_file;
+say "Populating new package directory";
+my $map = $$info {MAP};
+my @EXCLUDED_QR;
+my %EXCLUDED_QQ;
+if ($$info {EXCLUDED}) {
+ foreach my $entry (@{$$info {EXCLUDED}}) {
+ if (ref $entry) {push @EXCLUDED_QR => $entry}
+ else {$EXCLUDED_QQ {$entry} = 1}
+ }
+}
-say "Unpacking $new_file";
+FILE: for my $file ( find_type_f( $new_dir )) {
+ my $old_file = $file;
+ $file =~ s{^$new_dir/}{};
-system tar => 'xfz', $new_file;
+ next if $EXCLUDED_QQ{$file};
+ for my $qr (@EXCLUDED_QR) {
+ next FILE if $file =~ $qr;
+ }
-say "Renaming directories";
-rename $pkg_dir => $old_dir;
-rename $new_dir => $pkg_dir;
+ if ( $map ) {
+ for my $key ( sort { length $b <=> length $a } keys %$map ) {
+ my $val = $map->{$key};
+ last if $file =~ s/^$key/$val/;
+ }
+ }
+ else {
+ $file = $files[0] . '/' . $file;
+ }
+
+ if ( $file =~ m{^cpan/} ) {
+ $file =~ s{^cpan/}{};
+ }
+ else {
+ $file = '../' . $file;
+ }
+ my $prefix = '';
+ my @parts = split '/', $file;
+ pop @parts;
+ for my $part (@parts) {
+ $prefix .= '/' if $prefix;
+ $prefix .= $part;
+ mkdir $prefix unless -d $prefix;
+ }
+
+ rename $old_file => $file;
+}
+remove_tree( $new_dir );
if (-f "$old_dir/.gitignore") {
say "Restoring .gitignore";
system git => 'checkout', "$pkg_dir/.gitignore";
}
-my @new_files = `find $pkg_dir`;
-chomp @new_files;
+my @new_files = find_type_f( $pkg_dir );
@new_files = grep {$_ ne $pkg_dir} @new_files;
s!^[^/]+/!! for @new_files;
my %new_files = map {$_ => 1} @new_files;
-my @old_files = `find $old_dir`;
-chomp @old_files;
+my @old_files = find_type_f( $old_dir );
@old_files = grep {$_ ne $old_dir} @old_files;
s!^[^/]+/!! for @old_files;
my %old_files = map {$_ => 1} @old_files;
-#
-# Find files that can be deleted.
-#
-my @EXCLUDED_QR;
-my %EXCLUDED_QQ;
-if ($$info {EXCLUDED}) {
- foreach my $entry (@{$$info {EXCLUDED}}) {
- if (ref $entry) {push @EXCLUDED_QR => $entry}
- else {$EXCLUDED_QQ {$entry} = 1}
- }
-}
-
my @delete;
my @commit;
my @gone;
-my @exec;
FILE:
foreach my $file (@new_files) {
next if -d "$pkg_dir/$file"; # Ignore directories.
push @delete => $file;
next;
}
- if ($EXCLUDED_QQ {$file}) {
- push @delete => $file;
- next;
- }
- foreach my $pattern (@EXCLUDED_QR) {
- if ($file =~ /$pattern/) {
- push @delete => $file;
- next FILE;
- }
- }
push @commit => $file;
}
foreach my $file (@old_files) {
next if $new_files {$file};
push @gone => $file;
}
-if (-d "$pkg_dir/t") {
- push @exec => `find "$pkg_dir/t" -type f -perm +111`;
+
+#
+# Find all files with an exec bit
+#
+my @exec = find_type_f( $pkg_dir );
+my @de_exec;
+foreach my $file (@exec) {
+ # Remove leading dir
+ $file =~ s!^[^/]+/!!;
+ if ($file =~ m!^t/!) {
+ push @de_exec => $file;
+ next;
+ }
+ # Check to see if the file exists; if it doesn't and doesn't have
+ # the exec bit, remove it.
+ if ($old_files {$file}) {
+ unless (-x "$old_dir/$file") {
+ push @de_exec => $file;
+ }
+ }
}
-chomp @exec;
#
# No need to change the +x bit on files that will be deleted.
#
-if (@exec && @delete) {
+if (@de_exec && @delete) {
my %delete = map {+"$pkg_dir/$_" => 1} @delete;
- @exec = grep {!$delete {$_}} @exec;
+ @de_exec = grep {!$delete {$_}} @de_exec;
}
say "unlink $pkg_dir/$_" for @delete;
say "git add $pkg_dir/$_" for @commit;
say "git rm -f $pkg_dir/$_" for @gone;
-say "chmod a-x $_" for @exec;
+say "chmod a-x $pkg_dir/$_" for @de_exec;
print "Hit return to continue; ^C to abort "; <STDIN>;
unlink "$pkg_dir/$_" for @delete;
system git => 'add', "$pkg_dir/$_" for @commit;
system git => 'rm', '-f', "$pkg_dir/$_" for @gone;
-system chmod => 'a-x', $_ for @exec;
+system chmod => 'a-x', "$pkg_dir/$_" for @de_exec;
+
+#
+# Restore anything that is customized.
+# We don't really care whether we've deleted the file - since we
+# do a git restore, it's going to be resurrected if necessary.
+#
+if ($$info {CUSTOMIZED}) {
+ say "Restoring customized files";
+ foreach my $file (@{$$info {CUSTOMIZED}}) {
+ system git => "checkout", "$pkg_dir/$file";
+ }
+}
+chdir "..";
if (@commit) {
say "Fixing MANIFEST";
- my $MANIFEST = "../MANIFEST";
+ my $MANIFEST = "MANIFEST";
my $MANIFEST_SORT = "$MANIFEST.sorted";
open my $fh, ">>", $MANIFEST;
- say $fh, "cpan/$_" for @commit;
+ say $fh "cpan/$pkg_dir/$_" for @commit;
close $fh;
- system perl => "Porting/manisort", '--output', $MANIFEST;
+ system perl => "Porting/manisort", '--output', $MANIFEST_SORT;
rename $MANIFEST_SORT => $MANIFEST;
}
-#
-# TODO:
-# - deal with +x bit
-# - update Porting/Maintainers.pl
-#
-
-
-chdir "..";
print "Running a make ... ";
-system "make > make.log 2>&1" and die "Running make failed, see make.log";
+system "$Config{make} > make.log 2>&1" and die "Running make failed, see make.log";
print "done\n";
#
# Must clean up, or else t/porting/FindExt.t will fail.
-# Note that we can always retrieve the orginal directory with a git checkout.
+# Note that we can always retrieve the original directory with a git checkout.
#
print "About to clean up; hit return or abort (^C) "; <STDIN>;
-chdir "cpan";
-system rm => '-r', $old_dir;
-unlink $new_file;
+remove_tree( "cpan/$old_dir" );
+unlink "cpan/$new_file" unless $tarball;
+
+#
+# Run the tests. First the test belonging to the module, followed by the
+# the tests in t/porting
+#
+chdir "t";
+say "Running module tests";
+my @test_files = grep { /\.t$/ } find_type_f( $pkg_dir );
+my $exe_dir= $^O =~ /MSWin/ ? "..\\" : './';
+my $output = `${exe_dir}perl$Config{_exe} TEST @test_files`;
+unless ($output =~ /All tests successful/) {
+ say $output;
+ exit 1;
+}
-chdir "../t";
print "Running tests in t/porting ";
-my @tests = `ls porting/*.t`;
+my @tests = glob 'porting/*.t';
chomp @tests;
my @failed;
foreach my $t (@tests) {
say "Failed tests: @failed" if @failed;
-print "Now you ought to run a make; make test ...\n";
+say "Attempting to update Maintainers.pl";
+chdir '..';
+
+open my $Maintainers_pl, '<', 'Porting/Maintainers.pl';
+open my $new_Maintainers_pl, '>', 'Maintainers.pl';
+
+my $found;
+my $in_mod_section;
+while (<$Maintainers_pl>) {
+ if (!$found) {
+ if ($in_mod_section) {
+ if (/DISTRIBUTION/) {
+ if (s/\Q$old_version/$new_version/) {
+ $found = 1;
+ }
+ }
+
+ if (/^ }/) {
+ $in_mod_section = 0;
+ }
+ }
+
+ if (/\Q$cpan_mod/) {
+ $in_mod_section = 1;
+ }
+ }
+
+ print $new_Maintainers_pl $_;
+}
+
+if ($found) {
+ unlink 'Porting/Maintainers.pl';
+ rename 'Maintainers.pl' => 'Porting/Maintainers.pl';
+ system chmod => 'a+x', 'Porting/Maintainers.pl';
+}
+else {
+ say "Could not update Porting/Maintainers.pl.";
+ say "Make sure you update this by hand before committing.";
+}
-say "Do not forget to update Porting/Maintainers.pl before committing";
say "$o_module is now version $new_version";
+say "Now you ought to run a make; make test ...";
__END__
https://perl5.git.perl.org / perl5.git / blobdiff