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