[MERGE] release management checklist maker

The Release Manager's Guide is a complicated document that must accurately
describe how to prepare all four possible types of release. This makes it
hard to use as the basis for a checklist: for any given type of release, it
must list some steps in the wrong order, and list some steps that mustn't in
fact be taken at all.

We do have a porting tool that prepares a release checklist from the RMG for
a given release type. This set of changes, largely written by Sawyer++,
modifies that tool so that its output lists only the desired steps.

2 files changed, 165 insertions, 96 deletions

diff --git a/Porting/make-rmg-checklist b/Porting/make-rmg-checklist
index e25186c85e..e4a810d36f 100644
--- a/Porting/make-rmg-checklist
+++ b/Porting/make-rmg-checklist
@@ -1,145 +1,214 @@
-#!perl
+#!/usr/bin/perl
 use strict;
 use warnings;
-use autodie;
+use Getopt::Long qw< :config no_ignore_case >;
 
-use Getopt::Long;
-use Pod::Simple::HTML;
+sub pod {
+    my $filename = shift;
 
-sub main {
-    my ( $help, $type, $html );
-    GetOptions(
-        'type:s' => \$type,
-        'html'   => \$html,
-        'help'   => \$help,
-    );
+    open my $fh, '<', 'Porting/release_managers_guide.pod'
+        or die "Cannot open file: $!\n";
 
-    if ($help) {
-        print <<'EOF';
-make-rmg-checklist [--type TYPE]
+    my @lines = <$fh>;
+
+    close $fh
+        or die "Cannot close file: $!\n";
+
+    return \@lines;
+}
+
+sub _help {
+    my $msg = shift;
+    if ($msg) {
+        print "Error: $msg\n\n";
+    }
+
+    print << "_END_HELP";
+$0 --version VERSION
 
 This script creates a release checklist as a simple HTML document. It accepts
 the following arguments:
 
-  --type    The release type for the checklist. This can be BLEAD-FINAL,
-            BLEAD-POINT, MAINT, or RC. This defaults to BLEAD-POINT.
+  --version     The version you are working on. This will infer the type
+                of release you want to have
 
-  --html    Output HTML instead of POD
+  --html        Output HTML instead of POD
+_END_HELP
 
-EOF
+    exit;
+}
 
-        exit;
-    }
+sub _type_from_version {
+    my $version = shift;
 
-    $type = _validate_type($type);
+    # 5.26.0      = BLEAD-FINAL
+    # 5.26.0-RC1  = RC
+    # 5.26.1      = MAINT
+    # 5.27.0      = BLEAD-POINT
+    # 5.27.1      = BLEAD-POINT
+    $version =~ m{^ 5\. (\d{1,2}) \. (\d{1,2}) (?: -RC(\d) )? $}xms
+        or die "Version must be 5.x.y or 5.x.y-RC#\n";
 
-    open my $fh, '<', 'Porting/release_managers_guide.pod';
-    my $pod = do { local $/; <$fh> };
-    close $fh;
+    my ( $major, $minor, $rc ) = ( $1, $2, $3 );
 
-    my $heads = _parse_rmg( $pod, $type );
-    my $new_pod = _munge_pod( $pod, $heads );
+    # Dev release
+    if ( $major % 2 != 0 ) {
+        defined $rc
+            and die "Cannot have BLEAD-POINT RC release\n";
 
-    if ($html) {
-        my $simple = Pod::Simple::HTML->new();
-        $simple->output_fh(*STDOUT);
-        $simple->parse_string_document($new_pod);
+        return 'BLEAD-POINT';
     }
-    else {
-        print $new_pod;
-    }
-}
 
-sub _validate_type {
-    my $type = shift || 'BLEAD-POINT';
+    defined $rc
+        and return 'RC';
 
-    my @valid = qw( BLEAD-FINAL BLEAD-POINT MAINT RC );
-    my %valid = map { $_ => 1 } @valid;
+    return $minor == 0 ? 'BLEAD-FINAL' : 'MAINT';
+}
 
-    unless ( $valid{ uc $type } ) {
-        my $err
-            = "The type you provided ($type) is not a valid release type. It must be one of ";
-        $err .= join ', ', @valid;
-        $err .= "\n";
+sub iterate_items {
+    my ( $items, $type, $cb ) = @_;
 
-        die $err;
-    }
+    ITEM:
+    foreach my $item ( @{$items} ) {
+        foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
+            if ( $meta =~ /skip .+ $type/xms ) {
+                next ITEM;
+            }
+            elsif ( $meta =~ /skip/xms ) {
+                $item->{content} =~
+                    s/^ [^\n]* \b MUST\ SKIP\ this\ step \b [^\n]* \n\n//xms;
+            }
+        }
 
-    return $type;
+        $cb->($item);
+    }
 }
 
-sub _parse_rmg {
-    my $pod  = shift;
-    my $type = shift;
+sub create_checklist {
+    my ( $type, $items ) = @_;
+
+    my $collect;
+    my $prev_head = 0;
+    my $over_level;
+    iterate_items( $items, $type, sub {
+        my $item = shift;
 
-    my @heads;
-    my $include = 0;
-    my %skip;
+        foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
+            $meta =~ /checklist \s+ begin/xmsi
+                and $collect = 1;
+
+            $meta =~ /checklist \s+ end/xmsi
+                and $collect = 0;
 
-    for ( split /\n/, $pod ) {
-        if (/^=for checklist begin/) {
-            $include = 1;
-            next;
         }
 
-        next unless $include;
+        $collect
+            or return;
 
-        last if /^=for checklist end/;
+        $over_level = ( $item->{'head'} - 1 ) * 4;
 
-        if (/^=for checklist skip (.+)/) {
-            %skip = map { $_ => 1 } split / /, $1;
-            next;
-        }
+        print $prev_head < $item->{'head'} ? "=over $over_level\n\n"
+            : $prev_head > $item->{'head'} ? "=back\n\n"
+            :                                '';
 
-        if (/^=head(\d) (.+)/) {
-            unless ( keys %skip && $skip{$type} ) {
-                push @heads, [ $1, $2 ];
-            }
+        chomp( my $name = $item->{'name'} );
+        print "=item * L<< /$name >>\n\n";
 
-            %skip = ();
-        }
-    }
+        $prev_head = $item->{'head'};
+    });
 
-    return \@heads;
+    print "=back\n\n" x ( $over_level / 4 );
 }
 
-sub _munge_pod {
-    my $pod   = shift;
-    my $heads = shift;
+my ($version, $html);
+GetOptions(
+    'version|v=s' => \$version,
+    'html'        => \$html,
+    'help|h'      => sub { _help(); },
+);
+
+defined $version
+    or _help('You must provide a version number');
+
+my $pod_output = '';
+if ($html) {
+    require Pod::Simple::HTML;
+    open my $fh, '>', \$pod_output
+        or die "Can't create fh to string: $!\n";
+    select $fh;
+}
 
-    $pod =~ s/=head1 NAME.+?(=head1 SYNOPSIS)/$1/s;
+my $type = _type_from_version($version);
 
-    my $new_pod = <<'EOF';
-=head1 NAME
+chomp( my @pod_lines = @{ pod() } );
 
-Release Manager's Guide with Checklist
+my ( @items, $current_element, @leading_attrs );
+my $skip_headers     = qr/^=encoding/xms;
+my $passthru_headers = qr/^= (?: over | item | back | cut )/xms;
 
-=head2 Checklist
+foreach my $line (@pod_lines) {
+    $line =~ $skip_headers
+        and next;
 
-EOF
+    if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) {
+        my ( $head_num, $head_title ) = ( $1, $2 );
 
-    my $last_level = 0;
-    for my $head ( @{$heads} ) {
-        my $level = $head->[0] - 1;
+        my $elem = {
+            'head' => $head_num,
+            'name' => $head_title,
+        };
 
-        if ( $level > $last_level ) {
-            $new_pod .= '=over ' . $level * 4;
-            $new_pod .= "\n\n";
-        }
-        elsif ( $level < $last_level ) {
-            $new_pod .= "=back\n\n" for 1 .. ( $last_level - $level );
+        if (@leading_attrs) {
+            $elem->{'metadata'} = [ @leading_attrs ];
+            @leading_attrs = ();
         }
 
-        $new_pod .= '=item * ' . 'L<< /' . $head->[1] . " >>\n\n";
+        $current_element = $elem;
+        push @items, $elem;
 
-        $last_level = $level;
+        next;
     }
 
-    $new_pod .= "=back\n\n" while $last_level--;
+    if ( $line =~ /^ =for \s+ (.+) $ /xms ) {
+        push @leading_attrs, $1;
+        next;
+    }
 
-    $new_pod .= $pod;
+    $line =~ $passthru_headers
+        or length $line == 0 # allow empty lines
+        or $line =~ /^[^=]/xms
+        or die "Cannot recognize line: '$line'\n";
 
-    return $new_pod;
+    $current_element->{'content'} .= "\n" . $line;
 }
 
-main();
+print << "_END_BEGINNING";
+=head1 NAME
+
+Release Manager's Guide with Checklist for $version ($type)
+
+=head2 Checklist
+
+_END_BEGINNING
+
+# Remove beginning
+# This can also be done with a '=for introduction' in the future
+$items[0]{'name'} =~ /^NAME/xmsi
+    and shift @items;
+
+$items[0]{'name'} =~ /^MAKING \s+ A \s+ CHECKLIST/xmsi
+    and shift @items;
+
+create_checklist( $type, \@items );
+
+iterate_items( \@items, $type, sub {
+    my $item = shift;
+    print "=head$item->{'head'} $item->{'name'}";
+    print "$item->{'content'}\n";
+} );
+
+if ($html) {
+    my $simple = Pod::Simple::HTML->new;
+    $simple->output_fh(*STDOUT);
+    $simple->parse_string_document($pod_output);
+}
diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod
index 9f8004c7e0..35ac652f65 100644
--- a/Porting/release_managers_guide.pod
+++ b/Porting/release_managers_guide.pod
@@ -16,13 +16,13 @@ document that starts with a checklist for your release.
 This script is run as:
 
     perl Porting/make-rmg-checklist \
-        --type [BLEAD-POINT or MAINT or ...] > /tmp/rmg.pod
+        --version [5.x.y-RC#] > /tmp/rmg.pod
 
 You can also pass the C<--html> flag to generate an HTML document instead of
 POD.
 
     perl Porting/make-rmg-checklist --html \
-        --type [BLEAD-POINT or MAINT or ...] > /tmp/rmg.html
+        --version [5.x.y-RC#] > /tmp/rmg.html
 
 =head1 SYNOPSIS