Commit | Line | Data |
---|---|---|
bfb8e1a7 JK |
1 | #!/usr/bin/perl |
2 | use 5.14.0; | |
3 | use warnings; | |
4 | use Carp; | |
5 | use File::Spec; | |
6 | use Getopt::Long; | |
99328e53 | 7 | use Module::Metadata; |
bfb8e1a7 JK |
8 | require "./Porting/manifest_lib.pl"; |
9 | ||
10 | =head1 NAME | |
11 | ||
12 | add-pod-file - Utility to add new F<pod/*.pod> file to core distribution | |
13 | ||
14 | =head1 USAGE | |
15 | ||
16 | After C<make test_prep> has been run, call from top level of Perl 5 core | |
17 | distribution: | |
18 | ||
19 | perl Porting/add-pod-file \ | |
99328e53 | 20 | --stub=<XXX> --section=<Z> --verbose |
bfb8e1a7 JK |
21 | |
22 | =head1 DESCRIPTION | |
23 | ||
24 | This is a program which I<may> be helpful when a committer has to add a new | |
25 | F<*.pod> file in the F<pod/> directory. | |
26 | ||
27 | =head2 Prerequisites | |
28 | ||
29 | This program assumes that committer has taken the following steps (in the | |
30 | order listed): | |
31 | ||
32 | =over 4 | |
33 | ||
34 | =item 1 You have run F<make test_prep>. | |
35 | ||
36 | This is to guarantee that all files are properly positioned. | |
37 | ||
38 | =item 2 You have placed a well-formatted F<.pod> file into the F<pod/> directory. | |
39 | ||
40 | In the C<NAME> section of this file there is a single non-blank line which | |
41 | consists of a string in the format C<STUB - ABSTRACT>, where C<STUB> is the | |
42 | basename of the file without the C<.pod> suffix and C<ABSTRACT> is the short | |
43 | description of the file. For example, a new file whose path is | |
44 | F<pod/perlphonypod.pod> must have a C<NAME> section like this: | |
45 | ||
46 | =head1 NAME | |
47 | ||
48 | perlphonypod - This is phony POD | |
49 | ||
50 | =back | |
51 | ||
52 | F<pod/*.pod> files need entries in multiple locations to keep F<make | |
53 | test_porting> happy. This program automates the formulation of I<most> of | |
54 | those entries, but will need some assistance from the committer to work | |
55 | properly. The committer will have to make a reasonable choice as to which | |
56 | section of F<pod/perl.pod> the new F<.pod> file should be listed under. | |
57 | The eligible sections are shown in the following table: | |
58 | ||
59 | Command-Line Value Section in pod/perl.pod | |
60 | ||
61 | O => 'Overview', | |
62 | T => 'Tutorials', | |
63 | R => 'Reference Manual', | |
64 | I => 'Internals and C Language Interface', | |
d1690fb1 | 65 | H => 'History', |
bfb8e1a7 JK |
66 | M => 'Miscellaneous', |
67 | L => 'Language-Specific', | |
68 | P => 'Platform-Specific', | |
69 | ||
70 | For a first pass, we'll put the new entry at the end of the C<^=head2> section | |
71 | specified by the committer with the single-initial provided for command-line | |
72 | switch C<section>. | |
73 | ||
74 | =head2 Testing this program | |
75 | ||
76 | =over 4 | |
77 | ||
99328e53 | 78 | =item 1 Run F<configure> and F<make> in the source tree. |
bfb8e1a7 | 79 | |
99328e53 | 80 | =item 2 Create a well formatted F<.pod> file somewhere on your system. |
bfb8e1a7 | 81 | |
99328e53 | 82 | =item 3 Copy it into the source tree under F<pod>. |
bfb8e1a7 | 83 | |
99328e53 | 84 | =item 4 Call the program as in L</USAGE> above. |
bfb8e1a7 | 85 | |
99328e53 JK |
86 | =item 5 Call F<git diff> and examine results. |
87 | ||
88 | =item 6 Run F<make test_porting>. | |
bfb8e1a7 JK |
89 | |
90 | =back | |
91 | ||
99328e53 JK |
92 | =head1 BUGS |
93 | ||
94 | When the argument provided to the C<--section> command-line switch is C<P> (for platform-specific), F<win32/pod.mak> is not getting updated -- but it's not clear whether it I<ought> to be updated. | |
95 | ||
bfb8e1a7 JK |
96 | =cut |
97 | ||
98 | my @man_sections = ( | |
99 | O => 'Overview', | |
100 | T => 'Tutorials', | |
101 | R => 'Reference Manual', | |
102 | I => 'Internals and C Language Interface', | |
d1690fb1 | 103 | H => 'History', |
bfb8e1a7 JK |
104 | M => 'Miscellaneous', |
105 | L => 'Language-Specific', | |
106 | P => 'Platform-Specific', | |
107 | ); | |
108 | ||
109 | my @man_section_abbrevs = (); | |
110 | my $man_sections_str = ''; | |
111 | for (my $i=0; $i<= $#man_sections; $i+=2) { | |
112 | my $j = $i+1; | |
113 | push @man_section_abbrevs, $man_sections[$i]; | |
114 | $man_sections_str .= "\t$man_sections[$i] => $man_sections[$j]\n"; | |
115 | } | |
116 | my %man_sections_seen = map { $_ => 1 } @man_section_abbrevs; | |
117 | my $man_sections = { @man_sections }; | |
118 | ||
99328e53 | 119 | my ($stub, $section, $verbose) = ('') x 3; |
bfb8e1a7 JK |
120 | GetOptions( |
121 | "stub=s" => \$stub, | |
bfb8e1a7 JK |
122 | "section=s" => \$section, |
123 | "verbose" => \$verbose, | |
124 | ) or croak("Error in command line arguments to add-pod-file.pl\n"); | |
125 | croak "$0: Must provide value for command-line switch 'stub'" | |
126 | unless length($stub); | |
bfb8e1a7 JK |
127 | croak "$0: Must provide value for command-line switch 'section'" |
128 | unless length($section); | |
129 | my $section_croak = "$0: Value for command-line switch must be one of @man_section_abbrevs\n"; | |
130 | $section_croak .= " Select one initial from:\n$man_sections_str"; | |
131 | croak $section_croak unless $man_sections_seen{$section}; | |
132 | ||
133 | my $newpodfile = "$stub.pod"; | |
134 | my $newpodpath = File::Spec->catfile('pod', $newpodfile); | |
135 | croak "Unable to locate new file '$newpodpath'" unless -f $newpodpath; | |
99328e53 JK |
136 | my $thispodchecker = File::Spec->catfile(qw|cpan Pod-Checker podchecker|); |
137 | croak "Cannot locate 'podchecker' within this checkout; have you called 'make'?" | |
138 | unless -f $thispodchecker; | |
bfb8e1a7 JK |
139 | |
140 | say "Step 1: Basic test of validity of POD in $newpodpath" if $verbose; | |
141 | ||
99328e53 JK |
142 | system(qq|$^X $thispodchecker $newpodpath|) |
143 | and croak "$newpodpath has POD errors; correct before proceeding further"; | |
144 | my $data = Module::Metadata->new_from_file($newpodpath, collect_pod => 1, decode_pod => 1); | |
145 | ||
6dc0bc88 | 146 | my $regex = qr/\A\s*(?:\S+\s+)+?-+\s+(.+?)\s*\z/s; |
708c2574 | 147 | my ($abstract) = ($data->pod('NAME') // '') =~ $regex |
99328e53 JK |
148 | or croak "Could not parse abstract from `=head1 NAME` in $newpodpath"; |
149 | ||
bfb8e1a7 JK |
150 | system(qq|git add $newpodpath|) and croak "Unable to 'git add'"; |
151 | ||
152 | # Step 2: Insert entry for $newpodpath into MANIFEST | |
153 | ||
bfb8e1a7 | 154 | my $manifest = 'MANIFEST'; |
99328e53 JK |
155 | say "Step 2: Insert entry for $newpodpath into $manifest" if $verbose; |
156 | ||
bfb8e1a7 JK |
157 | open(my $IN, '<', $manifest) |
158 | or croak "Can't open $manifest for reading"; | |
159 | my @manifest_orig = <$IN>; | |
160 | close($IN) or croak "Can't close $manifest after reading"; | |
161 | chomp(@manifest_orig); | |
162 | ||
163 | my (@before_pod, @pod, @after_pod); | |
164 | my $seen_pod = 0; | |
165 | while (my $l = shift(@manifest_orig)) { | |
166 | if (! $seen_pod and $l !~ m{^pod\/}) { | |
167 | push @before_pod, $l; | |
168 | } | |
169 | elsif ($l =~ m{^pod\/}) { | |
170 | push @pod, $l; | |
171 | $seen_pod++; | |
172 | } | |
173 | else { | |
174 | push @after_pod, $l; | |
175 | } | |
176 | } | |
177 | ||
99328e53 | 178 | say "Inserting entry for '$newpodpath' into $manifest; text will be '$abstract'" if $verbose; |
bfb8e1a7 JK |
179 | my $new_manifest_entry = "$newpodpath\t\t$abstract"; |
180 | my @new_pod = sort_manifest(@pod, $new_manifest_entry); | |
181 | ||
182 | open(my $OUT, '>', $manifest) | |
183 | or croak "Can't open $manifest for writing"; | |
184 | binmode($OUT); | |
185 | say $OUT join("\n", @before_pod, @new_pod, @after_pod); | |
186 | close($OUT) or croak "Can't close $manifest after writing"; | |
187 | ||
99328e53 JK |
188 | my $perlpod = File::Spec->catfile(qw|pod perl.pod|); |
189 | ||
190 | say "Step 3: Add entry to $perlpod" if $verbose; | |
bfb8e1a7 JK |
191 | |
192 | # Read the existing pod/perl.pod into memory. | |
193 | # Divide it into chunks before the selected section, the head2 of the selected | |
194 | # section, the selected section, and what comes after the selected section. | |
195 | # Add the stub and abstract for the new .pod file to the end of the selected | |
196 | # section. (Manually reposition to taste.) | |
197 | ||
bfb8e1a7 JK |
198 | open(my $IN1, '<', $perlpod) |
199 | or croak "Can't open $perlpod for reading"; | |
200 | my $perlpod_str; | |
201 | { | |
202 | local $/; | |
203 | $perlpod_str = <$IN1>; | |
204 | } | |
205 | close($IN1) or croak "Can't close $perlpod after reading"; | |
206 | ||
207 | my $section_head = "=head2 $man_sections->{$section}"; | |
208 | my @chunks = split $section_head, $perlpod_str; | |
209 | chomp $chunks[0]; # So we can use 'say' consistently later on | |
210 | ||
211 | my @balance = split /\n/, $chunks[1]; | |
212 | shift @balance; # $chunks[1] begins with a newline which we won't need to output | |
213 | my (@target_section, @after_section); | |
214 | ||
99328e53 | 215 | my $target = \@target_section; |
bfb8e1a7 | 216 | for my $l (@balance) { |
99328e53 JK |
217 | $target = \@after_section if $l =~ m/^=(head2|for)/; |
218 | push @$target, $l; | |
bfb8e1a7 JK |
219 | } |
220 | ||
221 | push @target_section, " $stub\t\t$abstract"; | |
222 | ||
223 | open(my $OUT1, '>', $perlpod) | |
224 | or croak "Can't open $perlpod for writing"; | |
225 | say $OUT1 $chunks[0]; | |
226 | say $OUT1 $section_head; | |
227 | say $OUT1 join("\n" => @target_section), "\n"; | |
228 | say $OUT1 join("\n" => @after_section), "\n"; | |
229 | close $OUT1 or croak "Can't close $perlpod after writing"; | |
230 | ||
99328e53 JK |
231 | my $podmak_command = './perl -Ilib Porting/pod_rules.pl --build-podmak --verbose'; |
232 | say "Step 4: Running '$podmak_command' to update win32/pod.mak." | |
bfb8e1a7 JK |
233 | if $verbose; |
234 | ||
99328e53 | 235 | system($podmak_command) and croak "'$podmak_command' failed"; |
bfb8e1a7 JK |
236 | |
237 | system(qq|git add MANIFEST pod/perl.pod win32/pod.mak|) | |
238 | and croak "Unable to git-add three updated files"; | |
239 | ||
240 | if ($verbose) { | |
241 | say "Call 'git diff --staged' and inspect modified files; correct as needed."; | |
242 | say "Then run 'make test_porting'."; | |
243 | say "Then say 'git commit'."; | |
244 | } |