(perl #131836) avoid a use-after-free after parsing a "sub" keyword
[perl.git] / 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 }