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