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