-#!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, '<', $filename
+ or die "Cannot open file ($filename): $!\n";
- if ($help) {
- print <<'EOF';
-make-rmg-checklist [--type TYPE]
+ 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:
- --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('Porting/release_managers_guide.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);
+}
https://perl5.git.perl.org / perl5.git / blobdiff