| 1 | #!/usr/bin/perl -w |
| 2 | # |
| 3 | # Unconditionally regenerate: |
| 4 | # |
| 5 | # pod/perlintern.pod |
| 6 | # pod/perlapi.pod |
| 7 | # |
| 8 | # from information stored in |
| 9 | # |
| 10 | # embed.fnc |
| 11 | # plus all the .c and .h files listed in MANIFEST |
| 12 | # |
| 13 | # Has an optional arg, which is the directory to chdir to before reading |
| 14 | # MANIFEST and *.[ch]. |
| 15 | # |
| 16 | # This script is invoked as part of 'make all' |
| 17 | # |
| 18 | # '=head1' are the only headings looked for. If the first non-blank line after |
| 19 | # the heading begins with a word character, it is considered to be the first |
| 20 | # line of documentation that applies to the heading itself. That is, it is |
| 21 | # output immediately after the heading, before the first function, and not |
| 22 | # indented. The next input line that is a pod directive terminates this |
| 23 | # heading-level documentation. |
| 24 | |
| 25 | use strict; |
| 26 | |
| 27 | if (@ARGV) { |
| 28 | my $workdir = shift; |
| 29 | chdir $workdir |
| 30 | or die "Couldn't chdir to '$workdir': $!"; |
| 31 | } |
| 32 | require './regen/regen_lib.pl'; |
| 33 | require './regen/embed_lib.pl'; |
| 34 | |
| 35 | # |
| 36 | # See database of global and static function prototypes in embed.fnc |
| 37 | # This is used to generate prototype headers under various configurations, |
| 38 | # export symbols lists for different platforms, and macros to provide an |
| 39 | # implicit interpreter context argument. |
| 40 | # |
| 41 | |
| 42 | my %docs; |
| 43 | my %funcflags; |
| 44 | my %macro = ( |
| 45 | ax => 1, |
| 46 | items => 1, |
| 47 | ix => 1, |
| 48 | svtype => 1, |
| 49 | ); |
| 50 | my %missing; |
| 51 | |
| 52 | my $curheader = "Unknown section"; |
| 53 | |
| 54 | sub autodoc ($$) { # parse a file and extract documentation info |
| 55 | my($fh,$file) = @_; |
| 56 | my($in, $doc, $line, $header_doc); |
| 57 | |
| 58 | # Count lines easier |
| 59 | my $get_next_line = sub { $line++; return <$fh> }; |
| 60 | |
| 61 | FUNC: |
| 62 | while (defined($in = $get_next_line->())) { |
| 63 | if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ && |
| 64 | ($file ne 'embed.h' || $file ne 'proto.h')) { |
| 65 | $macro{$1} = $file; |
| 66 | next FUNC; |
| 67 | } |
| 68 | if ($in=~ /^=head1 (.*)/) { |
| 69 | $curheader = $1; |
| 70 | |
| 71 | # If the next non-space line begins with a word char, then it is |
| 72 | # the start of heading-ldevel documentation. |
| 73 | if (defined($doc = $get_next_line->())) { |
| 74 | # Skip over empty lines |
| 75 | while ($doc =~ /^\s+$/) { |
| 76 | if (! defined($doc = $get_next_line->())) { |
| 77 | next FUNC; |
| 78 | } |
| 79 | } |
| 80 | |
| 81 | if ($doc !~ /^\w/) { |
| 82 | $in = $doc; |
| 83 | redo FUNC; |
| 84 | } |
| 85 | $header_doc = $doc; |
| 86 | |
| 87 | # Continue getting the heading-level documentation until read |
| 88 | # in any pod directive (or as a fail-safe, find a closing |
| 89 | # comment to this pod in a C language file |
| 90 | HDR_DOC: |
| 91 | while (defined($doc = $get_next_line->())) { |
| 92 | if ($doc =~ /^=\w/) { |
| 93 | $in = $doc; |
| 94 | redo FUNC; |
| 95 | } |
| 96 | |
| 97 | if ($doc =~ m:^\s*\*/$:) { |
| 98 | warn "=cut missing? $file:$line:$doc";; |
| 99 | last HDR_DOC; |
| 100 | } |
| 101 | $header_doc .= $doc; |
| 102 | } |
| 103 | } |
| 104 | next FUNC; |
| 105 | } |
| 106 | if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) { |
| 107 | my $proto = $1; |
| 108 | $proto = "||$proto" unless $proto =~ /\|/; |
| 109 | my($flags, $ret, $name, @args) = split /\|/, $proto; |
| 110 | my $docs = ""; |
| 111 | DOC: |
| 112 | while (defined($doc = $get_next_line->())) { |
| 113 | |
| 114 | # Other pod commands are considered part of the current |
| 115 | # function's docs, so can have lists, etc. |
| 116 | last DOC if $doc =~ /^=(cut|for\s+apidoc|head)/; |
| 117 | if ($doc =~ m:^\*/$:) { |
| 118 | warn "=cut missing? $file:$line:$doc";; |
| 119 | last DOC; |
| 120 | } |
| 121 | $docs .= $doc; |
| 122 | } |
| 123 | $docs = "\n$docs" if $docs and $docs !~ /^\n/; |
| 124 | |
| 125 | # Check the consistency of the flags |
| 126 | my ($embed_where, $inline_where); |
| 127 | my ($embed_may_change, $inline_may_change); |
| 128 | |
| 129 | my $docref = delete $funcflags{$name}; |
| 130 | if ($docref and %$docref) { |
| 131 | $embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts'; |
| 132 | $embed_may_change = $docref->{flags} =~ /M/; |
| 133 | $flags .= 'D' if $docref->{flags} =~ /D/; |
| 134 | } else { |
| 135 | $missing{$name} = $file; |
| 136 | } |
| 137 | if ($flags =~ /m/) { |
| 138 | $inline_where = $flags =~ /A/ ? 'api' : 'guts'; |
| 139 | $inline_may_change = $flags =~ /x/; |
| 140 | |
| 141 | if (defined $embed_where && $inline_where ne $embed_where) { |
| 142 | warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where"; |
| 143 | } |
| 144 | |
| 145 | if (defined $embed_may_change |
| 146 | && $inline_may_change ne $embed_may_change) { |
| 147 | my $message = "Function '$name' inconsistency: "; |
| 148 | if ($embed_may_change) { |
| 149 | $message .= "embed.fnc says 'may change', Pod does not"; |
| 150 | } else { |
| 151 | $message .= "Pod says 'may change', embed.fnc does not"; |
| 152 | } |
| 153 | warn $message; |
| 154 | } |
| 155 | } elsif (!defined $embed_where) { |
| 156 | warn "Unable to place $name!\n"; |
| 157 | next; |
| 158 | } else { |
| 159 | $inline_where = $embed_where; |
| 160 | $flags .= 'x' if $embed_may_change; |
| 161 | @args = @{$docref->{args}}; |
| 162 | $ret = $docref->{retval}; |
| 163 | } |
| 164 | |
| 165 | if (exists $docs{$inline_where}{$curheader}{$name}) { |
| 166 | warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n"; |
| 167 | next; |
| 168 | } |
| 169 | $docs{$inline_where}{$curheader}{$name} |
| 170 | = [$flags, $docs, $ret, $file, @args]; |
| 171 | |
| 172 | # Create a special entry with an empty-string name for the |
| 173 | # heading-level documentation. |
| 174 | if (defined $header_doc) { |
| 175 | $docs{$inline_where}{$curheader}{""} = $header_doc; |
| 176 | undef $header_doc; |
| 177 | } |
| 178 | |
| 179 | if (defined $doc) { |
| 180 | if ($doc =~ /^=(?:for|head)/) { |
| 181 | $in = $doc; |
| 182 | redo FUNC; |
| 183 | } |
| 184 | } else { |
| 185 | warn "$file:$line:$in"; |
| 186 | } |
| 187 | } |
| 188 | } |
| 189 | } |
| 190 | |
| 191 | sub docout ($$$) { # output the docs for one function |
| 192 | my($fh, $name, $docref) = @_; |
| 193 | my($flags, $docs, $ret, $file, @args) = @$docref; |
| 194 | $name =~ s/\s*$//; |
| 195 | |
| 196 | if ($flags =~ /D/) { |
| 197 | $docs = "\n\nDEPRECATED! It is planned to remove this function from a |
| 198 | future release of Perl. Do not use it for new code; remove it from |
| 199 | existing code.\n\n$docs"; |
| 200 | } |
| 201 | else { |
| 202 | $docs = "\n\nNOTE: this function is experimental and may change or be |
| 203 | removed without notice.\n\n$docs" if $flags =~ /x/; |
| 204 | } |
| 205 | $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" |
| 206 | if $flags =~ /p/; |
| 207 | $docs .= "NOTE: this function must be explicitly called as Perl_$name with an aTHX_ parameter.\n\n" |
| 208 | if $flags =~ /o/; |
| 209 | |
| 210 | print $fh "=item $name\nX<$name>\n$docs"; |
| 211 | |
| 212 | if ($flags =~ /U/) { # no usage |
| 213 | # nothing |
| 214 | } elsif ($flags =~ /s/) { # semicolon ("dTHR;") |
| 215 | print $fh "\t\t$name;\n\n"; |
| 216 | } elsif ($flags =~ /n/) { # no args |
| 217 | print $fh "\t$ret\t$name\n\n"; |
| 218 | } else { # full usage |
| 219 | my $p = $flags =~ /o/; # no #define foo Perl_foo |
| 220 | my $n = "Perl_"x$p . $name; |
| 221 | my $large_ret = length $ret > 7; |
| 222 | my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item |
| 223 | +8+($large_ret ? 1 + length $ret : 8) |
| 224 | +length($n) + 1; |
| 225 | my $indent; |
| 226 | print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n("; |
| 227 | my $long_args; |
| 228 | for (@args) { |
| 229 | if ($indent_size + 2 + length > 79) { |
| 230 | $long_args=1; |
| 231 | $indent_size -= length($n) - 3; |
| 232 | last; |
| 233 | } |
| 234 | } |
| 235 | my $args = ''; |
| 236 | if ($p) { |
| 237 | $args = @args ? "pTHX_ " : "pTHX"; |
| 238 | if ($long_args) { print $fh $args; $args = '' } |
| 239 | } |
| 240 | $long_args and print $fh "\n"; |
| 241 | my $first = !$long_args; |
| 242 | while () { |
| 243 | if (!@args or |
| 244 | length $args |
| 245 | && $indent_size + 3 + length($args[0]) + length $args > 79 |
| 246 | ) { |
| 247 | print $fh |
| 248 | $first ? '' : ( |
| 249 | $indent //= |
| 250 | "\t".($large_ret ? " " x (1+length $ret) : "\t") |
| 251 | ." "x($long_args ? 4 : 1 + length $n) |
| 252 | ), |
| 253 | $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args; |
| 254 | $args = $first = ''; |
| 255 | } |
| 256 | @args or last; |
| 257 | $args .= ", "x!!(length $args && $args ne 'pTHX_ ') |
| 258 | . shift @args; |
| 259 | } |
| 260 | if ($long_args) { print $fh "\n", substr $indent, 0, -4 } |
| 261 | print $fh ")\n\n"; |
| 262 | } |
| 263 | print $fh "=for hackers\nFound in file $file\n\n"; |
| 264 | } |
| 265 | |
| 266 | sub sort_helper { |
| 267 | # Do a case-insensitive dictionary sort, with only alphabetics |
| 268 | # significant, falling back to using everything for determinancy |
| 269 | return (uc($a =~ s/[[:^alpha:]]//r) cmp uc($b =~ s/[[:^alpha:]]//r)) |
| 270 | || uc($a) cmp uc($b) |
| 271 | || $a cmp $b; |
| 272 | } |
| 273 | |
| 274 | sub output { |
| 275 | my ($podname, $header, $dochash, $missing, $footer) = @_; |
| 276 | my $fh = open_new("pod/$podname.pod", undef, |
| 277 | {by => "$0 extracting documentation", |
| 278 | from => 'the C source files'}, 1); |
| 279 | |
| 280 | print $fh $header; |
| 281 | |
| 282 | my $key; |
| 283 | for $key (sort sort_helper keys %$dochash) { |
| 284 | my $section = $dochash->{$key}; |
| 285 | print $fh "\n=head1 $key\n\n"; |
| 286 | |
| 287 | # Output any heading-level documentation and delete so won't get in |
| 288 | # the way later |
| 289 | if (exists $section->{""}) { |
| 290 | print $fh $section->{""} . "\n"; |
| 291 | delete $section->{""}; |
| 292 | } |
| 293 | print $fh "=over 8\n\n"; |
| 294 | |
| 295 | for my $key (sort sort_helper keys %$section) { |
| 296 | docout($fh, $key, $section->{$key}); |
| 297 | } |
| 298 | print $fh "\n=back\n"; |
| 299 | } |
| 300 | |
| 301 | if (@$missing) { |
| 302 | print $fh "\n=head1 Undocumented functions\n\n"; |
| 303 | print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_'; |
| 304 | The following functions have been flagged as part of the public API, |
| 305 | but are currently undocumented. Use them at your own risk, as the |
| 306 | interfaces are subject to change. Functions that are not listed in this |
| 307 | document are not intended for public use, and should NOT be used under any |
| 308 | circumstances. |
| 309 | |
| 310 | If you feel you need to use one of these functions, first send email to |
| 311 | L<perl5-porters@perl.org|mailto:perl5-porters@perl.org>. It may be |
| 312 | that there is a good reason for the function not being documented, and it |
| 313 | should be removed from this list; or it may just be that no one has gotten |
| 314 | around to documenting it. In the latter case, you will be asked to submit a |
| 315 | patch to document the function. Once your patch is accepted, it will indicate |
| 316 | that the interface is stable (unless it is explicitly marked otherwise) and |
| 317 | usable by you. |
| 318 | |
| 319 | =over |
| 320 | |
| 321 | _EOB_ |
| 322 | The following functions are currently undocumented. If you use one of |
| 323 | them, you may wish to consider creating and submitting documentation for |
| 324 | it. |
| 325 | |
| 326 | =over |
| 327 | |
| 328 | _EOB_ |
| 329 | for my $missing (sort @$missing) { |
| 330 | print $fh "=item $missing\nX<$missing>\n\n"; |
| 331 | } |
| 332 | print $fh "=back\n\n"; |
| 333 | } |
| 334 | print $fh $footer, "=cut\n"; |
| 335 | |
| 336 | read_only_bottom_close_and_rename($fh); |
| 337 | } |
| 338 | |
| 339 | foreach (@{(setup_embed())[0]}) { |
| 340 | next if @$_ < 2; |
| 341 | my ($flags, $retval, $func, @args) = @$_; |
| 342 | s/\b(?:NN|NULLOK)\b\s+//g for @args; |
| 343 | |
| 344 | $funcflags{$func} = { |
| 345 | flags => $flags, |
| 346 | retval => $retval, |
| 347 | args => \@args, |
| 348 | }; |
| 349 | } |
| 350 | |
| 351 | # glob() picks up docs from extra .c or .h files that may be in unclean |
| 352 | # development trees. |
| 353 | open my $fh, '<', 'MANIFEST' |
| 354 | or die "Can't open MANIFEST: $!"; |
| 355 | while (my $line = <$fh>) { |
| 356 | next unless my ($file) = $line =~ /^(\S+\.[ch])\t/; |
| 357 | |
| 358 | open F, '<', $file or die "Cannot open $file for docs: $!\n"; |
| 359 | $curheader = "Functions in file $file\n"; |
| 360 | autodoc(\*F,$file); |
| 361 | close F or die "Error closing $file: $!\n"; |
| 362 | } |
| 363 | close $fh or die "Error whilst reading MANIFEST: $!"; |
| 364 | |
| 365 | for (sort keys %funcflags) { |
| 366 | next unless $funcflags{$_}{flags} =~ /d/; |
| 367 | warn "no docs for $_\n" |
| 368 | } |
| 369 | |
| 370 | foreach (sort keys %missing) { |
| 371 | next if $macro{$_}; |
| 372 | # Heuristics for known not-a-function macros: |
| 373 | next if /^[A-Z]/; |
| 374 | next if /^dj?[A-Z]/; |
| 375 | |
| 376 | warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc"; |
| 377 | } |
| 378 | |
| 379 | # walk table providing an array of components in each line to |
| 380 | # subroutine, printing the result |
| 381 | |
| 382 | # List of funcs in the public API that aren't also marked as experimental nor |
| 383 | # deprecated. |
| 384 | my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags; |
| 385 | output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_'); |
| 386 | =encoding UTF-8 |
| 387 | |
| 388 | =head1 NAME |
| 389 | |
| 390 | perlapi - autogenerated documentation for the perl public API |
| 391 | |
| 392 | =head1 DESCRIPTION |
| 393 | X<Perl API> X<API> X<api> |
| 394 | |
| 395 | This file contains the documentation of the perl public API generated by |
| 396 | F<embed.pl>, specifically a listing of functions, macros, flags, and variables |
| 397 | that may be used by extension writers. L<At the end|/Undocumented functions> |
| 398 | is a list of functions which have yet to be documented. The interfaces of |
| 399 | those are subject to change without notice. Anything not listed here is |
| 400 | not part of the public API, and should not be used by extension writers at |
| 401 | all. For these reasons, blindly using functions listed in proto.h is to be |
| 402 | avoided when writing extensions. |
| 403 | |
| 404 | In Perl, unlike C, a string of characters may generally contain embedded |
| 405 | C<NUL> characters. Sometimes in the documentation a Perl string is referred |
| 406 | to as a "buffer" to distinguish it from a C string, but sometimes they are |
| 407 | both just referred to as strings. |
| 408 | |
| 409 | Note that all Perl API global variables must be referenced with the C<PL_> |
| 410 | prefix. Again, those not listed here are not to be used by extension writers, |
| 411 | and can be changed or removed without notice; same with macros. |
| 412 | Some macros are provided for compatibility with the older, |
| 413 | unadorned names, but this support may be disabled in a future release. |
| 414 | |
| 415 | Perl was originally written to handle US-ASCII only (that is characters |
| 416 | whose ordinal numbers are in the range 0 - 127). |
| 417 | And documentation and comments may still use the term ASCII, when |
| 418 | sometimes in fact the entire range from 0 - 255 is meant. |
| 419 | |
| 420 | The non-ASCII characters below 256 can have various meanings, depending on |
| 421 | various things. (See, most notably, L<perllocale>.) But usually the whole |
| 422 | range can be referred to as ISO-8859-1. Often, the term "Latin-1" (or |
| 423 | "Latin1") is used as an equivalent for ISO-8859-1. But some people treat |
| 424 | "Latin1" as referring just to the characters in the range 128 through 255, or |
| 425 | somethimes from 160 through 255. |
| 426 | This documentation uses "Latin1" and "Latin-1" to refer to all 256 characters. |
| 427 | |
| 428 | Note that Perl can be compiled and run under either ASCII or EBCDIC (See |
| 429 | L<perlebcdic>). Most of the documentation (and even comments in the code) |
| 430 | ignore the EBCDIC possibility. |
| 431 | For almost all purposes the differences are transparent. |
| 432 | As an example, under EBCDIC, |
| 433 | instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so |
| 434 | whenever this documentation refers to C<utf8> |
| 435 | (and variants of that name, including in function names), |
| 436 | it also (essentially transparently) means C<UTF-EBCDIC>. |
| 437 | But the ordinals of characters differ between ASCII, EBCDIC, and |
| 438 | the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different |
| 439 | number of bytes than in UTF-8. |
| 440 | |
| 441 | The listing below is alphabetical, case insensitive. |
| 442 | |
| 443 | _EOB_ |
| 444 | |
| 445 | =head1 AUTHORS |
| 446 | |
| 447 | Until May 1997, this document was maintained by Jeff Okamoto |
| 448 | <okamoto@corp.hp.com>. It is now maintained as part of Perl itself. |
| 449 | |
| 450 | With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, |
| 451 | Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil |
| 452 | Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, |
| 453 | Stephen McCamant, and Gurusamy Sarathy. |
| 454 | |
| 455 | API Listing originally by Dean Roehrich <roehrich@cray.com>. |
| 456 | |
| 457 | Updated to be autogenerated from comments in the source by Benjamin Stuhl. |
| 458 | |
| 459 | =head1 SEE ALSO |
| 460 | |
| 461 | L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern> |
| 462 | |
| 463 | _EOE_ |
| 464 | |
| 465 | # List of non-static internal functions |
| 466 | my @missing_guts = |
| 467 | grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags; |
| 468 | |
| 469 | output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END'); |
| 470 | =head1 NAME |
| 471 | |
| 472 | perlintern - autogenerated documentation of purely B<internal> |
| 473 | Perl functions |
| 474 | |
| 475 | =head1 DESCRIPTION |
| 476 | X<internal Perl functions> X<interpreter functions> |
| 477 | |
| 478 | This file is the autogenerated documentation of functions in the |
| 479 | Perl interpreter that are documented using Perl's internal documentation |
| 480 | format but are not marked as part of the Perl API. In other words, |
| 481 | B<they are not for use in extensions>! |
| 482 | |
| 483 | END |
| 484 | |
| 485 | =head1 AUTHORS |
| 486 | |
| 487 | The autodocumentation system was originally added to the Perl core by |
| 488 | Benjamin Stuhl. Documentation is by whoever was kind enough to |
| 489 | document their functions. |
| 490 | |
| 491 | =head1 SEE ALSO |
| 492 | |
| 493 | L<perlguts>, L<perlapi> |
| 494 | |
| 495 | END |