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 | ||
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 |