Commit | Line | Data |
---|---|---|
da571fa1 DR |
1 | #!perl |
2 | use strict; | |
3 | use warnings; | |
4 | use autodie; | |
5 | ||
6 | use Getopt::Long; | |
beb269e4 | 7 | use Pod::Simple::HTML; |
da571fa1 DR |
8 | |
9 | sub main { | |
beb269e4 | 10 | my ( $help, $type, $html ); |
da571fa1 DR |
11 | GetOptions( |
12 | 'type:s' => \$type, | |
beb269e4 | 13 | 'html' => \$html, |
da571fa1 DR |
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 | ||
beb269e4 DR |
27 | --html Output HTML instead of POD |
28 | ||
da571fa1 DR |
29 | EOF |
30 | ||
31 | exit; | |
32 | } | |
33 | ||
34 | $type = _validate_type($type); | |
beb269e4 DR |
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 | } | |
da571fa1 DR |
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 { | |
beb269e4 | 72 | my $pod = shift; |
da571fa1 DR |
73 | my $type = shift; |
74 | ||
da571fa1 DR |
75 | my @heads; |
76 | my $include = 0; | |
77 | my %skip; | |
78 | ||
beb269e4 | 79 | for ( split /\n/, $pod ) { |
da571fa1 DR |
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 | ||
beb269e4 | 103 | return \@heads; |
da571fa1 DR |
104 | } |
105 | ||
beb269e4 DR |
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 | |
da571fa1 | 114 | |
beb269e4 | 115 | Release Manager's Guide with Checklist |
da571fa1 | 116 | |
beb269e4 DR |
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; | |
da571fa1 DR |
136 | } |
137 | ||
4b545dae DR |
138 | $new_pod .= "=back\n\n" while $last_level--; |
139 | ||
beb269e4 DR |
140 | $new_pod .= $pod; |
141 | ||
142 | return $new_pod; | |
da571fa1 DR |
143 | } |
144 | ||
145 | main(); |