Add Porting/new-perldelta.pl, which automates adding a new perldelta.

Strictly, "mostly automates", as it doesn't run `git add`, or test that the
build is clean. However, it simplifies a gnarly step in the release manager's
guide, so it's progress.

1 files changed, 108 insertions, 0 deletions

diff --git a/Porting/new-perldelta.pl b/Porting/new-perldelta.pl
new file mode 100644
index 0000000000..4fa7fd13f2
--- /dev/null
+++ b/Porting/new-perldelta.pl
@@ -0,0 +1,108 @@
+#!/usr/bin/perl -w
+use strict;
+
+# This needs to be able to run from a clean checkout, hence assume only system
+# perl, which may be too old to have autodie
+
+require 'Porting/pod_lib.pl';
+
+my $state = get_pod_metadata(1);
+my (undef, $old_major, $old_minor) = @{$state->{delta_version}};
+# For now, hard code it for the simple ones...
+my $new_major = $old_major;
+my $new_minor = $old_minor + 1;
+# These two are just for "If you are upgrading from earlier releases..." in
+# the perldelta template.
+my $was_major = $old_major;
+my $was_minor = $old_minor - 1;
+# I may have missed some corner cases here:
+if ($was_minor < 0) {
+    $was_minor = 0;
+    --$was_major;
+}
+my $newdelta_filename = "perl5$new_major${new_minor}delta.pod";
+
+{
+    # For now, just tell the user what to add, as it's safer.
+    my %add;
+
+    sub git_add_new {
+        push @{$add{new}}, shift;
+    }
+
+    sub git_add_modified {
+        push @{$add{modified}}, shift;
+    }
+
+    sub notify_success {
+        return unless %add;
+        print "Please run:\n";
+        foreach (qw(new modified)) {
+            print "    git add @{$add{$_}}\n" if $add{$_};
+        }
+        print "\nBefore committing please check that the build works and make test_porting passes\n";
+    }
+}
+
+my $filename = 'pod/.gitignore';
+my $gitignore = slurp_or_die($filename);
+
+$gitignore =~ s{^/$state->{delta_target}$}
+               {/$newdelta_filename}m
+    or die "Can't find /$state->{delta_target} in $filename";
+
+write_or_die($filename, $gitignore);
+git_add_modified($filename);
+
+my $olddelta = slurp_or_die('pod/perldelta.pod');
+
+$olddelta =~ s{^(perl)(delta - what is new for perl v5.$old_major.$old_minor)$}
+              {$1 . "5$old_major$old_minor" . $2}me
+    or die "Can't find expected NAME contents in $olddelta";
+
+my $olddeltaname = "pod/perl5$old_major${old_minor}delta.pod";
+write_or_die($olddeltaname, $olddelta);
+git_add_new($olddeltaname);
+
+$filename = 'Porting/perldelta_template.pod';
+my $newdelta = slurp_or_die($filename);
+
+foreach([rXXX => $was_major],
+        [sXXX => $old_major],
+        [tXXX => $new_major],
+        [aXXX => $was_minor],
+        [bXXX => $old_minor],
+        [cXXX => $new_minor],
+        ['5XXX' => 5 . $old_major . $old_minor]) {
+    my ($token, $value) = @$_;
+    $newdelta =~ s/$token/$value/g
+        or die "Can't find '$token' in $filename";
+}
+
+write_or_die('pod/perldelta.pod', $newdelta);
+git_add_modified('pod/perldelta.pod');
+
+$filename = 'pod.lst';
+my $pod_master = slurp_or_die($filename);
+
+$pod_master =~ s{^(\s*perl5)($old_major$old_minor)(delta\s+Perl changes in version )(5\.\d+\.\d+)(.*)}
+    {$1 . $new_major . $new_minor .$3 . "5.$new_major.$new_minor" . $5 . "\n" .
+         "$1$2$3$4$5"}me
+    or die "Can't find perldelta line in $filename";
+
+write_or_die($filename, $pod_master);
+git_add_modified($filename);
+
+my $command = "$^X Porting/pod_rules.pl";
+system $command
+    and die "Could not run '$command', \$? = $?";
+git_add_modified(map {chomp $_; $_} `$^X Porting/pod_rules.pl --showfiles`);
+
+notify_success();
+
+# Local variables:
+# cperl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
+#
+# ex: set ts=8 sts=4 sw=4 et: