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