handle reading from a SVf_UTF8 scalar

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

diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan
index 2a43c8f..b90612f 100755 (executable)
--- a/Porting/sync-with-cpan
+++ b/Porting/sync-with-cpan
@@ -127,11 +127,10 @@ use 5.010;
 use strict;
 use warnings;
 use Getopt::Long;
-no  warnings 'syntax';
 
 $| = 1;
 
-die "This does not like top level directory"
+die "This does not look like a top level directory"
      unless -d "cpan" && -d "Porting";
 
 our @IGNORABLE;
@@ -147,6 +146,10 @@ my $package      = "02packages.details.txt";
 my $package_url  = "http://www.cpan.org/modules/$package";
 my $package_file = "/tmp/$package";
 
+my @problematic = (
+    'podlators', # weird CUSTOMIZED section due to .PL files
+);
+
 
 GetOptions ('tarball=s'  =>  \my $tarball,
             'version=s'  =>  \my $version,
@@ -163,7 +166,7 @@ my  $info         = $Modules {$module} or die "Cannot find module $module";
 my  $distribution = $$info {DISTRIBUTION};
 
 my @files         = glob $$info {FILES};
-if (@files != 1 || !-d $files [0] || $$info {MAP}) {
+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";
@@ -175,7 +178,7 @@ if (@files != 1 || !-d $files [0] || $$info {MAP}) {
 
 chdir "cpan";
 
-my  $pkg_dir      = $$info {FILES};
+my  $pkg_dir      = $files[0];
     $pkg_dir      =~ s!.*/!!;
 
 my ($old_version) = $distribution =~ /-([0-9.]+)\.tar\.gz/;
@@ -202,6 +205,10 @@ unless ($tarball) {
                      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";
@@ -217,7 +224,6 @@ else {
 }
 
 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;
@@ -225,11 +231,66 @@ system git => 'clean', '-dfxq', $pkg_dir;
 say "Unpacking $new_file";
 
 system tar => 'xfz', $new_file;
+(my $new_dir = $new_file) =~ s/\.tar\.gz//;
+# ensure 'make' will update all files
+system('find', $new_dir, '-exec', 'touch', '{}', ';');
 
 say "Renaming directories";
 rename $pkg_dir => $old_dir;
-rename $new_dir => $pkg_dir;
 
+say "Creating new package directory";
+mkdir $pkg_dir;
+
+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}
+    }
+}
+
+FILE: for my $file ( `find $new_dir -type f` ) {
+    chomp $file;
+    my $old_file = $file;
+    $file =~ s{^$new_dir/}{};
+
+    next if $EXCLUDED_QQ{$file};
+    for my $qr (@EXCLUDED_QR) {
+        next FILE if $file =~ $qr;
+    }
+
+    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;
+}
+system 'rm', '-rf', $new_dir;
 
 if (-f "$old_dir/.gitignore") {
     say "Restoring .gitignore";
@@ -248,18 +309,6 @@ chomp @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;
@@ -271,16 +320,6 @@ foreach my $file (@new_files) {
         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) {
@@ -398,10 +437,48 @@ print "\n";
 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__