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 {  push @INC, 'lib' }     # glob() below requires File::Glob
   7
   8
   9 #
  10 # See database of global and static function prototypes in embed.fnc
  11 # This is used to generate prototype headers under various configurations,
  12 # export symbols lists for different platforms, and macros to provide an
  13 # implicit interpreter context argument.
  14 #
  15
  16 open IN, "embed.fnc" or die $!;
  17
  18 # walk table providing an array of components in each line to
  19 # subroutine, printing the result
  20 sub walk_table (&@) {
  21     my $function = shift;
  22     my $filename = shift || '-';
  23     my $leader = shift;
  24     my $trailer = shift;
  25     my $F;
  26     local *F;
  27     if (ref $filename) {        # filehandle
  28         $F = $filename;
  29     }
  30     else {
  31         open F, ">$filename" or die "Can't open $filename: $!";
  32         $F = \*F;
  33     }
  34     print $F $leader if $leader;
  35     seek IN, 0, 0;              # so we may restart
  36     while (<IN>) {
  37         chomp;
  38         next if /^:/;
  39         while (s|\\\s*$||) {
  40             $_ .= <IN>;
  41             chomp;
  42         }
  43         my @args;
  44         if (/^\s*(#|$)/) {
  45             @args = $_;
  46         }
  47         else {
  48             @args = split /\s*\|\s*/, $_;
  49         }
  50         print $F $function->(@args);
  51     }
  52     print $F $trailer if $trailer;
  53     close $F unless ref $filename;
  54 }
  55
  56 my %apidocs;
  57 my %gutsdocs;
  58 my %docfuncs;
  59
  60 my $curheader = "Unknown section";
  61
  62 sub autodoc ($$) { # parse a file and extract documentation info
  63     my($fh,$file) = @_;
  64     my($in, $doc, $line);
  65 FUNC:
  66     while (defined($in = <$fh>)) {
  67         if ($in=~ /^=head1 (.*)/) {
  68             $curheader = $1;
  69             next FUNC;
  70         }
  71         $line++;
  72         if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
  73             my $proto = $1;
  74             $proto = "||$proto" unless $proto =~ /\|/;
  75             my($flags, $ret, $name, @args) = split /\|/, $proto;
  76             my $docs = "";
  77 DOC:
  78             while (defined($doc = <$fh>)) {
  79                 if ($doc =~ /^=head1 (.*)/) {
  80                     $curheader = $1;
  81                     next DOC;
  82                 }
  83                 $line++;
  84                 last DOC if $doc =~ /^=\w+/;
  85                 if ($doc =~ m:^\*/$:) {
  86                     warn "=cut missing? $file:$line:$doc";;
  87                     last DOC;
  88                 }
  89                 $docs .= $doc;
  90             }
  91             $docs = "\n$docs" if $docs and $docs !~ /^\n/;
  92             if ($flags =~ /m/) {
  93                 if ($flags =~ /A/) {
  94                     $apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
  95                 }
  96                 else {
  97                     $gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
  98                 }
  99             }
 100             else {
 101                 $docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
 102             }
 103             if (defined $doc) {
 104                 if ($doc =~ /^=for/) {
 105                     $in = $doc;
 106                     redo FUNC;
 107                 }
 108             } else {
 109                 warn "$file:$line:$in";
 110             }
 111         }
 112     }
 113 }
 114
 115 sub docout ($$$) { # output the docs for one function
 116     my($fh, $name, $docref) = @_;
 117     my($flags, $docs, $ret, $file, @args) = @$docref;
 118
 119     $docs .= "NOTE: this function is experimental and may change or be
 120 removed without notice.\n\n" if $flags =~ /x/;
 121     $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
 122         if $flags =~ /p/;
 123
 124     print $fh "=item $name\n$docs";
 125
 126     if ($flags =~ /U/) { # no usage
 127         # nothing
 128     } elsif ($flags =~ /s/) { # semicolon ("dTHR;")
 129         print $fh "\t\t$name;\n\n";
 130     } elsif ($flags =~ /n/) { # no args
 131         print $fh "\t$ret\t$name\n\n";
 132     } else { # full usage
 133         print $fh "\t$ret\t$name";
 134         print $fh "(" . join(", ", @args) . ")";
 135         print $fh "\n\n";
 136     }
 137     print $fh "=for hackers\nFound in file $file\n\n";
 138 }
 139
 140 my $file;
 141 for $file (glob('*.c'), glob('*.h')) {
 142     open F, "< $file" or die "Cannot open $file for docs: $!\n";
 143     $curheader = "Functions in file $file\n";
 144     autodoc(\*F,$file);
 145     close F or die "Error closing $file: $!\n";
 146 }
 147
 148 unlink "pod/perlapi.pod";
 149 open (DOC, ">pod/perlapi.pod") or
 150         die "Can't create pod/perlapi.pod: $!\n";
 151
 152 walk_table {    # load documented functions into approriate hash
 153     if (@_ > 1) {
 154         my($flags, $retval, $func, @args) = @_;
 155         return "" unless $flags =~ /d/;
 156         $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
 157         $retval =~ s/\t//;
 158         my $docref = delete $docfuncs{$func};
 159         if ($docref and @$docref) {
 160             if ($flags =~ /A/) {
 161                 $docref->[0].="x" if $flags =~ /M/;
 162                 $apidocs{$docref->[4]}{$func} =
 163                     [$docref->[0] . 'A', $docref->[1], $retval,
 164                                                 $docref->[3], @args];
 165             } else {
 166                 $gutsdocs{$docref->[4]}{$func} =
 167                     [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
 168             }
 169         }
 170         else {
 171             warn "no docs for $func\n" unless $docref and @$docref;
 172         }
 173     }
 174     return "";
 175 } \*DOC;
 176
 177 for (sort keys %docfuncs) {
 178     # Have you used a full for apidoc or just a func name?
 179     # Have you used Ap instead of Am in the for apidoc?
 180     warn "Unable to place $_!\n";
 181 }
 182
 183 print DOC <<'_EOB_';
 184 =head1 NAME
 185
 186 perlapi - autogenerated documentation for the perl public API
 187
 188 =head1 DESCRIPTION
 189
 190 This file contains the documentation of the perl public API generated by
 191 embed.pl, specifically a listing of functions, macros, flags, and variables
 192 that may be used by extension writers.  The interfaces of any functions that
 193 are not listed here are subject to change without notice.  For this reason,
 194 blindly using functions listed in proto.h is to be avoided when writing
 195 extensions.
 196
 197 Note that all Perl API global variables must be referenced with the C<PL_>
 198 prefix.  Some macros are provided for compatibility with the older,
 199 unadorned names, but this support may be disabled in a future release.
 200
 201 The listing is alphabetical, case insensitive.
 202
 203 _EOB_
 204
 205 my $key;
 206 for $key (sort { uc($a) cmp uc($b); } keys %apidocs) { # case insensitive sort
 207     my $section = $apidocs{$key};
 208     print DOC "\n=head1 $key\n\n=over 8\n\n";
 209     for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
 210         docout(\*DOC, $key, $section->{$key});
 211     }
 212     print DOC "\n=back\n";
 213 }
 214
 215 print DOC <<'_EOE_';
 216
 217 =head1 AUTHORS
 218
 219 Until May 1997, this document was maintained by Jeff Okamoto
 220 <okamoto@corp.hp.com>.  It is now maintained as part of Perl itself.
 221
 222 With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
 223 Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
 224 Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
 225 Stephen McCamant, and Gurusamy Sarathy.
 226
 227 API Listing originally by Dean Roehrich <roehrich@cray.com>.
 228
 229 Updated to be autogenerated from comments in the source by Benjamin Stuhl.
 230
 231 =head1 SEE ALSO
 232
 233 perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
 234
 235 _EOE_
 236
 237
 238 close(DOC);
 239
 240 open(GUTS, ">pod/perlintern.pod") or
 241                 die "Unable to create pod/perlintern.pod: $!\n";
 242 print GUTS <<'END';
 243 =head1 NAME
 244
 245 perlintern - autogenerated documentation of purely B<internal>
 246                  Perl functions
 247
 248 =head1 DESCRIPTION
 249
 250 This file is the autogenerated documentation of functions in the
 251 Perl interpreter that are documented using Perl's internal documentation
 252 format but are not marked as part of the Perl API. In other words,
 253 B<they are not for use in extensions>!
 254
 255 END
 256
 257 for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
 258     my $section = $gutsdocs{$key};
 259     print GUTS "\n=head1 $key\n\n=over 8\n\n";
 260     for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
 261         docout(\*GUTS, $key, $section->{$key});
 262     }
 263     print GUTS "\n=back\n";
 264 }
 265
 266 print GUTS <<'END';
 267
 268 =head1 AUTHORS
 269
 270 The autodocumentation system was originally added to the Perl core by
 271 Benjamin Stuhl. Documentation is by whoever was kind enough to
 272 document their functions.
 273
 274 =head1 SEE ALSO
 275
 276 perlguts(1), perlapi(1)
 277
 278 END
 279
 280 close GUTS;
 281