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