1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Getopt::Long qw< :config no_ignore_case >; 7use FindBin qw< $Bin >; 8 9sub pod { 10 my $filename = shift; 11 12 open my $fh, '<', $filename 13 or die "Cannot open file ($filename): $!\n"; 14 15 my @lines = <$fh>; 16 17 close $fh 18 or die "Cannot close file ($filename): $!\n"; 19 20 return \@lines; 21} 22 23sub _help { 24 my $msg = shift; 25 if ($msg) { 26 print "Error: $msg\n\n"; 27 } 28 29 print << "_END_HELP"; 30$0 --version VERSION 31 32This script creates a release checklist as a POD or HTML document. It accepts 33the following arguments: 34 35 --version The version you are working on. This will infer the type 36 of release you want to have 37 38 --html Output HTML instead of POD 39_END_HELP 40 41 exit; 42} 43 44sub _type_from_version { 45 my $version = shift; 46 47 # 5.26.0 = BLEAD-FINAL 48 # 5.26.0-RC1 = RC 49 # 5.26.1 = MAINT 50 # 5.27.0 = BLEAD-POINT 51 # 5.27.1 = BLEAD-POINT 52 $version =~ m{^ 5\. (\d{1,2}) \. (\d{1,2}) (?: -RC(\d) )? $}xms 53 or die "Version must be 5.x.y or 5.x.y-RC#\n"; 54 55 my ( $major, $minor, $rc ) = ( $1, $2, $3 ); 56 57 # Dev release 58 if ( $major % 2 != 0 ) { 59 defined $rc 60 and die "Cannot have BLEAD-POINT RC release\n"; 61 62 return 'BLEAD-POINT'; 63 } 64 65 defined $rc 66 and return 'RC'; 67 68 return $minor == 0 ? 'BLEAD-FINAL' : 'MAINT'; 69} 70 71sub iterate_items { 72 my ( $items, $type, $cb ) = @_; 73 74 ITEM: 75 foreach my $item ( @{$items} ) { 76 foreach my $meta ( @{ $item->{'metadata'} || [] } ) { 77 if ( $meta =~ /skip .+ $type/xms ) { 78 next ITEM; 79 } 80 elsif ( $meta =~ /skip/xms ) { 81 $item->{content} =~ 82 s/^ [^\n]* \b MUST\ SKIP\ this\ step \b [^\n]* \n\n//xms; 83 } 84 } 85 86 $cb->($item); 87 } 88} 89 90sub create_checklist { 91 my ( $type, $items ) = @_; 92 93 my $collect; 94 my $prev_head = 0; 95 my $over_level; 96 iterate_items( $items, $type, sub { 97 my $item = shift; 98 99 foreach my $meta ( @{ $item->{'metadata'} || [] } ) { 100 $meta =~ /checklist \s+ begin/xmsi 101 and $collect = 1; 102 103 $meta =~ /checklist \s+ end/xmsi 104 and $collect = 0; 105 106 } 107 108 $collect 109 or return; 110 111 $over_level = ( $item->{'head'} - 1 ) * 4; 112 113 print $prev_head < $item->{'head'} ? "=over $over_level\n\n" 114 : $prev_head > $item->{'head'} ? "=back\n\n" 115 : ''; 116 117 chomp( my $name = $item->{'name'} ); 118 print "=item * L<< /$name >>\n\n"; 119 120 $prev_head = $item->{'head'}; 121 }); 122 123 print "=back\n\n" x ( $over_level / 4 ); 124} 125 126my ($version, $html); 127GetOptions( 128 'version|v=s' => \$version, 129 'html' => \$html, 130 'help|h' => sub { _help(); }, 131); 132 133defined $version 134 or _help('You must provide a version number'); 135 136my $pod_output = ''; 137if ($html) { 138 require Pod::Simple::HTML; 139 open my $fh, '>', \$pod_output 140 or die "Can't create fh to string: $!\n"; 141 select $fh; 142} 143 144my $type = _type_from_version($version); 145 146chomp( my @pod_lines = @{ pod("$Bin/release_managers_guide.pod") } ); 147 148my ( @items, $current_element, @leading_attrs ); 149my $skip_headers = qr/^=encoding/xms; 150my $passthru_headers = qr/^= (?: over | item | back | cut )/xms; 151 152# version used when generating diffs (acknowledgements, Module::CoreList etc) 153# 5.36.0 -> 5.34.0 154# 5.36.1 -> 5.36.0 155my ($major, $minor, $point) = split(/\./, $version); 156my $last_version = join('.', $major, ($point == 0 ? ($minor - 2, 0) : ($minor, $point-1))); 157 158 159foreach my $line (@pod_lines) { 160 $line =~ $skip_headers 161 and next; 162 163 if ( $line =~ /^ =head(\d) \s+ (.+) $/xms ) { 164 my ( $head_num, $head_title ) = ( $1, $2 ); 165 166 my $elem = { 167 'head' => $head_num, 168 'name' => $head_title, 169 }; 170 171 if (@leading_attrs) { 172 $elem->{'metadata'} = [ @leading_attrs ]; 173 @leading_attrs = (); 174 } 175 176 $current_element = $elem; 177 push @items, $elem; 178 179 next; 180 } 181 182 if ( $line =~ /^ =for \s+ (.+) $ /xms ) { 183 push @leading_attrs, $1; 184 next; 185 } 186 187 $line =~ $passthru_headers 188 or length $line == 0 # allow empty lines 189 or $line =~ /^[^=]/xms 190 or die "Cannot recognize line: '$line'\n"; 191 192 $line =~ s/\Q5.X.Y\E/$version/g; 193 $line =~ s/\Q5.LAST\E/$last_version/g; 194 $line =~ s/\Q5.X\E\b/$major.$minor/g; 195 196 $current_element->{'content'} .= "\n" . $line; 197} 198 199print << "_END_BEGINNING"; 200=head1 NAME 201 202Release Manager's Guide with Checklist for $version ($type) 203 204=head2 Checklist 205 206_END_BEGINNING 207 208# Remove beginning 209# This can also be done with a '=for introduction' in the future 210$items[0]{'name'} =~ /^NAME/xmsi 211 and shift @items; 212 213$items[0]{'name'} =~ /^MAKING \s+ A \s+ CHECKLIST/xmsi 214 and shift @items; 215 216create_checklist( $type, \@items ); 217 218iterate_items( \@items, $type, sub { 219 my $item = shift; 220 print "=head$item->{'head'} $item->{'name'}"; 221 print "$item->{'content'}\n"; 222} ); 223 224if ($html) { 225 my $simple = Pod::Simple::HTML->new; 226 $simple->output_fh(*STDOUT); 227 $simple->parse_string_document($pod_output); 228} 229