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