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