This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Replace Release Managers Guide (RMG) with new version:
authorSawyer X <xsawyerx@cpan.org>
Sun, 14 May 2017 10:24:07 +0000 (12:24 +0200)
committerAaron Crane <arc@cpan.org>
Sun, 16 Jul 2017 11:57:37 +0000 (12:57 +0100)
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
Porting/release_managers_guide.pod

index e25186c..d7a9bc4 100644 (file)
-#!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";
+} );
index 9f8004c..30e089f 100644 (file)
@@ -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