| 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 | if ($doc =~ /^=head1 (.*)/) { |
| 86 | $curheader = $1; |
| 87 | next DOC; |
| 88 | } |
| 89 | $line++; |
| 90 | last DOC if $doc =~ /^=\w+/; |
| 91 | if ($doc =~ m:^\*/$:) { |
| 92 | warn "=cut missing? $file:$line:$doc";; |
| 93 | last DOC; |
| 94 | } |
| 95 | $docs .= $doc; |
| 96 | } |
| 97 | $docs = "\n$docs" if $docs and $docs !~ /^\n/; |
| 98 | if ($flags =~ /m/) { |
| 99 | if ($flags =~ /A/) { |
| 100 | $apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args]; |
| 101 | } |
| 102 | else { |
| 103 | $gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args]; |
| 104 | } |
| 105 | } |
| 106 | else { |
| 107 | $docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args]; |
| 108 | } |
| 109 | if (defined $doc) { |
| 110 | if ($doc =~ /^=for/) { |
| 111 | $in = $doc; |
| 112 | redo FUNC; |
| 113 | } |
| 114 | } else { |
| 115 | warn "$file:$line:$in"; |
| 116 | } |
| 117 | } |
| 118 | } |
| 119 | } |
| 120 | |
| 121 | sub docout ($$$) { # output the docs for one function |
| 122 | my($fh, $name, $docref) = @_; |
| 123 | my($flags, $docs, $ret, $file, @args) = @$docref; |
| 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\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 | for $file (glob('*.c'), glob('*.h')) { |
| 148 | open F, "< $file" or die "Cannot open $file for docs: $!\n"; |
| 149 | $curheader = "Functions in file $file\n"; |
| 150 | autodoc(\*F,$file); |
| 151 | close F or die "Error closing $file: $!\n"; |
| 152 | } |
| 153 | |
| 154 | safer_unlink "pod/perlapi.pod"; |
| 155 | open (DOC, ">pod/perlapi.pod") or |
| 156 | die "Can't create pod/perlapi.pod: $!\n"; |
| 157 | |
| 158 | walk_table { # load documented functions into approriate hash |
| 159 | if (@_ > 1) { |
| 160 | my($flags, $retval, $func, @args) = @_; |
| 161 | return "" unless $flags =~ /d/; |
| 162 | $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl |
| 163 | $retval =~ s/\t//; |
| 164 | my $docref = delete $docfuncs{$func}; |
| 165 | if ($docref and @$docref) { |
| 166 | if ($flags =~ /A/) { |
| 167 | $docref->[0].="x" if $flags =~ /M/; |
| 168 | $apidocs{$docref->[4]}{$func} = |
| 169 | [$docref->[0] . 'A', $docref->[1], $retval, |
| 170 | $docref->[3], @args]; |
| 171 | } else { |
| 172 | $gutsdocs{$docref->[4]}{$func} = |
| 173 | [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; |
| 174 | } |
| 175 | } |
| 176 | else { |
| 177 | warn "no docs for $func\n" unless $docref and @$docref; |
| 178 | } |
| 179 | } |
| 180 | return ""; |
| 181 | } \*DOC; |
| 182 | |
| 183 | for (sort keys %docfuncs) { |
| 184 | # Have you used a full for apidoc or just a func name? |
| 185 | # Have you used Ap instead of Am in the for apidoc? |
| 186 | warn "Unable to place $_!\n"; |
| 187 | } |
| 188 | |
| 189 | print DOC <<'_EOB_'; |
| 190 | =head1 NAME |
| 191 | |
| 192 | perlapi - autogenerated documentation for the perl public API |
| 193 | |
| 194 | =head1 DESCRIPTION |
| 195 | |
| 196 | This file contains the documentation of the perl public API generated by |
| 197 | embed.pl, specifically a listing of functions, macros, flags, and variables |
| 198 | that may be used by extension writers. The interfaces of any functions that |
| 199 | are not listed here are subject to change without notice. For this reason, |
| 200 | blindly using functions listed in proto.h is to be avoided when writing |
| 201 | extensions. |
| 202 | |
| 203 | Note that all Perl API global variables must be referenced with the C<PL_> |
| 204 | prefix. Some macros are provided for compatibility with the older, |
| 205 | unadorned names, but this support may be disabled in a future release. |
| 206 | |
| 207 | The listing is alphabetical, case insensitive. |
| 208 | |
| 209 | _EOB_ |
| 210 | |
| 211 | my $key; |
| 212 | # case insensitive sort, with fallback for determinacy |
| 213 | for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) { |
| 214 | my $section = $apidocs{$key}; |
| 215 | print DOC "\n=head1 $key\n\n=over 8\n\n"; |
| 216 | for my $key (sort { uc($a) cmp uc($b); } keys %$section) { |
| 217 | docout(\*DOC, $key, $section->{$key}); |
| 218 | } |
| 219 | print DOC "\n=back\n"; |
| 220 | } |
| 221 | |
| 222 | print DOC <<'_EOE_'; |
| 223 | |
| 224 | =head1 AUTHORS |
| 225 | |
| 226 | Until May 1997, this document was maintained by Jeff Okamoto |
| 227 | <okamoto@corp.hp.com>. It is now maintained as part of Perl itself. |
| 228 | |
| 229 | With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, |
| 230 | Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil |
| 231 | Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, |
| 232 | Stephen McCamant, and Gurusamy Sarathy. |
| 233 | |
| 234 | API Listing originally by Dean Roehrich <roehrich@cray.com>. |
| 235 | |
| 236 | Updated to be autogenerated from comments in the source by Benjamin Stuhl. |
| 237 | |
| 238 | =head1 SEE ALSO |
| 239 | |
| 240 | perlguts(1), perlxs(1), perlxstut(1), perlintern(1) |
| 241 | |
| 242 | _EOE_ |
| 243 | |
| 244 | |
| 245 | close(DOC) or die "Error closing pod/perlapi.pod: $!"; |
| 246 | |
| 247 | safer_unlink "pod/perlintern.pod"; |
| 248 | open(GUTS, ">pod/perlintern.pod") or |
| 249 | die "Unable to create pod/perlintern.pod: $!\n"; |
| 250 | print GUTS <<'END'; |
| 251 | =head1 NAME |
| 252 | |
| 253 | perlintern - autogenerated documentation of purely B<internal> |
| 254 | Perl functions |
| 255 | |
| 256 | =head1 DESCRIPTION |
| 257 | |
| 258 | This file is the autogenerated documentation of functions in the |
| 259 | Perl interpreter that are documented using Perl's internal documentation |
| 260 | format but are not marked as part of the Perl API. In other words, |
| 261 | B<they are not for use in extensions>! |
| 262 | |
| 263 | END |
| 264 | |
| 265 | for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) { |
| 266 | my $section = $gutsdocs{$key}; |
| 267 | print GUTS "\n=head1 $key\n\n=over 8\n\n"; |
| 268 | for my $key (sort { uc($a) cmp uc($b); } keys %$section) { |
| 269 | docout(\*GUTS, $key, $section->{$key}); |
| 270 | } |
| 271 | print GUTS "\n=back\n"; |
| 272 | } |
| 273 | |
| 274 | print GUTS <<'END'; |
| 275 | |
| 276 | =head1 AUTHORS |
| 277 | |
| 278 | The autodocumentation system was originally added to the Perl core by |
| 279 | Benjamin Stuhl. Documentation is by whoever was kind enough to |
| 280 | document their functions. |
| 281 | |
| 282 | =head1 SEE ALSO |
| 283 | |
| 284 | perlguts(1), perlapi(1) |
| 285 | |
| 286 | END |
| 287 | |
| 288 | close GUTS or die "Error closing pod/perlintern.pod: $!"; |