This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a section on applying a patch
[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;
08858ed2 36 $F = safer_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";
08858ed2 186my $doc = safer_open("pod/perlapi.pod");
94bdecf9 187
7eb550cf 188walk_table { # load documented functions into appropriate hash
94bdecf9
JH
189 if (@_ > 1) {
190 my($flags, $retval, $func, @args) = @_;
191 return "" unless $flags =~ /d/;
192 $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
193 $retval =~ s/\t//;
78c9d763 194 my $docref = delete $docfuncs{$func};
7eb550cf 195 $seenfuncs{$func} = 1;
78c9d763
DM
196 if ($docref and @$docref) {
197 if ($flags =~ /A/) {
198 $docref->[0].="x" if $flags =~ /M/;
7eb550cf
RGS
199 $apidocs{$docref->[4]}{$func} =
200 [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3],
201 @args];
78c9d763 202 } else {
7eb550cf 203 $gutsdocs{$docref->[4]}{$func} =
78c9d763
DM
204 [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
205 }
206 }
207 else {
7eb550cf 208 warn "no docs for $func\n" unless $seenfuncs{$func};
94bdecf9
JH
209 }
210 }
211 return "";
08858ed2 212} $doc;
94bdecf9
JH
213
214for (sort keys %docfuncs) {
215 # Have you used a full for apidoc or just a func name?
216 # Have you used Ap instead of Am in the for apidoc?
217 warn "Unable to place $_!\n";
218}
219
08858ed2 220readonly_header($doc);
e0492643 221
08858ed2 222print $doc <<'_EOB_';
94bdecf9
JH
223=head1 NAME
224
225perlapi - autogenerated documentation for the perl public API
226
227=head1 DESCRIPTION
d8c40edc 228X<Perl API> X<API> X<api>
94bdecf9
JH
229
230This file contains the documentation of the perl public API generated by
231embed.pl, specifically a listing of functions, macros, flags, and variables
232that may be used by extension writers. The interfaces of any functions that
233are not listed here are subject to change without notice. For this reason,
234blindly using functions listed in proto.h is to be avoided when writing
235extensions.
236
237Note that all Perl API global variables must be referenced with the C<PL_>
238prefix. Some macros are provided for compatibility with the older,
239unadorned names, but this support may be disabled in a future release.
240
241The listing is alphabetical, case insensitive.
242
243_EOB_
244
245my $key;
6a477168
HS
246# case insensitive sort, with fallback for determinacy
247for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
94bdecf9 248 my $section = $apidocs{$key};
08858ed2 249 print $doc "\n=head1 $key\n\n=over 8\n\n";
22469dce
NC
250 # Again, fallback for determinacy
251 for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
08858ed2 252 docout($doc, $key, $section->{$key});
94bdecf9 253 }
08858ed2 254 print $doc "\n=back\n";
94bdecf9
JH
255}
256
08858ed2 257print $doc <<'_EOE_';
94bdecf9
JH
258
259=head1 AUTHORS
260
261Until May 1997, this document was maintained by Jeff Okamoto
262<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
263
264With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
265Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
266Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
267Stephen McCamant, and Gurusamy Sarathy.
268
269API Listing originally by Dean Roehrich <roehrich@cray.com>.
270
271Updated to be autogenerated from comments in the source by Benjamin Stuhl.
272
273=head1 SEE ALSO
274
275perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
276
277_EOE_
278
08858ed2 279readonly_footer($doc);
94bdecf9 280
08858ed2 281safer_close($doc);
94bdecf9 282
36bb303b 283safer_unlink "pod/perlintern.pod";
08858ed2
NC
284my $guts = safer_open("pod/perlintern.pod");
285readonly_header($guts);
286print $guts <<'END';
94bdecf9
JH
287=head1 NAME
288
289perlintern - autogenerated documentation of purely B<internal>
290 Perl functions
291
292=head1 DESCRIPTION
d8c40edc 293X<internal Perl functions> X<interpreter functions>
94bdecf9
JH
294
295This file is the autogenerated documentation of functions in the
296Perl interpreter that are documented using Perl's internal documentation
297format but are not marked as part of the Perl API. In other words,
298B<they are not for use in extensions>!
299
300END
301
302for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
303 my $section = $gutsdocs{$key};
08858ed2 304 print $guts "\n=head1 $key\n\n=over 8\n\n";
94bdecf9 305 for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
08858ed2 306 docout($guts, $key, $section->{$key});
94bdecf9 307 }
08858ed2 308 print $guts "\n=back\n";
94bdecf9
JH
309}
310
08858ed2 311print $guts <<'END';
94bdecf9
JH
312
313=head1 AUTHORS
314
315The autodocumentation system was originally added to the Perl core by
316Benjamin Stuhl. Documentation is by whoever was kind enough to
317document their functions.
318
319=head1 SEE ALSO
320
321perlguts(1), perlapi(1)
322
323END
08858ed2 324readonly_footer($guts);
94bdecf9 325
08858ed2 326safer_close($guts);