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