#!/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);
}