vms.c backslash efs and long name fixes
[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 use strict;
12
13 #
14 # See database of global and static function prototypes in embed.fnc
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
20 open IN, "embed.fnc" or die $!;
21
22 # walk table providing an array of components in each line to
23 # subroutine, printing the result
24 sub 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 {
35         safer_unlink $filename;
36         $F = safer_open($filename);
37         binmode F;
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 /^:/;
45         while (s|\\\s*$||) {
46             $_ .= <IN>;
47             chomp;
48         }
49         s/\s+$//;
50         my @args;
51         if (/^\s*(#|$)/) {
52             @args = $_;
53         }
54         else {
55             @args = split /\s*\|\s*/, $_;
56         }
57         s/\b(NN|NULLOK)\b\s+//g for @args;
58         print $F $function->(@args);
59     }
60     print $F $trailer if $trailer;
61     unless (ref $filename) {
62         close $F or die "Error closing $filename: $!";
63     }
64 }
65
66 my %apidocs;
67 my %gutsdocs;
68 my %docfuncs;
69 my %seenfuncs;
70
71 my $curheader = "Unknown section";
72
73 sub autodoc ($$) { # parse a file and extract documentation info
74     my($fh,$file) = @_;
75     my($in, $doc, $line);
76 FUNC:
77     while (defined($in = <$fh>)) {
78         if ($in=~ /^=head1 (.*)/) {
79             $curheader = $1;
80             next FUNC;
81         }
82         $line++;
83         if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
84             my $proto = $1;
85             $proto = "||$proto" unless $proto =~ /\|/;
86             my($flags, $ret, $name, @args) = split /\|/, $proto;
87             my $docs = "";
88 DOC:
89             while (defined($doc = <$fh>)) {
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) {
111                 if ($doc =~ /^=(?:for|head)/) {
112                     $in = $doc;
113                     redo FUNC;
114                 }
115             } else {
116                 warn "$file:$line:$in";
117             }
118         }
119     }
120 }
121
122 sub docout ($$$) { # output the docs for one function
123     my($fh, $name, $docref) = @_;
124     my($flags, $docs, $ret, $file, @args) = @$docref;
125     $name =~ s/\s*$//;
126
127     $docs .= "NOTE: this function is experimental and may change or be
128 removed 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
132     print $fh "=item $name\nX<$name>\n$docs";
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
148 sub readonly_header (*) {
149     my $fh = shift;
150     print $fh <<"_EOH_";
151 -*- buffer-read-only: t -*-
152
153 !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
154 This file is built by $0 extracting documentation from the C source
155 files.
156
157 _EOH_
158 }
159
160 sub readonly_footer (*) {
161     my $fh = shift;
162     print $fh <<'_EOF_';
163 =cut
164
165  ex: set ro:
166 _EOF_
167 }
168
169 my $file;
170 # glob() picks up docs from extra .c or .h files that may be in unclean
171 # development trees.
172 my $MANIFEST = do {
173   local ($/, *FH);
174   open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
175   <FH>;
176 };
177
178 for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
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
185 safer_unlink "pod/perlapi.pod";
186 my $doc = safer_open("pod/perlapi.pod");
187
188 walk_table {    # load documented functions into appropriate hash
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//;
194         my $docref = delete $docfuncs{$func};
195         $seenfuncs{$func} = 1;
196         if ($docref and @$docref) {
197             if ($flags =~ /A/) {
198                 $docref->[0].="x" if $flags =~ /M/;
199                 $apidocs{$docref->[4]}{$func} =
200                     [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3],
201                         @args];
202             } else {
203                 $gutsdocs{$docref->[4]}{$func} =
204                     [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
205             }
206         }
207         else {
208             warn "no docs for $func\n" unless $seenfuncs{$func};
209         }
210     }
211     return "";
212 } $doc;
213
214 for (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
220 readonly_header($doc);
221
222 print $doc <<'_EOB_';
223 =head1 NAME
224
225 perlapi - autogenerated documentation for the perl public API
226
227 =head1 DESCRIPTION
228 X<Perl API> X<API> X<api>
229
230 This file contains the documentation of the perl public API generated by
231 embed.pl, specifically a listing of functions, macros, flags, and variables
232 that may be used by extension writers.  The interfaces of any functions that
233 are not listed here are subject to change without notice.  For this reason,
234 blindly using functions listed in proto.h is to be avoided when writing
235 extensions.
236
237 Note that all Perl API global variables must be referenced with the C<PL_>
238 prefix.  Some macros are provided for compatibility with the older,
239 unadorned names, but this support may be disabled in a future release.
240
241 Perl was originally written to handle US-ASCII only (that is characters
242 whose ordinal numbers are in the range 0 - 127).
243 And documentation and comments may still use the term ASCII, when
244 sometimes in fact the entire range from 0 - 255 is meant.
245
246 Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
247 or ASCII.  Most of the documentation (and even comments in the code)
248 ignore the EBCDIC possibility.  
249 For almost all purposes the differences are transparent.
250 As an example, under EBCDIC,
251 instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
252 whenever this documentation refers to C<utf8>
253 (and variants of that name, including in function names),
254 it also (essentially transparently) means C<UTF-EBCDIC>.
255 But the ordinals of characters differ between ASCII, EBCDIC, and
256 the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
257 than in UTF-8.
258
259 Also, on some EBCDIC machines, functions that are documented as operating on
260 US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
261 256 characters in the EBCDIC range, not just the subset corresponding to
262 US-ASCII.
263
264 The listing below is alphabetical, case insensitive.
265
266 _EOB_
267
268 my $key;
269 # case insensitive sort, with fallback for determinacy
270 for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
271     my $section = $apidocs{$key}; 
272     print $doc "\n=head1 $key\n\n=over 8\n\n";
273     # Again, fallback for determinacy
274     for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
275         docout($doc, $key, $section->{$key});
276     }
277     print $doc "\n=back\n";
278 }
279
280 print $doc <<'_EOE_';
281
282 =head1 AUTHORS
283
284 Until May 1997, this document was maintained by Jeff Okamoto
285 <okamoto@corp.hp.com>.  It is now maintained as part of Perl itself.
286
287 With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
288 Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
289 Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
290 Stephen McCamant, and Gurusamy Sarathy.
291
292 API Listing originally by Dean Roehrich <roehrich@cray.com>.
293
294 Updated to be autogenerated from comments in the source by Benjamin Stuhl.
295
296 =head1 SEE ALSO
297
298 perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
299
300 _EOE_
301
302 readonly_footer($doc);
303
304 safer_close($doc);
305
306 safer_unlink "pod/perlintern.pod";
307 my $guts = safer_open("pod/perlintern.pod");
308 readonly_header($guts);
309 print $guts <<'END';
310 =head1 NAME
311
312 perlintern - autogenerated documentation of purely B<internal>
313                  Perl functions
314
315 =head1 DESCRIPTION
316 X<internal Perl functions> X<interpreter functions>
317
318 This file is the autogenerated documentation of functions in the
319 Perl interpreter that are documented using Perl's internal documentation
320 format but are not marked as part of the Perl API. In other words,
321 B<they are not for use in extensions>!
322
323 END
324
325 for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
326     my $section = $gutsdocs{$key}; 
327     print $guts "\n=head1 $key\n\n=over 8\n\n";
328     for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
329         docout($guts, $key, $section->{$key});
330     }
331     print $guts "\n=back\n";
332 }
333
334 print $guts <<'END';
335
336 =head1 AUTHORS
337
338 The autodocumentation system was originally added to the Perl core by
339 Benjamin Stuhl. Documentation is by whoever was kind enough to
340 document their functions.
341
342 =head1 SEE ALSO
343
344 perlguts(1), perlapi(1)
345
346 END
347 readonly_footer($guts);
348
349 safer_close($guts);