Porting/make-rmg-checklist

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Getopt::Long qw< :config no_ignore_case >;
   5
   6 sub pod {
   7     my $filename = shift;
   8
   9     open my $fh, '<', $filename
  10         or die "Cannot open file ($filename): $!\n";
  11
  12     my @lines = <$fh>;
  13
  14     close $fh
  15         or die "Cannot close file ($filename): $!\n";
  16
  17     return \@lines;
  18 }
  19
  20 sub _help {
  21     my $msg = shift;
  22     if ($msg) {
  23         print "Error: $msg\n\n";
  24     }
  25
  26     print << "_END_HELP";
  27 $0 --version VERSION
  28
  29 This script creates a release checklist as a simple HTML document. It accepts
  30 the following arguments:
  31
  32   --version     The version you are working on. This will infer the type
  33                 of release you want to have
  34
  35   --html        Output HTML instead of POD
  36 _END_HELP
  37
  38     exit;
  39 }
  40
  41 sub _type_from_version {
  42     my $version = shift;
  43
  44     # 5.26.0      = BLEAD-FINAL
  45     # 5.26.0-RC1  = RC
  46     # 5.26.1      = MAINT
  47     # 5.27.0      = BLEAD-POINT
  48     # 5.27.1      = BLEAD-POINT
  49     $version =~ m{^ 5\. (\d{1,2}) \. (\d{1,2}) (?: -RC(\d) )? $}xms
  50         or die "Version must be 5.x.y or 5.x.y-RC#\n";
  51
  52     my ( $major, $minor, $rc ) = ( $1, $2, $3 );
  53
  54     # Dev release
  55     if ( $major % 2 != 0 ) {
  56         defined $rc
  57             and die "Cannot have BLEAD-POINT RC release\n";
  58
  59         return 'BLEAD-POINT';
  60     }
  61
  62     defined $rc
  63         and return 'RC';
  64
  65     return $minor == 0 ? 'BLEAD-FINAL' : 'MAINT';
  66 }
  67
  68 sub iterate_items {
  69     my ( $items, $type, $cb ) = @_;
  70
  71     ITEM:
  72     foreach my $item ( @{$items} ) {
  73         foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
  74             if ( $meta =~ /skip .+ $type/xms ) {
  75                 next ITEM;
  76             }
  77             elsif ( $meta =~ /skip/xms ) {
  78                 $item->{content} =~
  79                     s/^ [^\n]* \b MUST\ SKIP\ this\ step \b [^\n]* \n\n//xms;
  80             }
  81         }
  82
  83         $cb->($item);
  84     }
  85 }
  86
  87 sub create_checklist {
  88     my ( $type, $items ) = @_;
  89
  90     my $collect;
  91     my $prev_head = 0;
  92     my $over_level;
  93     iterate_items( $items, $type, sub {
  94         my $item = shift;
  95
  96         foreach my $meta ( @{ $item->{'metadata'} || [] } ) {
  97             $meta =~ /checklist \s+ begin/xmsi
  98                 and $collect = 1;
  99
 100             $meta =~ /checklist \s+ end/xmsi
 101                 and $collect = 0;
 102
 103         }
 104
 105         $collect
 106             or return;
 107
 108         $over_level = ( $item->{'head'} - 1 ) * 4;
 109
 110         print $prev_head < $item->{'head'} ? "=over $over_level\n\n"
 111             : $prev_head > $item->{'head'} ? "=back\n\n"
 112             :                                '';
 113
 114         chomp( my $name = $item->{'name'} );
 115         print "=item * L<< /$name >>\n\n";
 116
 117         $prev_head = $item->{'head'};
 118     });
 119
 120     print "=back\n\n" x ( $over_level / 4 );
 121 }
 122
 123 my ($version, $html);
 124 GetOptions(
 125     'version|v=s' => \$version,
 126     'html'        => \$html,
 127     'help|h'      => sub { _help(); },
 128 );
 129
 130 defined $version
 131     or _help('You must provide a version number');
 132
 133 my $pod_output = '';
 134 if ($html) {
 135     require Pod::Simple::HTML;
 136     open my $fh, '>', \$pod_output
 137         or die "Can't create fh to string: $!\n";
 138     select $fh;
 139 }
 140
 141 my $type = _type_from_version($version);
 142
 143 chomp( my @pod_lines = @{ pod('Porting/release_managers_guide.pod') } );
 144
 145 my ( @items, $current_element, @leading_attrs );
 146 my $skip_headers     = qr/^=encoding/xms;
 147 my $passthru_headers = qr/^= (?: over | item | back | cut )/xms;
 148
 149 foreach my $line (@pod_lines) {
 150     $line =~ $skip_headers
 151         and next;
 152
 153     if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) {
 154         my ( $head_num, $head_title ) = ( $1, $2 );
 155
 156         my $elem = {
 157             'head' => $head_num,
 158             'name' => $head_title,
 159         };
 160
 161         if (@leading_attrs) {
 162             $elem->{'metadata'} = [ @leading_attrs ];
 163             @leading_attrs = ();
 164         }
 165
 166         $current_element = $elem;
 167         push @items, $elem;
 168
 169         next;
 170     }
 171
 172     if ( $line =~ /^ =for \s+ (.+) $ /xms ) {
 173         push @leading_attrs, $1;
 174         next;
 175     }
 176
 177     $line =~ $passthru_headers
 178         or length $line == 0 # allow empty lines
 179         or $line =~ /^[^=]/xms
 180         or die "Cannot recognize line: '$line'\n";
 181
 182     $current_element->{'content'} .= "\n" . $line;
 183 }
 184
 185 print << "_END_BEGINNING";
 186 =head1 NAME
 187
 188 Release Manager's Guide with Checklist for $version ($type)
 189
 190 =head2 Checklist
 191
 192 _END_BEGINNING
 193
 194 # Remove beginning
 195 # This can also be done with a '=for introduction' in the future
 196 $items[0]{'name'} =~ /^NAME/xmsi
 197     and shift @items;
 198
 199 $items[0]{'name'} =~ /^MAKING \s+ A \s+ CHECKLIST/xmsi
 200     and shift @items;
 201
 202 create_checklist( $type, \@items );
 203
 204 iterate_items( \@items, $type, sub {
 205     my $item = shift;
 206     print "=head$item->{'head'} $item->{'name'}";
 207     print "$item->{'content'}\n";
 208 } );
 209
 210 if ($html) {
 211     my $simple = Pod::Simple::HTML->new;
 212     $simple->output_fh(*STDOUT);
 213     $simple->parse_string_document($pod_output);
 214 }