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