This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge near-duplicate code for 'api' and 'guts'.
[perl5.git] / autodoc.pl
1 #!/usr/bin/perl -w
2
3 # Unconditionally regenerate:
4 #
5 #    pod/perlintern.pod
6 #    pod/perlapi.pod
7 #
8 # from information stored in
9 #
10 #    embed.fnc
11 #    plus all the .c and .h files listed in MANIFEST
12 #
13 # Has an optional arg, which is the directory to chdir to before reading
14 # MANIFEST and *.[ch].
15 #
16 # This script is normally invoked as part of 'make all', but is also
17 # called from from regen.pl.
18
19 use strict;
20
21 #
22 # See database of global and static function prototypes in embed.fnc
23 # This is used to generate prototype headers under various configurations,
24 # export symbols lists for different platforms, and macros to provide an
25 # implicit interpreter context argument.
26 #
27
28 my %docs;
29 my %docfuncs;
30 my %seenfuncs;
31
32 my $curheader = "Unknown section";
33
34 sub autodoc ($$) { # parse a file and extract documentation info
35     my($fh,$file) = @_;
36     my($in, $doc, $line);
37 FUNC:
38     while (defined($in = <$fh>)) {
39         if ($in=~ /^=head1 (.*)/) {
40             $curheader = $1;
41             next FUNC;
42         }
43         $line++;
44         if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
45             my $proto = $1;
46             $proto = "||$proto" unless $proto =~ /\|/;
47             my($flags, $ret, $name, @args) = split /\|/, $proto;
48             my $docs = "";
49 DOC:
50             while (defined($doc = <$fh>)) {
51                 $line++;
52                 last DOC if $doc =~ /^=\w+/;
53                 if ($doc =~ m:^\*/$:) {
54                     warn "=cut missing? $file:$line:$doc";;
55                     last DOC;
56                 }
57                 $docs .= $doc;
58             }
59             $docs = "\n$docs" if $docs and $docs !~ /^\n/;
60             if ($flags =~ /m/) {
61                 my $where = $flags =~ /A/ ? 'api' : 'guts';
62                 $docs{$where}{$curheader}{$name}
63                     = [$flags, $docs, $ret, $file, @args];
64             }
65             else {
66                 $docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
67             }
68             $seenfuncs{$name} = 1;
69             if (defined $doc) {
70                 if ($doc =~ /^=(?:for|head)/) {
71                     $in = $doc;
72                     redo FUNC;
73                 }
74             } else {
75                 warn "$file:$line:$in";
76             }
77         }
78     }
79 }
80
81 sub docout ($$$) { # output the docs for one function
82     my($fh, $name, $docref) = @_;
83     my($flags, $docs, $ret, $file, @args) = @$docref;
84     $name =~ s/\s*$//;
85
86     $docs .= "NOTE: this function is experimental and may change or be
87 removed without notice.\n\n" if $flags =~ /x/;
88     $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
89         if $flags =~ /p/;
90
91     print $fh "=item $name\nX<$name>\n$docs";
92
93     if ($flags =~ /U/) { # no usage
94         # nothing
95     } elsif ($flags =~ /s/) { # semicolon ("dTHR;")
96         print $fh "\t\t$name;\n\n";
97     } elsif ($flags =~ /n/) { # no args
98         print $fh "\t$ret\t$name\n\n";
99     } else { # full usage
100         print $fh "\t$ret\t$name";
101         print $fh "(" . join(", ", @args) . ")";
102         print $fh "\n\n";
103     }
104     print $fh "=for hackers\nFound in file $file\n\n";
105 }
106
107 sub output {
108     my ($podname, $header, $dochash, $footer) = @_;
109     my $filename = "pod/$podname.pod";
110     open my $fh, '>', $filename or die "Can't open $filename: $!";
111
112     print $fh <<"_EOH_", $header;
113 -*- buffer-read-only: t -*-
114
115 !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
116 This file is built by $0 extracting documentation from the C source
117 files.
118
119 _EOH_
120
121     my $key;
122     # case insensitive sort, with fallback for determinacy
123     for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$dochash) {
124         my $section = $dochash->{$key}; 
125         print $fh "\n=head1 $key\n\n=over 8\n\n";
126         # Again, fallback for determinacy
127         for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
128             docout($fh, $key, $section->{$key});
129         }
130         print $fh "\n=back\n";
131     }
132
133     print $fh $footer, <<'_EOF_';
134 =cut
135
136  ex: set ro:
137 _EOF_
138
139     close $fh or die "Can't close $filename: $!";
140 }
141
142 if (@ARGV) {
143     my $workdir = shift;
144     chdir $workdir
145         or die "Couldn't chdir to '$workdir': $!";
146 }
147
148 my $file;
149 # glob() picks up docs from extra .c or .h files that may be in unclean
150 # development trees.
151 my $MANIFEST = do {
152   local ($/, *FH);
153   open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
154   <FH>;
155 };
156
157 for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
158     open F, "< $file" or die "Cannot open $file for docs: $!\n";
159     $curheader = "Functions in file $file\n";
160     autodoc(\*F,$file);
161     close F or die "Error closing $file: $!\n";
162 }
163
164 open IN, "embed.fnc" or die $!;
165
166 # walk table providing an array of components in each line to
167 # subroutine, printing the result
168
169 while (<IN>) {
170     chomp;
171     next if /^:/;
172     while (s|\\\s*$||) {
173         $_ .= <IN>;
174         chomp;
175     }
176     s/\s+$//;
177     next if /^\s*(#|$)/;
178
179     my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_;
180
181     next unless $flags =~ /d/;
182     next unless $func;
183
184     s/\b(NN|NULLOK)\b\s+//g for @args;
185     $func =~ s/\t//g; # clean up fields from embed.pl
186     $retval =~ s/\t//;
187
188     my $docref = delete $docfuncs{$func};
189     if ($docref and @$docref) {
190         my $where;
191         if ($flags =~ /A/) {
192             $where = 'api';
193             $docref->[0].="x" if $flags =~ /M/;
194             $docref->[0] .= 'A';
195         } else {
196             $where = 'guts';
197         }
198         $docs{$where}{$docref->[4]}{$func} =
199             [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
200     }
201     else {
202         warn "no docs for $func\n" unless $seenfuncs{$func};
203     }
204 }
205
206 for (sort keys %docfuncs) {
207     # Have you used a full for apidoc or just a func name?
208     # Have you used Ap instead of Am in the for apidoc?
209     warn "Unable to place $_!\n";
210 }
211
212 output('perlapi', <<'_EOB_', $docs{api}, <<'_EOE_');
213 =head1 NAME
214
215 perlapi - autogenerated documentation for the perl public API
216
217 =head1 DESCRIPTION
218 X<Perl API> X<API> X<api>
219
220 This file contains the documentation of the perl public API generated by
221 embed.pl, specifically a listing of functions, macros, flags, and variables
222 that may be used by extension writers.  The interfaces of any functions that
223 are not listed here are subject to change without notice.  For this reason,
224 blindly using functions listed in proto.h is to be avoided when writing
225 extensions.
226
227 Note that all Perl API global variables must be referenced with the C<PL_>
228 prefix.  Some macros are provided for compatibility with the older,
229 unadorned names, but this support may be disabled in a future release.
230
231 Perl was originally written to handle US-ASCII only (that is characters
232 whose ordinal numbers are in the range 0 - 127).
233 And documentation and comments may still use the term ASCII, when
234 sometimes in fact the entire range from 0 - 255 is meant.
235
236 Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
237 or ASCII.  Most of the documentation (and even comments in the code)
238 ignore the EBCDIC possibility.  
239 For almost all purposes the differences are transparent.
240 As an example, under EBCDIC,
241 instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
242 whenever this documentation refers to C<utf8>
243 (and variants of that name, including in function names),
244 it also (essentially transparently) means C<UTF-EBCDIC>.
245 But the ordinals of characters differ between ASCII, EBCDIC, and
246 the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
247 than in UTF-8.
248
249 Also, on some EBCDIC machines, functions that are documented as operating on
250 US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
251 256 characters in the EBCDIC range, not just the subset corresponding to
252 US-ASCII.
253
254 The listing below is alphabetical, case insensitive.
255
256 _EOB_
257
258 =head1 AUTHORS
259
260 Until May 1997, this document was maintained by Jeff Okamoto
261 <okamoto@corp.hp.com>.  It is now maintained as part of Perl itself.
262
263 With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
264 Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
265 Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
266 Stephen McCamant, and Gurusamy Sarathy.
267
268 API Listing originally by Dean Roehrich <roehrich@cray.com>.
269
270 Updated to be autogenerated from comments in the source by Benjamin Stuhl.
271
272 =head1 SEE ALSO
273
274 perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
275
276 _EOE_
277
278 output('perlintern', <<'END', $docs{guts}, <<'END');
279 =head1 NAME
280
281 perlintern - autogenerated documentation of purely B<internal>
282                  Perl functions
283
284 =head1 DESCRIPTION
285 X<internal Perl functions> X<interpreter functions>
286
287 This file is the autogenerated documentation of functions in the
288 Perl interpreter that are documented using Perl's internal documentation
289 format but are not marked as part of the Perl API. In other words,
290 B<they are not for use in extensions>!
291
292 END
293
294 =head1 AUTHORS
295
296 The autodocumentation system was originally added to the Perl core by
297 Benjamin Stuhl. Documentation is by whoever was kind enough to
298 document their functions.
299
300 =head1 SEE ALSO
301
302 perlguts(1), perlapi(1)
303
304 END