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