Disambiguate map { }

[perl5.git] / Porting / sync-with-cpan

#!/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__