Faster feature checks

[perl5.git] / Porting / make-rmg-checklist

#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long qw< :config no_ignore_case >;

sub pod {
    my $filename = shift;

    open my $fh, '<', $filename
        or die "Cannot open file ($filename): $!\n";

    my @lines = <$fh>;

    close $fh
        or die "Cannot close file ($filename): $!\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:

  --version     The version you are working on. This will infer the type
                of release you want to have

  --html        Output HTML instead of POD
_END_HELP

    exit;
}

sub _type_from_version {
    my $version = shift;

    # 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";

    my ( $major, $minor, $rc ) = ( $1, $2, $3 );

    # Dev release
    if ( $major % 2 != 0 ) {
        defined $rc
            and die "Cannot have BLEAD-POINT RC release\n";

        return 'BLEAD-POINT';
    }

    defined $rc
        and return 'RC';

    return $minor == 0 ? 'BLEAD-FINAL' : 'MAINT';
}

sub iterate_items {
    my ( $items, $type, $cb ) = @_;

    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;
            }
        }

        $cb->($item);
    }
}

sub create_checklist {
    my ( $type, $items ) = @_;

    my $collect;
    my $prev_head = 0;
    my $over_level;
    iterate_items( $items, $type, sub {
        my $item = shift;

        foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
            $meta =~ /checklist \s+ begin/xmsi
                and $collect = 1;

            $meta =~ /checklist \s+ end/xmsi
                and $collect = 0;

        }

        $collect
            or return;

        $over_level = ( $item->{'head'} - 1 ) * 4;

        print $prev_head < $item->{'head'} ? "=over $over_level\n\n"
            : $prev_head > $item->{'head'} ? "=back\n\n"
            :                                '';

        chomp( my $name = $item->{'name'} );
        print "=item * L<< /$name >>\n\n";

        $prev_head = $item->{'head'};
    });

    print "=back\n\n" x ( $over_level / 4 );
}

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;
}

my $type = _type_from_version($version);

chomp( my @pod_lines = @{ pod('Porting/release_managers_guide.pod') } );

my ( @items, $current_element, @leading_attrs );
my $skip_headers     = qr/^=encoding/xms;
my $passthru_headers = qr/^= (?: over | item | back | cut )/xms;

foreach my $line (@pod_lines) {
    $line =~ $skip_headers
        and next;

    if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) {
        my ( $head_num, $head_title ) = ( $1, $2 );

        my $elem = {
            'head' => $head_num,
            'name' => $head_title,
        };

        if (@leading_attrs) {
            $elem->{'metadata'} = [ @leading_attrs ];
            @leading_attrs = ();
        }

        $current_element = $elem;
        push @items, $elem;

        next;
    }

    if ( $line =~ /^ =for \s+ (.+) $ /xms ) {
        push @leading_attrs, $1;
        next;
    }

    $line =~ $passthru_headers
        or length $line == 0 # allow empty lines
        or $line =~ /^[^=]/xms
        or die "Cannot recognize line: '$line'\n";

    $current_element->{'content'} .= "\n" . $line;
}

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);
}