This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/embed.pl: Improve error msg
[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#
52a9d53b 16# This script is invoked as part of 'make all'
151c3fe5 17#
f554dfc5
MH
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.
94bdecf9 24
1fcde0e9
KW
25# The meanings of the flags fields in embed.fnc and the source code is
26# documented at the top of embed.fnc.
27
56a0c332 28use strict;
a64c954a 29
7882b24a
NC
30if (@ARGV) {
31 my $workdir = shift;
32 chdir $workdir
33 or die "Couldn't chdir to '$workdir': $!";
34}
3d7c117d
MB
35require './regen/regen_lib.pl';
36require './regen/embed_lib.pl';
7882b24a 37
94bdecf9 38#
346f75ff 39# See database of global and static function prototypes in embed.fnc
94bdecf9
JH
40# This is used to generate prototype headers under various configurations,
41# export symbols lists for different platforms, and macros to provide an
42# implicit interpreter context argument.
43#
44
6a235718 45my %docs;
5ce57792 46my %funcflags;
5ce57792 47my %missing;
94bdecf9
JH
48
49my $curheader = "Unknown section";
50
51sub autodoc ($$) { # parse a file and extract documentation info
52 my($fh,$file) = @_;
151c3fe5 53 my($in, $doc, $line, $header_doc);
f554dfc5
MH
54
55 # Count lines easier
56 my $get_next_line = sub { $line++; return <$fh> };
57
94bdecf9 58FUNC:
f554dfc5 59 while (defined($in = $get_next_line->())) {
94bdecf9
JH
60 if ($in=~ /^=head1 (.*)/) {
61 $curheader = $1;
151c3fe5 62
f554dfc5 63 # If the next non-space line begins with a word char, then it is
1c82f4a4 64 # the start of heading-level documentation.
20046047 65 if (defined($doc = $get_next_line->())) {
f554dfc5
MH
66 # Skip over empty lines
67 while ($doc =~ /^\s+$/) {
68 if (! defined($doc = $get_next_line->())) {
69 next FUNC;
70 }
71 }
72
151c3fe5
KW
73 if ($doc !~ /^\w/) {
74 $in = $doc;
75 redo FUNC;
76 }
77 $header_doc = $doc;
151c3fe5
KW
78
79 # Continue getting the heading-level documentation until read
80 # in any pod directive (or as a fail-safe, find a closing
81 # comment to this pod in a C language file
82HDR_DOC:
f554dfc5 83 while (defined($doc = $get_next_line->())) {
151c3fe5
KW
84 if ($doc =~ /^=\w/) {
85 $in = $doc;
86 redo FUNC;
87 }
151c3fe5
KW
88
89 if ($doc =~ m:^\s*\*/$:) {
90 warn "=cut missing? $file:$line:$doc";;
91 last HDR_DOC;
92 }
93 $header_doc .= $doc;
94 }
95 }
94bdecf9
JH
96 next FUNC;
97 }
20046047
KE
98 if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
99 my $proto_in_file = $1;
100 my $proto = $proto_in_file;
101 $proto = "||$proto" unless $proto =~ /\|/;
102 my($flags, $ret, $name, @args) = split /\s*\|\s*/, $proto;
256dda50
TC
103 $name or die <<EOS;
104Bad apidoc at $file line $.:
105 $in
106Expected:
107 =for apidoc flags|returntype|name|arg|arg|...
108 =for apidoc flags|returntype|name
109 =for apidoc name
110EOS
0a60f600
KW
111 warn ("'$name' not \\w+ in '$proto_in_file' in $file")
112 if $flags !~ /N/ && $name !~ / ^ [_[:alpha:]] \w* $ /x;
20046047 113 my $docs = "";
94bdecf9 114DOC:
20046047 115 while (defined($doc = $get_next_line->())) {
72d4186d
KW
116
117 # Other pod commands are considered part of the current
118 # function's docs, so can have lists, etc.
119 last DOC if $doc =~ /^=(cut|for\s+apidoc|head)/;
20046047
KE
120 if ($doc =~ m:^\*/$:) {
121 warn "=cut missing? $file:$line:$doc";;
122 last DOC;
72d4186d 123 }
20046047
KE
124 $docs .= $doc;
125 }
126 $docs = "\n$docs" if $docs and $docs !~ /^\n/;
5ce57792 127
20046047 128 # If the entry is also in embed.fnc, it should be defined
8902d554 129 # completely there, but not here
20046047
KE
130 my $embed_docref = delete $funcflags{$name};
131 if ($embed_docref and %$embed_docref) {
8902d554
KW
132 warn "embed.fnc entry overrides redundant information in"
133 . " '$proto_in_file' in $file" if $flags || $ret || @args;
134 $flags = $embed_docref->{'flags'};
5514c4f1
KW
135 warn "embed.fnc entry '$name' missing 'd' flag"
136 unless $flags =~ /d/;
8902d554 137 $ret = $embed_docref->{'retval'};
20046047 138 @args = @{$embed_docref->{args}};
5514c4f1
KW
139 } elsif ($flags !~ /m/) { # Not in embed.fnc, is missing if not a
140 # macro
20046047
KE
141 $missing{$name} = $file;
142 }
5ce57792 143
8902d554 144 my $inline_where = $flags =~ /A/ ? 'api' : 'guts';
5ce57792 145
20046047 146 if (exists $docs{$inline_where}{$curheader}{$name}) {
7a6610ca
DM
147 warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n";
148 next;
149 }
20046047
KE
150 $docs{$inline_where}{$curheader}{$name}
151 = [$flags, $docs, $ret, $file, @args];
5ce57792 152
151c3fe5
KW
153 # Create a special entry with an empty-string name for the
154 # heading-level documentation.
20046047 155 if (defined $header_doc) {
151c3fe5
KW
156 $docs{$inline_where}{$curheader}{""} = $header_doc;
157 undef $header_doc;
158 }
159
20046047
KE
160 if (defined $doc) {
161 if ($doc =~ /^=(?:for|head)/) {
162 $in = $doc;
163 redo FUNC;
164 }
165 } else {
166 warn "$file:$line:$in";
167 }
168 }
94bdecf9
JH
169 }
170}
171
172sub docout ($$$) { # output the docs for one function
173 my($fh, $name, $docref) = @_;
174 my($flags, $docs, $ret, $file, @args) = @$docref;
d8c40edc 175 $name =~ s/\s*$//;
94bdecf9 176
d4e99c76
KW
177 if ($flags =~ /D/) {
178 $docs = "\n\nDEPRECATED! It is planned to remove this function from a
179future release of Perl. Do not use it for new code; remove it from
180existing code.\n\n$docs";
181 }
182 else {
58a428bb
KW
183 $docs = "\n\nNOTE: this function is experimental and may change or be
184removed without notice.\n\n$docs" if $flags =~ /x/;
d4e99c76 185 }
54c193ae
KW
186
187 # Is Perl_, but no #define foo # Perl_foo
188 my $p = $flags =~ /p/ && $flags =~ /o/ && $flags !~ /M/;
189
94bdecf9 190 $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
20046047 191 if $flags =~ /O/;
54c193ae
KW
192 if ($p) {
193 $docs .= "NOTE: this function must be explicitly called as Perl_$name";
d7cc3209 194 $docs .= " with an aTHX_ parameter" if $flags !~ /T/;
54c193ae
KW
195 $docs .= ".\n\n"
196 }
94bdecf9 197
d8c40edc 198 print $fh "=item $name\nX<$name>\n$docs";
94bdecf9
JH
199
200 if ($flags =~ /U/) { # no usage
8b5ff177 201 warn("U and s flags are incompatible") if $flags =~ /s/;
20046047 202 # nothing
05ca4832 203 } else {
8b5ff177 204 if ($flags =~ /n/) { # no args
1fcde0e9
KW
205 warn("n flag without m") unless $flags =~ /m/;
206 warn("n flag but apparently has args") if @args;
1ded1f42
KW
207 print $fh "\t$ret\t$name";
208 } else { # full usage
1ded1f42
KW
209 my $n = "Perl_"x$p . $name;
210 my $large_ret = length $ret > 7;
211 my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item
212 +8+($large_ret ? 1 + length $ret : 8)
213 +length($n) + 1;
214 my $indent;
215 print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n(";
216 my $long_args;
217 for (@args) {
218 if ($indent_size + 2 + length > 79) {
219 $long_args=1;
220 $indent_size -= length($n) - 3;
221 last;
222 }
223 }
224 my $args = '';
d7cc3209 225 if ($p && $flags !~ /T/) {
1ded1f42
KW
226 $args = @args ? "pTHX_ " : "pTHX";
227 if ($long_args) { print $fh $args; $args = '' }
228 }
229 $long_args and print $fh "\n";
230 my $first = !$long_args;
231 while () {
232 if (!@args or
233 length $args
234 && $indent_size + 3 + length($args[0]) + length $args > 79
235 ) {
236 print $fh
237 $first ? '' : (
238 $indent //=
239 "\t".($large_ret ? " " x (1+length $ret) : "\t")
240 ." "x($long_args ? 4 : 1 + length $n)
241 ),
242 $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args;
243 $args = $first = '';
244 }
245 @args or last;
246 $args .= ", "x!!(length $args && $args ne 'pTHX_ ')
247 . shift @args;
248 }
249 if ($long_args) { print $fh "\n", substr $indent, 0, -4 }
250 print $fh ")";
251 }
8b5ff177 252 print $fh ";" if $flags =~ /s/; # semicolon "dTHR;"
1ded1f42 253 print $fh "\n\n";
94bdecf9
JH
254 }
255 print $fh "=for hackers\nFound in file $file\n\n";
256}
257
f83c6033
KW
258sub sort_helper {
259 # Do a case-insensitive dictionary sort, with only alphabetics
260 # significant, falling back to using everything for determinancy
1354d57e 261 return (uc($a =~ s/[[:^alpha:]]//r) cmp uc($b =~ s/[[:^alpha:]]//r))
f83c6033
KW
262 || uc($a) cmp uc($b)
263 || $a cmp $b;
264}
265
7b73ff98 266sub output {
5a0155e6 267 my ($podname, $header, $dochash, $missing, $footer) = @_;
6a4c4cd4
DM
268 #
269 # strip leading '|' from each line which had been used to hide
270 # pod from pod checkers.
271 s/^\|//gm for $header, $footer;
272
7882b24a 273 my $fh = open_new("pod/$podname.pod", undef,
20046047 274 {by => "$0 extracting documentation",
f1f44974 275 from => 'the C source files'}, 1);
e0492643 276
7882b24a 277 print $fh $header;
e0492643 278
7b73ff98 279 my $key;
f83c6033 280 for $key (sort sort_helper keys %$dochash) {
20046047
KE
281 my $section = $dochash->{$key};
282 print $fh "\n=head1 $key\n\n";
151c3fe5
KW
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 }
20046047 290 print $fh "=over 8\n\n";
151c3fe5 291
20046047
KE
292 for my $key (sort sort_helper keys %$section) {
293 docout($fh, $key, $section->{$key});
294 }
295 print $fh "\n=back\n";
7b73ff98
NC
296 }
297
5a0155e6 298 if (@$missing) {
a23e6e20 299 print $fh "\n=head1 Undocumented functions\n\n";
2616800a 300 print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_';
474d0ac8 301The following functions have been flagged as part of the public API,
72d33970 302but are currently undocumented. Use them at your own risk, as the
ba4591a5
KW
303interfaces are subject to change. Functions that are not listed in this
304document are not intended for public use, and should NOT be used under any
305circumstances.
306
5a4fed09
KW
307If you feel you need to use one of these functions, first send email to
308L<perl5-porters@perl.org|mailto:perl5-porters@perl.org>. It may be
309that there is a good reason for the function not being documented, and it
310should be removed from this list; or it may just be that no one has gotten
311around to documenting it. In the latter case, you will be asked to submit a
312patch to document the function. Once your patch is accepted, it will indicate
313that the interface is stable (unless it is explicitly marked otherwise) and
314usable by you.
cf5f2f8f 315_EOB_
2616800a
FC
316The following functions are currently undocumented. If you use one of
317them, you may wish to consider creating and submitting documentation for
318it.
2616800a 319_EOB_
6a4c4cd4
DM
320 print $fh "\n=over\n\n";
321
cf5f2f8f
KW
322 for my $missing (sort @$missing) {
323 print $fh "=item $missing\nX<$missing>\n\n";
5a0155e6 324 }
cf5f2f8f
KW
325 print $fh "=back\n\n";
326}
7882b24a 327 print $fh $footer, "=cut\n";
5a0155e6 328
7882b24a 329 read_only_bottom_close_and_rename($fh);
cd093254
MM
330}
331
e8e591c9
NC
332foreach (@{(setup_embed())[0]}) {
333 next if @$_ < 2;
334 my ($flags, $retval, $func, @args) = @$_;
335 s/\b(?:NN|NULLOK)\b\s+//g for @args;
bc350081 336
5ce57792 337 $funcflags{$func} = {
20046047
KE
338 flags => $flags,
339 retval => $retval,
340 args => \@args,
341 };
5ce57792
NC
342}
343
5ce57792
NC
344# glob() picks up docs from extra .c or .h files that may be in unclean
345# development trees.
741c0772
NC
346open my $fh, '<', 'MANIFEST'
347 or die "Can't open MANIFEST: $!";
348while (my $line = <$fh>) {
349 next unless my ($file) = $line =~ /^(\S+\.[ch])\t/;
5ce57792 350
1ae6ead9 351 open F, '<', $file or die "Cannot open $file for docs: $!\n";
5ce57792
NC
352 $curheader = "Functions in file $file\n";
353 autodoc(\*F,$file);
354 close F or die "Error closing $file: $!\n";
355}
741c0772 356close $fh or die "Error whilst reading MANIFEST: $!";
5ce57792
NC
357
358for (sort keys %funcflags) {
359 next unless $funcflags{$_}{flags} =~ /d/;
360 warn "no docs for $_\n"
bc350081 361}
94bdecf9 362
5ce57792 363foreach (sort keys %missing) {
5ce57792 364 warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
94bdecf9
JH
365}
366
5ce57792
NC
367# walk table providing an array of components in each line to
368# subroutine, printing the result
369
8c869419
KW
370# List of funcs in the public API that aren't also marked as experimental nor
371# deprecated.
e4aeb12f 372my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[xD]/ && !$docs{api}{$_}, keys %funcflags;
5a0155e6 373output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
6a4c4cd4
DM
374|=encoding UTF-8
375|
376|=head1 NAME
377|
378|perlapi - autogenerated documentation for the perl public API
379|
380|=head1 DESCRIPTION
381|X<Perl API> X<API> X<api>
382|
383|This file contains the documentation of the perl public API generated by
384|F<embed.pl>, specifically a listing of functions, macros, flags, and variables
385|that may be used by extension writers. L<At the end|/Undocumented functions>
386|is a list of functions which have yet to be documented. The interfaces of
387|those are subject to change without notice. Anything not listed here is
388|not part of the public API, and should not be used by extension writers at
389|all. For these reasons, blindly using functions listed in proto.h is to be
390|avoided when writing extensions.
391|
392|In Perl, unlike C, a string of characters may generally contain embedded
393|C<NUL> characters. Sometimes in the documentation a Perl string is referred
394|to as a "buffer" to distinguish it from a C string, but sometimes they are
395|both just referred to as strings.
396|
397|Note that all Perl API global variables must be referenced with the C<PL_>
398|prefix. Again, those not listed here are not to be used by extension writers,
399|and can be changed or removed without notice; same with macros.
400|Some macros are provided for compatibility with the older,
401|unadorned names, but this support may be disabled in a future release.
402|
403|Perl was originally written to handle US-ASCII only (that is characters
404|whose ordinal numbers are in the range 0 - 127).
405|And documentation and comments may still use the term ASCII, when
406|sometimes in fact the entire range from 0 - 255 is meant.
407|
408|The non-ASCII characters below 256 can have various meanings, depending on
409|various things. (See, most notably, L<perllocale>.) But usually the whole
410|range can be referred to as ISO-8859-1. Often, the term "Latin-1" (or
411|"Latin1") is used as an equivalent for ISO-8859-1. But some people treat
412|"Latin1" as referring just to the characters in the range 128 through 255, or
413|somethimes from 160 through 255.
414|This documentation uses "Latin1" and "Latin-1" to refer to all 256 characters.
415|
416|Note that Perl can be compiled and run under either ASCII or EBCDIC (See
417|L<perlebcdic>). Most of the documentation (and even comments in the code)
418|ignore the EBCDIC possibility.
419|For almost all purposes the differences are transparent.
420|As an example, under EBCDIC,
421|instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
422|whenever this documentation refers to C<utf8>
423|(and variants of that name, including in function names),
424|it also (essentially transparently) means C<UTF-EBCDIC>.
425|But the ordinals of characters differ between ASCII, EBCDIC, and
426|the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different
427|number of bytes than in UTF-8.
428|
429|The listing below is alphabetical, case insensitive.
430|
94bdecf9 431_EOB_
6a4c4cd4
DM
432|
433|=head1 AUTHORS
434|
435|Until May 1997, this document was maintained by Jeff Okamoto
436|<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
437|
438|With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
439|Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
440|Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
441|Stephen McCamant, and Gurusamy Sarathy.
442|
443|API Listing originally by Dean Roehrich <roehrich@cray.com>.
444|
445|Updated to be autogenerated from comments in the source by Benjamin Stuhl.
446|
447|=head1 SEE ALSO
448|
449|L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern>
450|
94bdecf9
JH
451_EOE_
452
79fc8511
FC
453# List of non-static internal functions
454my @missing_guts =
9f589e47 455 grep $funcflags{$_}{flags} !~ /[AS]/ && !$docs{guts}{$_}, keys %funcflags;
5a0155e6
TC
456
457output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END');
6a4c4cd4
DM
458|=head1 NAME
459|
460|perlintern - autogenerated documentation of purely B<internal>
20046047 461|Perl functions
6a4c4cd4
DM
462|
463|=head1 DESCRIPTION
464|X<internal Perl functions> X<interpreter functions>
465|
466|This file is the autogenerated documentation of functions in the
467|Perl interpreter that are documented using Perl's internal documentation
468|format but are not marked as part of the Perl API. In other words,
469|B<they are not for use in extensions>!
470|
94bdecf9 471END
6a4c4cd4
DM
472|
473|=head1 AUTHORS
474|
475|The autodocumentation system was originally added to the Perl core by
476|Benjamin Stuhl. Documentation is by whoever was kind enough to
477|document their functions.
478|
479|=head1 SEE ALSO
480|
481|L<perlguts>, L<perlapi>
482|
94bdecf9 483END