Mercurial > repo
comparison perl-5.22.2/autodoc.pl @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 #!/usr/bin/perl -w | |
2 # | |
3 # Unconditionally regenerate: | |
4 # | |
5 # pod/perlintern.pod | |
6 # pod/perlapi.pod | |
7 # | |
8 # from information stored in | |
9 # | |
10 # embed.fnc | |
11 # plus all the .c and .h files listed in MANIFEST | |
12 # | |
13 # Has an optional arg, which is the directory to chdir to before reading | |
14 # MANIFEST and *.[ch]. | |
15 # | |
16 # This script is invoked as part of 'make all' | |
17 # | |
18 # '=head1' are the only headings looked for. If the first non-blank line after | |
19 # the heading begins with a word character, it is considered to be the first | |
20 # line of documentation that applies to the heading itself. That is, it is | |
21 # output immediately after the heading, before the first function, and not | |
22 # indented. The next input line that is a pod directive terminates this | |
23 # heading-level documentation. | |
24 | |
25 use strict; | |
26 | |
27 if (@ARGV) { | |
28 my $workdir = shift; | |
29 chdir $workdir | |
30 or die "Couldn't chdir to '$workdir': $!"; | |
31 } | |
32 require 'regen/regen_lib.pl'; | |
33 require 'regen/embed_lib.pl'; | |
34 | |
35 # | |
36 # See database of global and static function prototypes in embed.fnc | |
37 # This is used to generate prototype headers under various configurations, | |
38 # export symbols lists for different platforms, and macros to provide an | |
39 # implicit interpreter context argument. | |
40 # | |
41 | |
42 my %docs; | |
43 my %funcflags; | |
44 my %macro = ( | |
45 ax => 1, | |
46 items => 1, | |
47 ix => 1, | |
48 svtype => 1, | |
49 ); | |
50 my %missing; | |
51 | |
52 my $curheader = "Unknown section"; | |
53 | |
54 sub autodoc ($$) { # parse a file and extract documentation info | |
55 my($fh,$file) = @_; | |
56 my($in, $doc, $line, $header_doc); | |
57 | |
58 # Count lines easier | |
59 my $get_next_line = sub { $line++; return <$fh> }; | |
60 | |
61 FUNC: | |
62 while (defined($in = $get_next_line->())) { | |
63 if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ && | |
64 ($file ne 'embed.h' || $file ne 'proto.h')) { | |
65 $macro{$1} = $file; | |
66 next FUNC; | |
67 } | |
68 if ($in=~ /^=head1 (.*)/) { | |
69 $curheader = $1; | |
70 | |
71 # If the next non-space line begins with a word char, then it is | |
72 # the start of heading-ldevel documentation. | |
73 if (defined($doc = $get_next_line->())) { | |
74 # Skip over empty lines | |
75 while ($doc =~ /^\s+$/) { | |
76 if (! defined($doc = $get_next_line->())) { | |
77 next FUNC; | |
78 } | |
79 } | |
80 | |
81 if ($doc !~ /^\w/) { | |
82 $in = $doc; | |
83 redo FUNC; | |
84 } | |
85 $header_doc = $doc; | |
86 | |
87 # Continue getting the heading-level documentation until read | |
88 # in any pod directive (or as a fail-safe, find a closing | |
89 # comment to this pod in a C language file | |
90 HDR_DOC: | |
91 while (defined($doc = $get_next_line->())) { | |
92 if ($doc =~ /^=\w/) { | |
93 $in = $doc; | |
94 redo FUNC; | |
95 } | |
96 | |
97 if ($doc =~ m:^\s*\*/$:) { | |
98 warn "=cut missing? $file:$line:$doc";; | |
99 last HDR_DOC; | |
100 } | |
101 $header_doc .= $doc; | |
102 } | |
103 } | |
104 next FUNC; | |
105 } | |
106 if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) { | |
107 my $proto = $1; | |
108 $proto = "||$proto" unless $proto =~ /\|/; | |
109 my($flags, $ret, $name, @args) = split /\|/, $proto; | |
110 my $docs = ""; | |
111 DOC: | |
112 while (defined($doc = $get_next_line->())) { | |
113 last DOC if $doc =~ /^=\w+/; | |
114 if ($doc =~ m:^\*/$:) { | |
115 warn "=cut missing? $file:$line:$doc";; | |
116 last DOC; | |
117 } | |
118 $docs .= $doc; | |
119 } | |
120 $docs = "\n$docs" if $docs and $docs !~ /^\n/; | |
121 | |
122 # Check the consistency of the flags | |
123 my ($embed_where, $inline_where); | |
124 my ($embed_may_change, $inline_may_change); | |
125 | |
126 my $docref = delete $funcflags{$name}; | |
127 if ($docref and %$docref) { | |
128 $embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts'; | |
129 $embed_may_change = $docref->{flags} =~ /M/; | |
130 $flags .= 'D' if $docref->{flags} =~ /D/; | |
131 } else { | |
132 $missing{$name} = $file; | |
133 } | |
134 if ($flags =~ /m/) { | |
135 $inline_where = $flags =~ /A/ ? 'api' : 'guts'; | |
136 $inline_may_change = $flags =~ /x/; | |
137 | |
138 if (defined $embed_where && $inline_where ne $embed_where) { | |
139 warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where"; | |
140 } | |
141 | |
142 if (defined $embed_may_change | |
143 && $inline_may_change ne $embed_may_change) { | |
144 my $message = "Function '$name' inconsistency: "; | |
145 if ($embed_may_change) { | |
146 $message .= "embed.fnc says 'may change', Pod does not"; | |
147 } else { | |
148 $message .= "Pod says 'may change', embed.fnc does not"; | |
149 } | |
150 warn $message; | |
151 } | |
152 } elsif (!defined $embed_where) { | |
153 warn "Unable to place $name!\n"; | |
154 next; | |
155 } else { | |
156 $inline_where = $embed_where; | |
157 $flags .= 'x' if $embed_may_change; | |
158 @args = @{$docref->{args}}; | |
159 $ret = $docref->{retval}; | |
160 } | |
161 | |
162 if (exists $docs{$inline_where}{$curheader}{$name}) { | |
163 warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n"; | |
164 next; | |
165 } | |
166 $docs{$inline_where}{$curheader}{$name} | |
167 = [$flags, $docs, $ret, $file, @args]; | |
168 | |
169 # Create a special entry with an empty-string name for the | |
170 # heading-level documentation. | |
171 if (defined $header_doc) { | |
172 $docs{$inline_where}{$curheader}{""} = $header_doc; | |
173 undef $header_doc; | |
174 } | |
175 | |
176 if (defined $doc) { | |
177 if ($doc =~ /^=(?:for|head)/) { | |
178 $in = $doc; | |
179 redo FUNC; | |
180 } | |
181 } else { | |
182 warn "$file:$line:$in"; | |
183 } | |
184 } | |
185 } | |
186 } | |
187 | |
188 sub docout ($$$) { # output the docs for one function | |
189 my($fh, $name, $docref) = @_; | |
190 my($flags, $docs, $ret, $file, @args) = @$docref; | |
191 $name =~ s/\s*$//; | |
192 | |
193 if ($flags =~ /D/) { | |
194 $docs = "\n\nDEPRECATED! It is planned to remove this function from a | |
195 future release of Perl. Do not use it for new code; remove it from | |
196 existing code.\n\n$docs"; | |
197 } | |
198 else { | |
199 $docs = "\n\nNOTE: this function is experimental and may change or be | |
200 removed without notice.\n\n$docs" if $flags =~ /x/; | |
201 } | |
202 $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" | |
203 if $flags =~ /p/; | |
204 $docs .= "NOTE: this function must be explicitly called as Perl_$name with an aTHX_ parameter.\n\n" | |
205 if $flags =~ /o/; | |
206 | |
207 print $fh "=item $name\nX<$name>\n$docs"; | |
208 | |
209 if ($flags =~ /U/) { # no usage | |
210 # nothing | |
211 } elsif ($flags =~ /s/) { # semicolon ("dTHR;") | |
212 print $fh "\t\t$name;\n\n"; | |
213 } elsif ($flags =~ /n/) { # no args | |
214 print $fh "\t$ret\t$name\n\n"; | |
215 } else { # full usage | |
216 my $p = $flags =~ /o/; # no #define foo Perl_foo | |
217 my $n = "Perl_"x$p . $name; | |
218 my $large_ret = length $ret > 7; | |
219 my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item | |
220 +8+($large_ret ? 1 + length $ret : 8) | |
221 +length($n) + 1; | |
222 my $indent; | |
223 print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n("; | |
224 my $long_args; | |
225 for (@args) { | |
226 if ($indent_size + 2 + length > 79) { | |
227 $long_args=1; | |
228 $indent_size -= length($n) - 3; | |
229 last; | |
230 } | |
231 } | |
232 my $args = ''; | |
233 if ($p) { | |
234 $args = @args ? "pTHX_ " : "pTHX"; | |
235 if ($long_args) { print $fh $args; $args = '' } | |
236 } | |
237 $long_args and print $fh "\n"; | |
238 my $first = !$long_args; | |
239 while () { | |
240 if (!@args or | |
241 length $args | |
242 && $indent_size + 3 + length($args[0]) + length $args > 79 | |
243 ) { | |
244 print $fh | |
245 $first ? '' : ( | |
246 $indent //= | |
247 "\t".($large_ret ? " " x (1+length $ret) : "\t") | |
248 ." "x($long_args ? 4 : 1 + length $n) | |
249 ), | |
250 $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args; | |
251 $args = $first = ''; | |
252 } | |
253 @args or last; | |
254 $args .= ", "x!!(length $args && $args ne 'pTHX_ ') | |
255 . shift @args; | |
256 } | |
257 if ($long_args) { print $fh "\n", substr $indent, 0, -4 } | |
258 print $fh ")\n\n"; | |
259 } | |
260 print $fh "=for hackers\nFound in file $file\n\n"; | |
261 } | |
262 | |
263 sub sort_helper { | |
264 # Do a case-insensitive dictionary sort, with only alphabetics | |
265 # significant, falling back to using everything for determinancy | |
266 return (uc($a =~ s/[[^:alpha]]//r) cmp uc($b =~ s/[[^:alpha]]//r)) | |
267 || uc($a) cmp uc($b) | |
268 || $a cmp $b; | |
269 } | |
270 | |
271 sub output { | |
272 my ($podname, $header, $dochash, $missing, $footer) = @_; | |
273 my $fh = open_new("pod/$podname.pod", undef, | |
274 {by => "$0 extracting documentation", | |
275 from => 'the C source files'}, 1); | |
276 | |
277 print $fh $header; | |
278 | |
279 my $key; | |
280 for $key (sort sort_helper keys %$dochash) { | |
281 my $section = $dochash->{$key}; | |
282 print $fh "\n=head1 $key\n\n"; | |
283 | |
284 # Output any heading-level documentation and delete so won't get in | |
285 # the way later | |
286 if (exists $section->{""}) { | |
287 print $fh $section->{""} . "\n"; | |
288 delete $section->{""}; | |
289 } | |
290 print $fh "=over 8\n\n"; | |
291 | |
292 for my $key (sort sort_helper keys %$section) { | |
293 docout($fh, $key, $section->{$key}); | |
294 } | |
295 print $fh "\n=back\n"; | |
296 } | |
297 | |
298 if (@$missing) { | |
299 print $fh "\n=head1 Undocumented functions\n\n"; | |
300 print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_'; | |
301 The following functions have been flagged as part of the public API, | |
302 but are currently undocumented. Use them at your own risk, as the | |
303 interfaces are subject to change. Functions that are not listed in this | |
304 document are not intended for public use, and should NOT be used under any | |
305 circumstances. | |
306 | |
307 If you use one of the undocumented functions below, you may wish to consider | |
308 creating and submitting documentation | |
309 for it. If your patch is accepted, this | |
310 will indicate that the interface is stable (unless it is explicitly marked | |
311 otherwise). | |
312 | |
313 =over | |
314 | |
315 _EOB_ | |
316 The following functions are currently undocumented. If you use one of | |
317 them, you may wish to consider creating and submitting documentation for | |
318 it. | |
319 | |
320 =over | |
321 | |
322 _EOB_ | |
323 for my $missing (sort @$missing) { | |
324 print $fh "=item $missing\nX<$missing>\n\n"; | |
325 } | |
326 print $fh "=back\n\n"; | |
327 } | |
328 print $fh $footer, "=cut\n"; | |
329 | |
330 read_only_bottom_close_and_rename($fh); | |
331 } | |
332 | |
333 foreach (@{(setup_embed())[0]}) { | |
334 next if @$_ < 2; | |
335 my ($flags, $retval, $func, @args) = @$_; | |
336 s/\b(?:NN|NULLOK)\b\s+//g for @args; | |
337 | |
338 $funcflags{$func} = { | |
339 flags => $flags, | |
340 retval => $retval, | |
341 args => \@args, | |
342 }; | |
343 } | |
344 | |
345 # glob() picks up docs from extra .c or .h files that may be in unclean | |
346 # development trees. | |
347 open my $fh, '<', 'MANIFEST' | |
348 or die "Can't open MANIFEST: $!"; | |
349 while (my $line = <$fh>) { | |
350 next unless my ($file) = $line =~ /^(\S+\.[ch])\t/; | |
351 | |
352 open F, "< $file" or die "Cannot open $file for docs: $!\n"; | |
353 $curheader = "Functions in file $file\n"; | |
354 autodoc(\*F,$file); | |
355 close F or die "Error closing $file: $!\n"; | |
356 } | |
357 close $fh or die "Error whilst reading MANIFEST: $!"; | |
358 | |
359 for (sort keys %funcflags) { | |
360 next unless $funcflags{$_}{flags} =~ /d/; | |
361 warn "no docs for $_\n" | |
362 } | |
363 | |
364 foreach (sort keys %missing) { | |
365 next if $macro{$_}; | |
366 # Heuristics for known not-a-function macros: | |
367 next if /^[A-Z]/; | |
368 next if /^dj?[A-Z]/; | |
369 | |
370 warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc"; | |
371 } | |
372 | |
373 # walk table providing an array of components in each line to | |
374 # subroutine, printing the result | |
375 | |
376 # List of funcs in the public API that aren't also marked as experimental nor | |
377 # deprecated. | |
378 my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags; | |
379 output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_'); | |
380 =head1 NAME | |
381 | |
382 perlapi - autogenerated documentation for the perl public API | |
383 | |
384 =head1 DESCRIPTION | |
385 X<Perl API> X<API> X<api> | |
386 | |
387 This file contains the documentation of the perl public API generated by | |
388 F<embed.pl>, specifically a listing of functions, macros, flags, and variables | |
389 that may be used by extension writers. L<At the end|/Undocumented functions> | |
390 is a list of functions which have yet to be documented. The interfaces of | |
391 those are subject to change without notice. Anything not listed here is | |
392 not part of the public API, and should not be used by extension writers at | |
393 all. For these reasons, blindly using functions listed in proto.h is to be | |
394 avoided when writing extensions. | |
395 | |
396 Note that all Perl API global variables must be referenced with the C<PL_> | |
397 prefix. Again, those not listed here are not to be used by extension writers, | |
398 and can be changed or removed without notice; same with macros. | |
399 Some macros are provided for compatibility with the older, | |
400 unadorned names, but this support may be disabled in a future release. | |
401 | |
402 Perl was originally written to handle US-ASCII only (that is characters | |
403 whose ordinal numbers are in the range 0 - 127). | |
404 And documentation and comments may still use the term ASCII, when | |
405 sometimes in fact the entire range from 0 - 255 is meant. | |
406 | |
407 Note that Perl can be compiled and run under either ASCII or EBCDIC (See | |
408 L<perlebcdic>). Most of the documentation (and even comments in the code) | |
409 ignore the EBCDIC possibility. | |
410 For almost all purposes the differences are transparent. | |
411 As an example, under EBCDIC, | |
412 instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so | |
413 whenever this documentation refers to C<utf8> | |
414 (and variants of that name, including in function names), | |
415 it also (essentially transparently) means C<UTF-EBCDIC>. | |
416 But the ordinals of characters differ between ASCII, EBCDIC, and | |
417 the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes | |
418 than in UTF-8. | |
419 | |
420 The listing below is alphabetical, case insensitive. | |
421 | |
422 _EOB_ | |
423 | |
424 =head1 AUTHORS | |
425 | |
426 Until May 1997, this document was maintained by Jeff Okamoto | |
427 <okamoto@corp.hp.com>. It is now maintained as part of Perl itself. | |
428 | |
429 With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, | |
430 Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil | |
431 Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, | |
432 Stephen McCamant, and Gurusamy Sarathy. | |
433 | |
434 API Listing originally by Dean Roehrich <roehrich@cray.com>. | |
435 | |
436 Updated to be autogenerated from comments in the source by Benjamin Stuhl. | |
437 | |
438 =head1 SEE ALSO | |
439 | |
440 L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern> | |
441 | |
442 _EOE_ | |
443 | |
444 # List of non-static internal functions | |
445 my @missing_guts = | |
446 grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags; | |
447 | |
448 output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END'); | |
449 =head1 NAME | |
450 | |
451 perlintern - autogenerated documentation of purely B<internal> | |
452 Perl functions | |
453 | |
454 =head1 DESCRIPTION | |
455 X<internal Perl functions> X<interpreter functions> | |
456 | |
457 This file is the autogenerated documentation of functions in the | |
458 Perl interpreter that are documented using Perl's internal documentation | |
459 format but are not marked as part of the Perl API. In other words, | |
460 B<they are not for use in extensions>! | |
461 | |
462 END | |
463 | |
464 =head1 AUTHORS | |
465 | |
466 The autodocumentation system was originally added to the Perl core by | |
467 Benjamin Stuhl. Documentation is by whoever was kind enough to | |
468 document their functions. | |
469 | |
470 =head1 SEE ALSO | |
471 | |
472 L<perlguts>, L<perlapi> | |
473 | |
474 END |