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