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