This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Encourage compilers to tail call optimise in sv_savepv, sv_savepvn
[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
36bb303b
NC
6BEGIN {
7 push @INC, 'lib';
9ad884cb 8 require 'regen_lib.pl';
36bb303b 9} # glob() below requires File::Glob
a64c954a
IZ
10
11
94bdecf9 12#
346f75ff 13# See database of global and static function prototypes in embed.fnc
94bdecf9
JH
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
19open IN, "embed.fnc" or die $!;
20
21# walk table providing an array of components in each line to
22# subroutine, printing the result
23sub 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
JH
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
JH
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
NC
57 unless (ref $filename) {
58 close $F or die "Error closing $filename: $!";
59 }
94bdecf9
JH
60}
61
62my %apidocs;
63my %gutsdocs;
64my %docfuncs;
65
66my $curheader = "Unknown section";
67
68sub autodoc ($$) { # parse a file and extract documentation info
69 my($fh,$file) = @_;
70 my($in, $doc, $line);
71FUNC:
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
JH
79 my $proto = $1;
80 $proto = "||$proto" unless $proto =~ /\|/;
81 my($flags, $ret, $name, @args) = split /\|/, $proto;
82 my $docs = "";
83DOC:
84 while (defined($doc = <$fh>)) {
94bdecf9
JH
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
JH
107 $in = $doc;
108 redo FUNC;
109 }
110 } else {
111 warn "$file:$line:$in";
112 }
113 }
114 }
115}
116
117sub 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
122removed 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
142my $file;
143for $file (glob('*.c'), glob('*.h')) {
144 open F, "< $file" or die "Cannot open $file for docs: $!\n";
145 $curheader = "Functions in file $file\n";
146 autodoc(\*F,$file);
147 close F or die "Error closing $file: $!\n";
148}
149
36bb303b 150safer_unlink "pod/perlapi.pod";
94bdecf9
JH
151open (DOC, ">pod/perlapi.pod") or
152 die "Can't create pod/perlapi.pod: $!\n";
153
154walk_table { # load documented functions into approriate hash
155 if (@_ > 1) {
156 my($flags, $retval, $func, @args) = @_;
157 return "" unless $flags =~ /d/;
158 $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
159 $retval =~ s/\t//;
78c9d763
DM
160 my $docref = delete $docfuncs{$func};
161 if ($docref and @$docref) {
162 if ($flags =~ /A/) {
163 $docref->[0].="x" if $flags =~ /M/;
164 $apidocs{$docref->[4]}{$func} =
165 [$docref->[0] . 'A', $docref->[1], $retval,
166 $docref->[3], @args];
167 } else {
168 $gutsdocs{$docref->[4]}{$func} =
169 [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
170 }
171 }
172 else {
94bdecf9 173 warn "no docs for $func\n" unless $docref and @$docref;
94bdecf9
JH
174 }
175 }
176 return "";
177} \*DOC;
178
179for (sort keys %docfuncs) {
180 # Have you used a full for apidoc or just a func name?
181 # Have you used Ap instead of Am in the for apidoc?
182 warn "Unable to place $_!\n";
183}
184
185print DOC <<'_EOB_';
186=head1 NAME
187
188perlapi - autogenerated documentation for the perl public API
189
190=head1 DESCRIPTION
191
192This file contains the documentation of the perl public API generated by
193embed.pl, specifically a listing of functions, macros, flags, and variables
194that may be used by extension writers. The interfaces of any functions that
195are not listed here are subject to change without notice. For this reason,
196blindly using functions listed in proto.h is to be avoided when writing
197extensions.
198
199Note that all Perl API global variables must be referenced with the C<PL_>
200prefix. Some macros are provided for compatibility with the older,
201unadorned names, but this support may be disabled in a future release.
202
203The listing is alphabetical, case insensitive.
204
205_EOB_
206
207my $key;
6a477168
HS
208# case insensitive sort, with fallback for determinacy
209for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
94bdecf9
JH
210 my $section = $apidocs{$key};
211 print DOC "\n=head1 $key\n\n=over 8\n\n";
212 for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
213 docout(\*DOC, $key, $section->{$key});
214 }
215 print DOC "\n=back\n";
216}
217
218print DOC <<'_EOE_';
219
220=head1 AUTHORS
221
222Until May 1997, this document was maintained by Jeff Okamoto
223<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
224
225With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
226Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
227Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
228Stephen McCamant, and Gurusamy Sarathy.
229
230API Listing originally by Dean Roehrich <roehrich@cray.com>.
231
232Updated to be autogenerated from comments in the source by Benjamin Stuhl.
233
234=head1 SEE ALSO
235
236perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
237
238_EOE_
239
240
36bb303b 241close(DOC) or die "Error closing pod/perlapi.pod: $!";
94bdecf9 242
36bb303b 243safer_unlink "pod/perlintern.pod";
94bdecf9
JH
244open(GUTS, ">pod/perlintern.pod") or
245 die "Unable to create pod/perlintern.pod: $!\n";
246print GUTS <<'END';
247=head1 NAME
248
249perlintern - autogenerated documentation of purely B<internal>
250 Perl functions
251
252=head1 DESCRIPTION
253
254This file is the autogenerated documentation of functions in the
255Perl interpreter that are documented using Perl's internal documentation
256format but are not marked as part of the Perl API. In other words,
257B<they are not for use in extensions>!
258
259END
260
261for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
262 my $section = $gutsdocs{$key};
263 print GUTS "\n=head1 $key\n\n=over 8\n\n";
264 for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
265 docout(\*GUTS, $key, $section->{$key});
266 }
267 print GUTS "\n=back\n";
268}
269
270print GUTS <<'END';
271
272=head1 AUTHORS
273
274The autodocumentation system was originally added to the Perl core by
275Benjamin Stuhl. Documentation is by whoever was kind enough to
276document their functions.
277
278=head1 SEE ALSO
279
280perlguts(1), perlapi(1)
281
282END
283
36bb303b 284close GUTS or die "Error closing pod/perlintern.pod: $!";