Script to help out upgrading a cpan/ distro.

This one is not complete yet, and its portability can be much improved.
But it helps me out right now, and it wouldn't be fair to keep it all to
myself.

1 files changed, 262 insertions, 0 deletions

diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan
new file mode 100755
index 0000000000..93d1a7ec75
--- /dev/null
+++ b/Porting/sync-with-cpan
@@ -0,0 +1,262 @@
+#!/usr/bin/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
+#
+
+use 5.010;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+$| = 1;
+
+die "This does not like top level directory"
+     unless -d "cpan" && -d "Porting";
+
+package Maintainers;
+
+our @IGNORABLE;
+our %Modules;
+
+use autodie;
+
+require "Porting/Maintainers.pl";
+
+chdir "cpan";
+
+my %IGNORABLE    = map {$_ => 1} @IGNORABLE;
+
+my $package      = "02packages.details.txt";
+my $package_url  = "http://www.cpan.org/modules/$package";
+my $package_file = "/tmp/$package";
+
+#
+# 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;
+
+my ($module) = @ARGV;
+
+my  $info         = $Modules {$module} or die "Cannot find module $module";
+my  $distribution = $$info {DISTRIBUTION};
+my  $pkg_dir      = $$info {FILES};
+    $pkg_dir      =~ s!.*/!!;
+
+my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
+
+my  $o_module     = $module;
+if ($module =~ /-/ && $module !~ /::/) {
+    $module =~ 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  $old_dir      = "$pkg_dir-$old_version";
+my  $new_dir      = "$pkg_dir-$new_version";
+
+say "Cleaning out old directory";
+system git => 'clean', '-dfxq', $pkg_dir;
+
+
+
+my $url = "http://search.cpan.org/CPAN/authors/id/$new_path";
+
+say "Fetching $url";
+
+#
+# Fetch the new distro
+#
+system wget => $url, '-qO', $new_file;
+
+say "Unpacking $new_file";
+
+system tar => 'xfz', $new_file;
+
+say "Renaming directories";
+rename $pkg_dir => $old_dir;
+rename $new_dir => $pkg_dir;
+
+
+if (-f "$old_dir/.gitignore") {
+    say "Restoring .gitignore";
+    system git => 'checkout', "$pkg_dir/.gitignore";
+}
+
+my @new_files = `find $pkg_dir`;
+chomp @new_files;
+@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;
+@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.
+    next if $old_files {$file};    # It's already there.
+    if ($IGNORABLE {$file}) {
+        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 -d "$old_dir/$file";
+    next if $new_files {$file};
+    push @gone => $file;
+}
+if (-d "$pkg_dir/t") {
+    push @exec => `find "$pkg_dir/t" -type f -perm +111`;
+}
+chomp @exec;
+
+#
+# No need to change the +x bit on files that will be deleted.
+#
+if (@exec && @delete) {
+    my %delete = map {"$pkg_dir/$_" => 1} @delete;
+    @exec = grep {!$delete {$_}} @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;
+
+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;
+
+if (@commit) {
+    say "Fixing MANIFEST";
+    my $MANIFEST      = "../MANIFEST";
+    my $MANIFEST_SORT = "$MANIFEST.sorted";
+    open my $fh, ">>", $MANIFEST;
+    say $fh, "cpan/$_" for @commit;
+    close $fh;
+    system perl => "Porting/manisort", '--output', $MANIFEST;
+    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";
+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.
+#
+print "About to clean up; hit return or abort (^C) "; <STDIN>;
+
+chdir "cpan";
+system rm => '-r', $old_dir;
+unlink $new_file;
+
+
+chdir "../t";
+print "Running tests in t/porting ";
+my @tests = `ls porting/*.t`;
+chomp @tests;
+my @failed;
+foreach my $t (@tests) {
+    my @not = `./perl -I../lib -I.. $t | grep ^not | grep -v "# TODO"`;
+    print @not ? '!' : '.';
+    push @failed => $t if @not;
+}
+print "\n";
+say "Failed tests: @failed" if @failed;
+
+
+print "Now you ought to run a make; make test ...\n";
+
+say "Do not forget to update Porting/Maintainers.pl before committing";
+say "$o_module is now version $new_version";
+
+
+__END__