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