final commit for v5.24.0!
[perl.git] / 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();