This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #18113] UNIVERSAL::AUTOLOAD doesn't work if the stash doesn't exist yet
[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 /^:/;
78c9d763 39 while (s|\\\s*$||) {
94bdecf9
JH
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++;
78c9d763 72 if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
94bdecf9
JH
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//;
78c9d763
DM
158 my $docref = delete $docfuncs{$func};
159 if ($docref and @$docref) {
160 if ($flags =~ /A/) {
161 $docref->[0].="x" if $flags =~ /M/;
162 $apidocs{$docref->[4]}{$func} =
163 [$docref->[0] . 'A', $docref->[1], $retval,
164 $docref->[3], @args];
165 } else {
166 $gutsdocs{$docref->[4]}{$func} =
167 [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
168 }
169 }
170 else {
94bdecf9 171 warn "no docs for $func\n" unless $docref and @$docref;
94bdecf9
JH
172 }
173 }
174 return "";
175} \*DOC;
176
177for (sort keys %docfuncs) {
178 # Have you used a full for apidoc or just a func name?
179 # Have you used Ap instead of Am in the for apidoc?
180 warn "Unable to place $_!\n";
181}
182
183print DOC <<'_EOB_';
184=head1 NAME
185
186perlapi - autogenerated documentation for the perl public API
187
188=head1 DESCRIPTION
189
190This file contains the documentation of the perl public API generated by
191embed.pl, specifically a listing of functions, macros, flags, and variables
192that may be used by extension writers. The interfaces of any functions that
193are not listed here are subject to change without notice. For this reason,
194blindly using functions listed in proto.h is to be avoided when writing
195extensions.
196
197Note that all Perl API global variables must be referenced with the C<PL_>
198prefix. Some macros are provided for compatibility with the older,
199unadorned names, but this support may be disabled in a future release.
200
201The listing is alphabetical, case insensitive.
202
203_EOB_
204
205my $key;
206for $key (sort { uc($a) cmp uc($b); } keys %apidocs) { # case insensitive sort
207 my $section = $apidocs{$key};
208 print DOC "\n=head1 $key\n\n=over 8\n\n";
209 for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
210 docout(\*DOC, $key, $section->{$key});
211 }
212 print DOC "\n=back\n";
213}
214
215print DOC <<'_EOE_';
216
217=head1 AUTHORS
218
219Until May 1997, this document was maintained by Jeff Okamoto
220<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
221
222With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
223Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
224Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
225Stephen McCamant, and Gurusamy Sarathy.
226
227API Listing originally by Dean Roehrich <roehrich@cray.com>.
228
229Updated to be autogenerated from comments in the source by Benjamin Stuhl.
230
231=head1 SEE ALSO
232
233perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
234
235_EOE_
236
237
238close(DOC);
239
240open(GUTS, ">pod/perlintern.pod") or
241 die "Unable to create pod/perlintern.pod: $!\n";
242print GUTS <<'END';
243=head1 NAME
244
245perlintern - autogenerated documentation of purely B<internal>
246 Perl functions
247
248=head1 DESCRIPTION
249
250This file is the autogenerated documentation of functions in the
251Perl interpreter that are documented using Perl's internal documentation
252format but are not marked as part of the Perl API. In other words,
253B<they are not for use in extensions>!
254
255END
256
257for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
258 my $section = $gutsdocs{$key};
259 print GUTS "\n=head1 $key\n\n=over 8\n\n";
260 for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
261 docout(\*GUTS, $key, $section->{$key});
262 }
263 print GUTS "\n=back\n";
264}
265
266print GUTS <<'END';
267
268=head1 AUTHORS
269
270The autodocumentation system was originally added to the Perl core by
271Benjamin Stuhl. Documentation is by whoever was kind enough to
272document their functions.
273
274=head1 SEE ALSO
275
276perlguts(1), perlapi(1)
277
278END
279
280close GUTS;
281