Porting/make-rmg-checklist

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use autodie;
   5
   6 use Getopt::Long;
   7 use Pod::Simple::HTML;
   8
   9 sub main {
  10     my ( $help, $type, $html );
  11     GetOptions(
  12         'type:s' => \$type,
  13         'html'   => \$html,
  14         'help'   => \$help,
  15     );
  16
  17     if ($help) {
  18         print <<'EOF';
  19 make-rmg-checklist [--type TYPE]
  20
  21 This script creates a release checklist as a simple HTML document. It accepts
  22 the following arguments:
  23
  24   --type    The release type for the checklist. This can be BLEAD-FINAL,
  25             BLEAD-POINT, MAINT, or RC. This defaults to BLEAD-POINT.
  26
  27   --html    Output HTML instead of POD
  28
  29 EOF
  30
  31         exit;
  32     }
  33
  34     $type = _validate_type($type);
  35
  36     open my $fh, '<', 'Porting/release_managers_guide.pod';
  37     my $pod = do { local $/; <$fh> };
  38     close $fh;
  39
  40     my $heads = _parse_rmg( $pod, $type );
  41     my $new_pod = _munge_pod( $pod, $heads );
  42
  43     if ($html) {
  44         my $simple = Pod::Simple::HTML->new();
  45         $simple->output_fh(*STDOUT);
  46         $simple->parse_string_document($new_pod);
  47     }
  48     else {
  49         print $new_pod;
  50     }
  51 }
  52
  53 sub _validate_type {
  54     my $type = shift || 'BLEAD-POINT';
  55
  56     my @valid = qw( BLEAD-FINAL BLEAD-POINT MAINT RC );
  57     my %valid = map { $_ => 1 } @valid;
  58
  59     unless ( $valid{ uc $type } ) {
  60         my $err
  61             = "The type you provided ($type) is not a valid release type. It must be one of ";
  62         $err .= join ', ', @valid;
  63         $err .= "\n";
  64
  65         die $err;
  66     }
  67
  68     return $type;
  69 }
  70
  71 sub _parse_rmg {
  72     my $pod  = shift;
  73     my $type = shift;
  74
  75     my @heads;
  76     my $include = 0;
  77     my %skip;
  78
  79     for ( split /\n/, $pod ) {
  80         if (/^=for checklist begin/) {
  81             $include = 1;
  82             next;
  83         }
  84
  85         next unless $include;
  86
  87         last if /^=for checklist end/;
  88
  89         if (/^=for checklist skip (.+)/) {
  90             %skip = map { $_ => 1 } split / /, $1;
  91             next;
  92         }
  93
  94         if (/^=head(\d) (.+)/) {
  95             unless ( keys %skip && $skip{$type} ) {
  96                 push @heads, [ $1, $2 ];
  97             }
  98
  99             %skip = ();
 100         }
 101     }
 102
 103     return \@heads;
 104 }
 105
 106 sub _munge_pod {
 107     my $pod   = shift;
 108     my $heads = shift;
 109
 110     $pod =~ s/=head1 NAME.+?(=head1 SYNOPSIS)/$1/s;
 111
 112     my $new_pod = <<'EOF';
 113 =head1 NAME
 114
 115 Release Manager's Guide with Checklist
 116
 117 =head2 Checklist
 118
 119 EOF
 120
 121     my $last_level = 0;
 122     for my $head ( @{$heads} ) {
 123         my $level = $head->[0] - 1;
 124
 125         if ( $level > $last_level ) {
 126             $new_pod .= '=over ' . $level * 4;
 127             $new_pod .= "\n\n";
 128         }
 129         elsif ( $level < $last_level ) {
 130             $new_pod .= "=back\n\n" for 1 .. ( $last_level - $level );
 131         }
 132
 133         $new_pod .= '=item * ' . 'L<< /' . $head->[1] . " >>\n\n";
 134
 135         $last_level = $level;
 136     }
 137
 138     $new_pod .= "=back\n\n" while $last_level--;
 139
 140     $new_pod .= $pod;
 141
 142     return $new_pod;
 143 }
 144
 145 main();