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