Commit | Line | Data |
94bdecf9 |
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 |
6 | BEGIN { |
7 | push @INC, 'lib'; |
9ad884cb |
8 | require 'regen_lib.pl'; |
69e39a9a |
9 | } |
a64c954a |
10 | |
11 | |
94bdecf9 |
12 | # |
346f75ff |
13 | # See database of global and static function prototypes in embed.fnc |
94bdecf9 |
14 | # This is used to generate prototype headers under various configurations, |
15 | # export symbols lists for different platforms, and macros to provide an |
16 | # implicit interpreter context argument. |
17 | # |
18 | |
19 | open IN, "embed.fnc" or die $!; |
20 | |
21 | # walk table providing an array of components in each line to |
22 | # subroutine, printing the result |
23 | sub walk_table (&@) { |
24 | my $function = shift; |
25 | my $filename = shift || '-'; |
26 | my $leader = shift; |
27 | my $trailer = shift; |
28 | my $F; |
29 | local *F; |
30 | if (ref $filename) { # filehandle |
31 | $F = $filename; |
32 | } |
33 | else { |
36bb303b |
34 | safer_unlink $filename; |
94bdecf9 |
35 | open F, ">$filename" or die "Can't open $filename: $!"; |
36 | $F = \*F; |
37 | } |
38 | print $F $leader if $leader; |
39 | seek IN, 0, 0; # so we may restart |
40 | while (<IN>) { |
41 | chomp; |
42 | next if /^:/; |
78c9d763 |
43 | while (s|\\\s*$||) { |
94bdecf9 |
44 | $_ .= <IN>; |
45 | chomp; |
46 | } |
47 | my @args; |
48 | if (/^\s*(#|$)/) { |
49 | @args = $_; |
50 | } |
51 | else { |
52 | @args = split /\s*\|\s*/, $_; |
53 | } |
54 | print $F $function->(@args); |
55 | } |
56 | print $F $trailer if $trailer; |
36bb303b |
57 | unless (ref $filename) { |
58 | close $F or die "Error closing $filename: $!"; |
59 | } |
94bdecf9 |
60 | } |
61 | |
62 | my %apidocs; |
63 | my %gutsdocs; |
64 | my %docfuncs; |
65 | |
66 | my $curheader = "Unknown section"; |
67 | |
68 | sub autodoc ($$) { # parse a file and extract documentation info |
69 | my($fh,$file) = @_; |
70 | my($in, $doc, $line); |
71 | FUNC: |
72 | while (defined($in = <$fh>)) { |
73 | if ($in=~ /^=head1 (.*)/) { |
74 | $curheader = $1; |
75 | next FUNC; |
76 | } |
77 | $line++; |
78c9d763 |
78 | if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) { |
94bdecf9 |
79 | my $proto = $1; |
80 | $proto = "||$proto" unless $proto =~ /\|/; |
81 | my($flags, $ret, $name, @args) = split /\|/, $proto; |
82 | my $docs = ""; |
83 | DOC: |
84 | while (defined($doc = <$fh>)) { |
94bdecf9 |
85 | $line++; |
86 | last DOC if $doc =~ /^=\w+/; |
87 | if ($doc =~ m:^\*/$:) { |
88 | warn "=cut missing? $file:$line:$doc";; |
89 | last DOC; |
90 | } |
91 | $docs .= $doc; |
92 | } |
93 | $docs = "\n$docs" if $docs and $docs !~ /^\n/; |
94 | if ($flags =~ /m/) { |
95 | if ($flags =~ /A/) { |
96 | $apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args]; |
97 | } |
98 | else { |
99 | $gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args]; |
100 | } |
101 | } |
102 | else { |
103 | $docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args]; |
104 | } |
105 | if (defined $doc) { |
e509e693 |
106 | if ($doc =~ /^=(?:for|head)/) { |
94bdecf9 |
107 | $in = $doc; |
108 | redo FUNC; |
109 | } |
110 | } else { |
111 | warn "$file:$line:$in"; |
112 | } |
113 | } |
114 | } |
115 | } |
116 | |
117 | sub docout ($$$) { # output the docs for one function |
118 | my($fh, $name, $docref) = @_; |
119 | my($flags, $docs, $ret, $file, @args) = @$docref; |
120 | |
121 | $docs .= "NOTE: this function is experimental and may change or be |
122 | removed without notice.\n\n" if $flags =~ /x/; |
123 | $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" |
124 | if $flags =~ /p/; |
125 | |
126 | print $fh "=item $name\n$docs"; |
127 | |
128 | if ($flags =~ /U/) { # no usage |
129 | # nothing |
130 | } elsif ($flags =~ /s/) { # semicolon ("dTHR;") |
131 | print $fh "\t\t$name;\n\n"; |
132 | } elsif ($flags =~ /n/) { # no args |
133 | print $fh "\t$ret\t$name\n\n"; |
134 | } else { # full usage |
135 | print $fh "\t$ret\t$name"; |
136 | print $fh "(" . join(", ", @args) . ")"; |
137 | print $fh "\n\n"; |
138 | } |
139 | print $fh "=for hackers\nFound in file $file\n\n"; |
140 | } |
141 | |
142 | my $file; |
69e39a9a |
143 | # glob() picks up docs from extra .c or .h files that may be in unclean |
144 | # development trees. |
145 | my $MANIFEST = do { |
146 | local ($/, *FH); |
147 | open FH, "MANIFEST" or die "Can't open MANIFEST: $!"; |
148 | <FH>; |
149 | }; |
150 | |
151 | for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) { |
94bdecf9 |
152 | open F, "< $file" or die "Cannot open $file for docs: $!\n"; |
153 | $curheader = "Functions in file $file\n"; |
154 | autodoc(\*F,$file); |
155 | close F or die "Error closing $file: $!\n"; |
156 | } |
157 | |
36bb303b |
158 | safer_unlink "pod/perlapi.pod"; |
94bdecf9 |
159 | open (DOC, ">pod/perlapi.pod") or |
160 | die "Can't create pod/perlapi.pod: $!\n"; |
161 | |
162 | walk_table { # load documented functions into approriate hash |
163 | if (@_ > 1) { |
164 | my($flags, $retval, $func, @args) = @_; |
165 | return "" unless $flags =~ /d/; |
166 | $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl |
167 | $retval =~ s/\t//; |
78c9d763 |
168 | my $docref = delete $docfuncs{$func}; |
169 | if ($docref and @$docref) { |
170 | if ($flags =~ /A/) { |
171 | $docref->[0].="x" if $flags =~ /M/; |
172 | $apidocs{$docref->[4]}{$func} = |
173 | [$docref->[0] . 'A', $docref->[1], $retval, |
174 | $docref->[3], @args]; |
175 | } else { |
176 | $gutsdocs{$docref->[4]}{$func} = |
177 | [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; |
178 | } |
179 | } |
180 | else { |
94bdecf9 |
181 | warn "no docs for $func\n" unless $docref and @$docref; |
94bdecf9 |
182 | } |
183 | } |
184 | return ""; |
185 | } \*DOC; |
186 | |
187 | for (sort keys %docfuncs) { |
188 | # Have you used a full for apidoc or just a func name? |
189 | # Have you used Ap instead of Am in the for apidoc? |
190 | warn "Unable to place $_!\n"; |
191 | } |
192 | |
193 | print DOC <<'_EOB_'; |
194 | =head1 NAME |
195 | |
196 | perlapi - autogenerated documentation for the perl public API |
197 | |
198 | =head1 DESCRIPTION |
199 | |
200 | This file contains the documentation of the perl public API generated by |
201 | embed.pl, specifically a listing of functions, macros, flags, and variables |
202 | that may be used by extension writers. The interfaces of any functions that |
203 | are not listed here are subject to change without notice. For this reason, |
204 | blindly using functions listed in proto.h is to be avoided when writing |
205 | extensions. |
206 | |
207 | Note that all Perl API global variables must be referenced with the C<PL_> |
208 | prefix. Some macros are provided for compatibility with the older, |
209 | unadorned names, but this support may be disabled in a future release. |
210 | |
211 | The listing is alphabetical, case insensitive. |
212 | |
213 | _EOB_ |
214 | |
215 | my $key; |
6a477168 |
216 | # case insensitive sort, with fallback for determinacy |
217 | for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) { |
94bdecf9 |
218 | my $section = $apidocs{$key}; |
219 | print DOC "\n=head1 $key\n\n=over 8\n\n"; |
220 | for my $key (sort { uc($a) cmp uc($b); } keys %$section) { |
221 | docout(\*DOC, $key, $section->{$key}); |
222 | } |
223 | print DOC "\n=back\n"; |
224 | } |
225 | |
226 | print DOC <<'_EOE_'; |
227 | |
228 | =head1 AUTHORS |
229 | |
230 | Until May 1997, this document was maintained by Jeff Okamoto |
231 | <okamoto@corp.hp.com>. It is now maintained as part of Perl itself. |
232 | |
233 | With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, |
234 | Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil |
235 | Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, |
236 | Stephen McCamant, and Gurusamy Sarathy. |
237 | |
238 | API Listing originally by Dean Roehrich <roehrich@cray.com>. |
239 | |
240 | Updated to be autogenerated from comments in the source by Benjamin Stuhl. |
241 | |
242 | =head1 SEE ALSO |
243 | |
244 | perlguts(1), perlxs(1), perlxstut(1), perlintern(1) |
245 | |
246 | _EOE_ |
247 | |
248 | |
36bb303b |
249 | close(DOC) or die "Error closing pod/perlapi.pod: $!"; |
94bdecf9 |
250 | |
36bb303b |
251 | safer_unlink "pod/perlintern.pod"; |
94bdecf9 |
252 | open(GUTS, ">pod/perlintern.pod") or |
253 | die "Unable to create pod/perlintern.pod: $!\n"; |
254 | print GUTS <<'END'; |
255 | =head1 NAME |
256 | |
257 | perlintern - autogenerated documentation of purely B<internal> |
258 | Perl functions |
259 | |
260 | =head1 DESCRIPTION |
261 | |
262 | This file is the autogenerated documentation of functions in the |
263 | Perl interpreter that are documented using Perl's internal documentation |
264 | format but are not marked as part of the Perl API. In other words, |
265 | B<they are not for use in extensions>! |
266 | |
267 | END |
268 | |
269 | for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) { |
270 | my $section = $gutsdocs{$key}; |
271 | print GUTS "\n=head1 $key\n\n=over 8\n\n"; |
272 | for my $key (sort { uc($a) cmp uc($b); } keys %$section) { |
273 | docout(\*GUTS, $key, $section->{$key}); |
274 | } |
275 | print GUTS "\n=back\n"; |
276 | } |
277 | |
278 | print GUTS <<'END'; |
279 | |
280 | =head1 AUTHORS |
281 | |
282 | The autodocumentation system was originally added to the Perl core by |
283 | Benjamin Stuhl. Documentation is by whoever was kind enough to |
284 | document their functions. |
285 | |
286 | =head1 SEE ALSO |
287 | |
288 | perlguts(1), perlapi(1) |
289 | |
290 | END |
291 | |
36bb303b |
292 | close GUTS or die "Error closing pod/perlintern.pod: $!"; |