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