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