This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
re_eval: clear lexicals in the right pad
[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(";
198 my $args = $p ? @args ? "pTHX_ " : "pTHX" : '';
199 my $first = 1;
200 while () {
201 if (!@args or
202 length $args
203 && $indent_size + 3 + length($args[0]) + length $args > 80
204 ) {
205 print $fh
206 $first ? '' : (
207 $indent //=
208 "\t".($large_ret ? " " x (1+length $ret) : "\t")
209 ." "x(1 + length $n)
210 ),
211 $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args;
212 $args = $first = '';
213 }
214 @args or last;
215 $args .= ", "x!!(length $args && $args ne 'pTHX_ ')
216 . shift @args;
217 }
218 print $fh ")\n\n";
94bdecf9
JH
219 }
220 print $fh "=for hackers\nFound in file $file\n\n";
221}
222
7b73ff98 223sub output {
5a0155e6 224 my ($podname, $header, $dochash, $missing, $footer) = @_;
7b73ff98
NC
225 my $filename = "pod/$podname.pod";
226 open my $fh, '>', $filename or die "Can't open $filename: $!";
227
228 print $fh <<"_EOH_", $header;
e0492643
NC
229-*- buffer-read-only: t -*-
230
231!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
232This file is built by $0 extracting documentation from the C source
233files.
234
235_EOH_
e0492643 236
7b73ff98
NC
237 my $key;
238 # case insensitive sort, with fallback for determinacy
239 for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$dochash) {
240 my $section = $dochash->{$key};
151c3fe5
KW
241 print $fh "\n=head1 $key\n\n";
242
243 # Output any heading-level documentation and delete so won't get in
244 # the way later
245 if (exists $section->{""}) {
246 print $fh $section->{""} . "\n";
247 delete $section->{""};
248 }
249 print $fh "=over 8\n\n";
250
7b73ff98
NC
251 # Again, fallback for determinacy
252 for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
253 docout($fh, $key, $section->{$key});
254 }
255 print $fh "\n=back\n";
256 }
257
5a0155e6 258 if (@$missing) {
a23e6e20 259 print $fh "\n=head1 Undocumented functions\n\n";
cf5f2f8f 260 print $fh <<'_EOB_';
474d0ac8
DM
261The following functions have been flagged as part of the public API,
262but are currently undocumented. Use them at your own risk, as the
263interfaces are subject to change.
264
265If you use one of them, you may wish to consider creating and submitting
266documentation for it. If your patch is accepted, this will indicate that
267the interface is stable (unless it is explicitly marked otherwise).
cf5f2f8f
KW
268
269=over
270
271_EOB_
272 for my $missing (sort @$missing) {
273 print $fh "=item $missing\nX<$missing>\n\n";
5a0155e6 274 }
cf5f2f8f
KW
275 print $fh "=back\n\n";
276}
5a0155e6 277
cf5f2f8f 278print $fh $footer, <<'_EOF_';
e0492643
NC
279=cut
280
3f98fbb3 281 ex: set ro:
e0492643 282_EOF_
7b73ff98
NC
283
284 close $fh or die "Can't close $filename: $!";
e0492643
NC
285}
286
cd093254
MM
287if (@ARGV) {
288 my $workdir = shift;
289 chdir $workdir
290 or die "Couldn't chdir to '$workdir': $!";
291}
292
bc350081
NC
293open IN, "embed.fnc" or die $!;
294
bc350081
NC
295while (<IN>) {
296 chomp;
297 next if /^:/;
298 while (s|\\\s*$||) {
299 $_ .= <IN>;
300 chomp;
301 }
302 s/\s+$//;
303 next if /^\s*(#|$)/;
304
305 my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_;
306
bc350081
NC
307 next unless $func;
308
309 s/\b(NN|NULLOK)\b\s+//g for @args;
310 $func =~ s/\t//g; # clean up fields from embed.pl
311 $retval =~ s/\t//;
312
5ce57792
NC
313 $funcflags{$func} = {
314 flags => $flags,
315 retval => $retval,
316 args => \@args,
317 };
318}
319
320my $file;
321# glob() picks up docs from extra .c or .h files that may be in unclean
322# development trees.
323my $MANIFEST = do {
324 local ($/, *FH);
325 open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
326 <FH>;
327};
328
329for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
330 open F, "< $file" or die "Cannot open $file for docs: $!\n";
331 $curheader = "Functions in file $file\n";
332 autodoc(\*F,$file);
333 close F or die "Error closing $file: $!\n";
334}
335
336for (sort keys %funcflags) {
337 next unless $funcflags{$_}{flags} =~ /d/;
338 warn "no docs for $_\n"
bc350081 339}
94bdecf9 340
5ce57792
NC
341foreach (sort keys %missing) {
342 next if $macro{$_};
343 # Heuristics for known not-a-function macros:
344 next if /^[A-Z]/;
345 next if /^dj?[A-Z]/;
346
347 warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
94bdecf9
JH
348}
349
5ce57792
NC
350# walk table providing an array of components in each line to
351# subroutine, printing the result
352
e9ad5866
KW
353# List of funcs in the public API that aren't also marked as experimental.
354my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /M/ && !$docs{api}{$_}, keys %funcflags;
5a0155e6 355output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
94bdecf9
JH
356=head1 NAME
357
358perlapi - autogenerated documentation for the perl public API
359
360=head1 DESCRIPTION
d8c40edc 361X<Perl API> X<API> X<api>
94bdecf9
JH
362
363This file contains the documentation of the perl public API generated by
364embed.pl, specifically a listing of functions, macros, flags, and variables
cf5f2f8f
KW
365that may be used by extension writers. L<At the end|/Undocumented functions>
366is a list of functions which have yet to be documented. The interfaces of
367those are subject to change without notice. Any functions not listed here are
368not part of the public API, and should not be used by extension writers at
369all. For these reasons, blindly using functions listed in proto.h is to be
370avoided when writing extensions.
94bdecf9
JH
371
372Note that all Perl API global variables must be referenced with the C<PL_>
373prefix. Some macros are provided for compatibility with the older,
374unadorned names, but this support may be disabled in a future release.
375
2bbc8d55
SP
376Perl was originally written to handle US-ASCII only (that is characters
377whose ordinal numbers are in the range 0 - 127).
378And documentation and comments may still use the term ASCII, when
379sometimes in fact the entire range from 0 - 255 is meant.
380
381Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
382or ASCII. Most of the documentation (and even comments in the code)
383ignore the EBCDIC possibility.
384For almost all purposes the differences are transparent.
385As an example, under EBCDIC,
386instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
387whenever this documentation refers to C<utf8>
388(and variants of that name, including in function names),
389it also (essentially transparently) means C<UTF-EBCDIC>.
390But the ordinals of characters differ between ASCII, EBCDIC, and
391the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
392than in UTF-8.
393
394Also, on some EBCDIC machines, functions that are documented as operating on
395US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
396256 characters in the EBCDIC range, not just the subset corresponding to
397US-ASCII.
398
399The listing below is alphabetical, case insensitive.
94bdecf9
JH
400
401_EOB_
402
94bdecf9
JH
403=head1 AUTHORS
404
405Until May 1997, this document was maintained by Jeff Okamoto
406<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
407
408With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
409Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
410Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
411Stephen McCamant, and Gurusamy Sarathy.
412
413API Listing originally by Dean Roehrich <roehrich@cray.com>.
414
415Updated to be autogenerated from comments in the source by Benjamin Stuhl.
416
417=head1 SEE ALSO
418
b92fc6c1 419L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern>
94bdecf9
JH
420
421_EOE_
422
5a0155e6
TC
423my @missing_guts = grep $funcflags{$_}{flags} !~ /A/ && !$docs{guts}{$_}, keys %funcflags;
424
425output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END');
94bdecf9
JH
426=head1 NAME
427
428perlintern - autogenerated documentation of purely B<internal>
429 Perl functions
430
431=head1 DESCRIPTION
d8c40edc 432X<internal Perl functions> X<interpreter functions>
94bdecf9
JH
433
434This file is the autogenerated documentation of functions in the
435Perl interpreter that are documented using Perl's internal documentation
436format but are not marked as part of the Perl API. In other words,
437B<they are not for use in extensions>!
438
439END
440
94bdecf9
JH
441=head1 AUTHORS
442
443The autodocumentation system was originally added to the Perl core by
444Benjamin Stuhl. Documentation is by whoever was kind enough to
445document their functions.
446
447=head1 SEE ALSO
448
b92fc6c1 449L<perlguts>, L<perlapi>
94bdecf9
JH
450
451END