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