From 705821546fe3db90097b481dbcc726b8db12cac8 Mon Sep 17 00:00:00 2001
From: Sawyer X <xsawyerx@cpan.org>
Date: Sun, 14 May 2017 12:24:07 +0200
Subject: [PATCH] Replace Release Managers Guide (RMG) with new version:

Many of the mistakes made by me during a release has to do with the
confusing instructions in the guide.

* Some steps are mentioned in different order
* Some steps are mentioned (and noted to *NOT* do)
* The confusion between "MAINT" and "BLEAD-FINAL", and "BLEAD-FINAL"
  and "BLEAD-POINT".

This generator generates a checklist with only the instruction you
*will* have to perform. Any steps that mentions they must be skipped
for the release will not be included in the end-result.

Unlike the previous guide, you need not know the type of the release
you do. Instead, you give the version you want to release and it
generates the appropriate one for you.

All the following incantations work:

    perl Porting/make-rmg-checklist --version 5.26.0-RC2 # RC
    perl Porting/make-rmg-checklist --version 5.26.0     # BLEAD-FINAL
    perl Porting/make-rmg-checklist --version 5.27.0     # BLEAD-POINT
    perl Porting/make-rmg-checklist --version 5.27.1     # BLEAD-POINT
    perl Porting/make-rmg-checklist --version 5.26.1     # MAINT

Extra benefit: Apparently it includes additional checklist steps
at the top that somehow are not included when you currently generate.

Downside: HTML is not yet supported.
---
 Porting/make-rmg-checklist         | 239 ++++++++++++++++++++++---------------
 Porting/release_managers_guide.pod |   8 +-
 2 files changed, 146 insertions(+), 101 deletions(-)

diff --git a/Porting/make-rmg-checklist b/Porting/make-rmg-checklist
index e25186c..d7a9bc4 100644
--- a/Porting/make-rmg-checklist
+++ b/Porting/make-rmg-checklist
@@ -1,145 +1,196 @@
-#!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
+                (Not supported at the moment)
+_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);
-    }
-    else {
-        print $new_pod;
+        return 'BLEAD-POINT';
     }
-}
 
-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'} || [] } ) {
+            $meta =~ /skip .+ $type/xms
+                and next ITEM;
+        }
 
-    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);
+GetOptions(
+    'version|v=s' => \$version,
+    'html'        => sub { _help('HTML is not supported at the moment'); },
+    'help|h'      => sub { _help(); },
+);
 
-    $pod =~ s/=head1 NAME.+?(=head1 SYNOPSIS)/$1/s;
+defined $version
+    or _help('You must provide a version number');
 
-    my $new_pod = <<'EOF';
-=head1 NAME
+my $type = _type_from_version($version);
 
-Release Manager's Guide with Checklist
+chomp( my @pod_lines = @{ pod() } );
 
-=head2 Checklist
+my ( @items, $current_element, @leading_attrs );
+my $skip_headers     = qr/^=encoding/xms;
+my $passthru_headers = qr/^= (?: over | item | back | cut )/xms;
 
-EOF
+foreach my $line (@pod_lines) {
+    $line =~ $skip_headers
+        and next;
 
-    my $last_level = 0;
-    for my $head ( @{$heads} ) {
-        my $level = $head->[0] - 1;
+    if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) {
+        my ( $head_num, $head_title ) = ( $1, $2 );
 
-        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 );
+        my $elem = {
+            'head' => $head_num,
+            'name' => $head_title,
+        };
+
+        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";
+} );
diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod
index 9f8004c..30e089f 100644
--- a/Porting/release_managers_guide.pod
+++ b/Porting/release_managers_guide.pod
@@ -16,13 +16,7 @@ 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
-
-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.pod
 
 =head1 SYNOPSIS
 
-- 
2.7.4

From 65fc826e7d7b8c0d1ca1b0b31485f5faa6913eca Mon Sep 17 00:00:00 2001
From: Aaron Crane <arc@cpan.org>
Date: Sun, 9 Jul 2017 13:54:26 +0100
Subject: [PATCH 1/2] Suppress irrelevant "MUST SKIP this step" RMG paragraphs

Sections that aren't relevant to the current release type are suppressed in
their entirety, so the remaining "MUST SKIP" messages are just confusing.
Remove them from the content.
---
 Porting/make-rmg-checklist | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/Porting/make-rmg-checklist b/Porting/make-rmg-checklist
index d7a9bc4938..f116d23471 100644
--- a/Porting/make-rmg-checklist
+++ b/Porting/make-rmg-checklist
@@ -72,8 +72,13 @@ sub iterate_items {
     ITEM:
     foreach my $item ( @{$items} ) {
         foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
-            $meta =~ /skip .+ $type/xms
-                and next ITEM;
+            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;
+            }
         }
 
         $cb->($item);
-- 
2.12.2

From eb938745842d0953bb3861e08451bfceca8f2731 Mon Sep 17 00:00:00 2001
From: Aaron Crane <arc@cpan.org>
Date: Sun, 9 Jul 2017 14:01:54 +0100
Subject: [PATCH 2/2] Restore Porting/make-rmg-checklist --html option

---
 Porting/make-rmg-checklist | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/Porting/make-rmg-checklist b/Porting/make-rmg-checklist
index f116d23471..e4a810d36f 100644
--- a/Porting/make-rmg-checklist
+++ b/Porting/make-rmg-checklist
@@ -33,7 +33,6 @@ the following arguments:
                 of release you want to have
 
   --html        Output HTML instead of POD
-                (Not supported at the moment)
 _END_HELP
 
     exit;
@@ -121,16 +120,24 @@ sub create_checklist {
     print "=back\n\n" x ( $over_level / 4 );
 }
 
-my ($version);
+my ($version, $html);
 GetOptions(
     'version|v=s' => \$version,
-    'html'        => sub { _help('HTML is not supported at the moment'); },
+    '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;
+}
+
 my $type = _type_from_version($version);
 
 chomp( my @pod_lines = @{ pod() } );
@@ -199,3 +206,9 @@ iterate_items( \@items, $type, sub {
     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);
+}
-- 
2.12.2