Commit | Line | Data |
---|---|---|
7c4d7879 | 1 | #!/usr/bin/perl |
da571fa1 DR |
2 | use strict; |
3 | use warnings; | |
7c4d7879 | 4 | use Getopt::Long qw< :config no_ignore_case >; |
da571fa1 | 5 | |
7c4d7879 S |
6 | sub pod { |
7 | my $filename = shift; | |
da571fa1 | 8 | |
5c780def MH |
9 | open my $fh, '<', $filename |
10 | or die "Cannot open file ($filename): $!\n"; | |
da571fa1 | 11 | |
7c4d7879 S |
12 | my @lines = <$fh>; |
13 | ||
14 | close $fh | |
5c780def | 15 | or die "Cannot close file ($filename): $!\n"; |
7c4d7879 S |
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 | |
da571fa1 DR |
28 | |
29 | This script creates a release checklist as a simple HTML document. It accepts | |
30 | the following arguments: | |
31 | ||
7c4d7879 S |
32 | --version The version you are working on. This will infer the type |
33 | of release you want to have | |
da571fa1 | 34 | |
7c4d7879 | 35 | --html Output HTML instead of POD |
7c4d7879 | 36 | _END_HELP |
beb269e4 | 37 | |
7c4d7879 S |
38 | exit; |
39 | } | |
da571fa1 | 40 | |
7c4d7879 S |
41 | sub _type_from_version { |
42 | my $version = shift; | |
da571fa1 | 43 | |
7c4d7879 S |
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"; | |
beb269e4 | 51 | |
7c4d7879 | 52 | my ( $major, $minor, $rc ) = ( $1, $2, $3 ); |
beb269e4 | 53 | |
7c4d7879 S |
54 | # Dev release |
55 | if ( $major % 2 != 0 ) { | |
56 | defined $rc | |
57 | and die "Cannot have BLEAD-POINT RC release\n"; | |
beb269e4 | 58 | |
7c4d7879 | 59 | return 'BLEAD-POINT'; |
beb269e4 | 60 | } |
da571fa1 | 61 | |
7c4d7879 S |
62 | defined $rc |
63 | and return 'RC'; | |
da571fa1 | 64 | |
7c4d7879 S |
65 | return $minor == 0 ? 'BLEAD-FINAL' : 'MAINT'; |
66 | } | |
da571fa1 | 67 | |
7c4d7879 S |
68 | sub iterate_items { |
69 | my ( $items, $type, $cb ) = @_; | |
da571fa1 | 70 | |
7c4d7879 S |
71 | ITEM: |
72 | foreach my $item ( @{$items} ) { | |
73 | foreach my $meta ( @{ $item->{'metadata'} || [] } ) { | |
57ebedf6 AC |
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 | } | |
7c4d7879 | 81 | } |
da571fa1 | 82 | |
7c4d7879 S |
83 | $cb->($item); |
84 | } | |
da571fa1 DR |
85 | } |
86 | ||
7c4d7879 S |
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; | |
da571fa1 | 95 | |
7c4d7879 S |
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; | |
da571fa1 | 102 | |
da571fa1 DR |
103 | } |
104 | ||
7c4d7879 S |
105 | $collect |
106 | or return; | |
da571fa1 | 107 | |
7c4d7879 | 108 | $over_level = ( $item->{'head'} - 1 ) * 4; |
da571fa1 | 109 | |
7c4d7879 S |
110 | print $prev_head < $item->{'head'} ? "=over $over_level\n\n" |
111 | : $prev_head > $item->{'head'} ? "=back\n\n" | |
112 | : ''; | |
da571fa1 | 113 | |
7c4d7879 S |
114 | chomp( my $name = $item->{'name'} ); |
115 | print "=item * L<< /$name >>\n\n"; | |
da571fa1 | 116 | |
7c4d7879 S |
117 | $prev_head = $item->{'head'}; |
118 | }); | |
da571fa1 | 119 | |
7c4d7879 | 120 | print "=back\n\n" x ( $over_level / 4 ); |
da571fa1 DR |
121 | } |
122 | ||
ad1baa5f | 123 | my ($version, $html); |
7c4d7879 S |
124 | GetOptions( |
125 | 'version|v=s' => \$version, | |
ad1baa5f | 126 | 'html' => \$html, |
7c4d7879 S |
127 | 'help|h' => sub { _help(); }, |
128 | ); | |
beb269e4 | 129 | |
7c4d7879 S |
130 | defined $version |
131 | or _help('You must provide a version number'); | |
beb269e4 | 132 | |
ad1baa5f AC |
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 | ||
7c4d7879 | 141 | my $type = _type_from_version($version); |
da571fa1 | 142 | |
5c780def | 143 | chomp( my @pod_lines = @{ pod('Porting/release_managers_guide.pod') } ); |
da571fa1 | 144 | |
7c4d7879 S |
145 | my ( @items, $current_element, @leading_attrs ); |
146 | my $skip_headers = qr/^=encoding/xms; | |
147 | my $passthru_headers = qr/^= (?: over | item | back | cut )/xms; | |
beb269e4 | 148 | |
7c4d7879 S |
149 | foreach my $line (@pod_lines) { |
150 | $line =~ $skip_headers | |
151 | and next; | |
beb269e4 | 152 | |
7c4d7879 S |
153 | if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) { |
154 | my ( $head_num, $head_title ) = ( $1, $2 ); | |
beb269e4 | 155 | |
7c4d7879 S |
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 = (); | |
beb269e4 DR |
164 | } |
165 | ||
7c4d7879 S |
166 | $current_element = $elem; |
167 | push @items, $elem; | |
beb269e4 | 168 | |
7c4d7879 | 169 | next; |
da571fa1 DR |
170 | } |
171 | ||
7c4d7879 S |
172 | if ( $line =~ /^ =for \s+ (.+) $ /xms ) { |
173 | push @leading_attrs, $1; | |
174 | next; | |
175 | } | |
4b545dae | 176 | |
7c4d7879 S |
177 | $line =~ $passthru_headers |
178 | or length $line == 0 # allow empty lines | |
179 | or $line =~ /^[^=]/xms | |
180 | or die "Cannot recognize line: '$line'\n"; | |
beb269e4 | 181 | |
7c4d7879 | 182 | $current_element->{'content'} .= "\n" . $line; |
da571fa1 DR |
183 | } |
184 | ||
7c4d7879 S |
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 | } ); | |
ad1baa5f AC |
209 | |
210 | if ($html) { | |
211 | my $simple = Pod::Simple::HTML->new; | |
212 | $simple->output_fh(*STDOUT); | |
213 | $simple->parse_string_document($pod_output); | |
214 | } |