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