Mercurial > repo
diff perl-5.22.2/autodoc.pl @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/perl-5.22.2/autodoc.pl Sat May 14 14:54:38 2016 +0000 @@ -0,0 +1,474 @@ +#!/usr/bin/perl -w +# +# Unconditionally regenerate: +# +# pod/perlintern.pod +# pod/perlapi.pod +# +# from information stored in +# +# embed.fnc +# plus all the .c and .h files listed in MANIFEST +# +# Has an optional arg, which is the directory to chdir to before reading +# MANIFEST and *.[ch]. +# +# This script is invoked as part of 'make all' +# +# '=head1' are the only headings looked for. If the first non-blank line after +# the heading begins with a word character, it is considered to be the first +# line of documentation that applies to the heading itself. That is, it is +# output immediately after the heading, before the first function, and not +# indented. The next input line that is a pod directive terminates this +# heading-level documentation. + +use strict; + +if (@ARGV) { + my $workdir = shift; + chdir $workdir + or die "Couldn't chdir to '$workdir': $!"; +} +require 'regen/regen_lib.pl'; +require 'regen/embed_lib.pl'; + +# +# See database of global and static function prototypes in embed.fnc +# This is used to generate prototype headers under various configurations, +# export symbols lists for different platforms, and macros to provide an +# implicit interpreter context argument. +# + +my %docs; +my %funcflags; +my %macro = ( + ax => 1, + items => 1, + ix => 1, + svtype => 1, + ); +my %missing; + +my $curheader = "Unknown section"; + +sub autodoc ($$) { # parse a file and extract documentation info + my($fh,$file) = @_; + my($in, $doc, $line, $header_doc); + + # Count lines easier + my $get_next_line = sub { $line++; return <$fh> }; + +FUNC: + while (defined($in = $get_next_line->())) { + if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ && + ($file ne 'embed.h' || $file ne 'proto.h')) { + $macro{$1} = $file; + next FUNC; + } + if ($in=~ /^=head1 (.*)/) { + $curheader = $1; + + # If the next non-space line begins with a word char, then it is + # the start of heading-ldevel documentation. + if (defined($doc = $get_next_line->())) { + # Skip over empty lines + while ($doc =~ /^\s+$/) { + if (! defined($doc = $get_next_line->())) { + next FUNC; + } + } + + if ($doc !~ /^\w/) { + $in = $doc; + redo FUNC; + } + $header_doc = $doc; + + # Continue getting the heading-level documentation until read + # in any pod directive (or as a fail-safe, find a closing + # comment to this pod in a C language file +HDR_DOC: + while (defined($doc = $get_next_line->())) { + if ($doc =~ /^=\w/) { + $in = $doc; + redo FUNC; + } + + if ($doc =~ m:^\s*\*/$:) { + warn "=cut missing? $file:$line:$doc";; + last HDR_DOC; + } + $header_doc .= $doc; + } + } + next FUNC; + } + if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) { + my $proto = $1; + $proto = "||$proto" unless $proto =~ /\|/; + my($flags, $ret, $name, @args) = split /\|/, $proto; + my $docs = ""; +DOC: + while (defined($doc = $get_next_line->())) { + last DOC if $doc =~ /^=\w+/; + if ($doc =~ m:^\*/$:) { + warn "=cut missing? $file:$line:$doc";; + last DOC; + } + $docs .= $doc; + } + $docs = "\n$docs" if $docs and $docs !~ /^\n/; + + # Check the consistency of the flags + my ($embed_where, $inline_where); + my ($embed_may_change, $inline_may_change); + + my $docref = delete $funcflags{$name}; + if ($docref and %$docref) { + $embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts'; + $embed_may_change = $docref->{flags} =~ /M/; + $flags .= 'D' if $docref->{flags} =~ /D/; + } else { + $missing{$name} = $file; + } + if ($flags =~ /m/) { + $inline_where = $flags =~ /A/ ? 'api' : 'guts'; + $inline_may_change = $flags =~ /x/; + + if (defined $embed_where && $inline_where ne $embed_where) { + warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where"; + } + + if (defined $embed_may_change + && $inline_may_change ne $embed_may_change) { + my $message = "Function '$name' inconsistency: "; + if ($embed_may_change) { + $message .= "embed.fnc says 'may change', Pod does not"; + } else { + $message .= "Pod says 'may change', embed.fnc does not"; + } + warn $message; + } + } elsif (!defined $embed_where) { + warn "Unable to place $name!\n"; + next; + } else { + $inline_where = $embed_where; + $flags .= 'x' if $embed_may_change; + @args = @{$docref->{args}}; + $ret = $docref->{retval}; + } + + if (exists $docs{$inline_where}{$curheader}{$name}) { + warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n"; + next; + } + $docs{$inline_where}{$curheader}{$name} + = [$flags, $docs, $ret, $file, @args]; + + # Create a special entry with an empty-string name for the + # heading-level documentation. + if (defined $header_doc) { + $docs{$inline_where}{$curheader}{""} = $header_doc; + undef $header_doc; + } + + if (defined $doc) { + if ($doc =~ /^=(?:for|head)/) { + $in = $doc; + redo FUNC; + } + } else { + warn "$file:$line:$in"; + } + } + } +} + +sub docout ($$$) { # output the docs for one function + my($fh, $name, $docref) = @_; + my($flags, $docs, $ret, $file, @args) = @$docref; + $name =~ s/\s*$//; + + if ($flags =~ /D/) { + $docs = "\n\nDEPRECATED! It is planned to remove this function from a +future release of Perl. Do not use it for new code; remove it from +existing code.\n\n$docs"; + } + else { + $docs = "\n\nNOTE: this function is experimental and may change or be +removed without notice.\n\n$docs" if $flags =~ /x/; + } + $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" + if $flags =~ /p/; + $docs .= "NOTE: this function must be explicitly called as Perl_$name with an aTHX_ parameter.\n\n" + if $flags =~ /o/; + + print $fh "=item $name\nX<$name>\n$docs"; + + if ($flags =~ /U/) { # no usage + # nothing + } elsif ($flags =~ /s/) { # semicolon ("dTHR;") + print $fh "\t\t$name;\n\n"; + } elsif ($flags =~ /n/) { # no args + print $fh "\t$ret\t$name\n\n"; + } else { # full usage + my $p = $flags =~ /o/; # no #define foo Perl_foo + my $n = "Perl_"x$p . $name; + my $large_ret = length $ret > 7; + my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item + +8+($large_ret ? 1 + length $ret : 8) + +length($n) + 1; + my $indent; + print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n("; + my $long_args; + for (@args) { + if ($indent_size + 2 + length > 79) { + $long_args=1; + $indent_size -= length($n) - 3; + last; + } + } + my $args = ''; + if ($p) { + $args = @args ? "pTHX_ " : "pTHX"; + if ($long_args) { print $fh $args; $args = '' } + } + $long_args and print $fh "\n"; + my $first = !$long_args; + while () { + if (!@args or + length $args + && $indent_size + 3 + length($args[0]) + length $args > 79 + ) { + print $fh + $first ? '' : ( + $indent //= + "\t".($large_ret ? " " x (1+length $ret) : "\t") + ." "x($long_args ? 4 : 1 + length $n) + ), + $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args; + $args = $first = ''; + } + @args or last; + $args .= ", "x!!(length $args && $args ne 'pTHX_ ') + . shift @args; + } + if ($long_args) { print $fh "\n", substr $indent, 0, -4 } + print $fh ")\n\n"; + } + print $fh "=for hackers\nFound in file $file\n\n"; +} + +sub sort_helper { + # Do a case-insensitive dictionary sort, with only alphabetics + # significant, falling back to using everything for determinancy + return (uc($a =~ s/[[^:alpha]]//r) cmp uc($b =~ s/[[^:alpha]]//r)) + || uc($a) cmp uc($b) + || $a cmp $b; +} + +sub output { + my ($podname, $header, $dochash, $missing, $footer) = @_; + my $fh = open_new("pod/$podname.pod", undef, + {by => "$0 extracting documentation", + from => 'the C source files'}, 1); + + print $fh $header; + + my $key; + for $key (sort sort_helper keys %$dochash) { + my $section = $dochash->{$key}; + print $fh "\n=head1 $key\n\n"; + + # Output any heading-level documentation and delete so won't get in + # the way later + if (exists $section->{""}) { + print $fh $section->{""} . "\n"; + delete $section->{""}; + } + print $fh "=over 8\n\n"; + + for my $key (sort sort_helper keys %$section) { + docout($fh, $key, $section->{$key}); + } + print $fh "\n=back\n"; + } + + if (@$missing) { + print $fh "\n=head1 Undocumented functions\n\n"; + print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_'; +The following functions have been flagged as part of the public API, +but are currently undocumented. Use them at your own risk, as the +interfaces are subject to change. Functions that are not listed in this +document are not intended for public use, and should NOT be used under any +circumstances. + +If you use one of the undocumented functions below, you may wish to consider +creating and submitting documentation +for it. If your patch is accepted, this +will indicate that the interface is stable (unless it is explicitly marked +otherwise). + +=over + +_EOB_ +The following functions are currently undocumented. If you use one of +them, you may wish to consider creating and submitting documentation for +it. + +=over + +_EOB_ + for my $missing (sort @$missing) { + print $fh "=item $missing\nX<$missing>\n\n"; + } + print $fh "=back\n\n"; +} + print $fh $footer, "=cut\n"; + + read_only_bottom_close_and_rename($fh); +} + +foreach (@{(setup_embed())[0]}) { + next if @$_ < 2; + my ($flags, $retval, $func, @args) = @$_; + s/\b(?:NN|NULLOK)\b\s+//g for @args; + + $funcflags{$func} = { + flags => $flags, + retval => $retval, + args => \@args, + }; +} + +# glob() picks up docs from extra .c or .h files that may be in unclean +# development trees. +open my $fh, '<', 'MANIFEST' + or die "Can't open MANIFEST: $!"; +while (my $line = <$fh>) { + next unless my ($file) = $line =~ /^(\S+\.[ch])\t/; + + open F, "< $file" or die "Cannot open $file for docs: $!\n"; + $curheader = "Functions in file $file\n"; + autodoc(\*F,$file); + close F or die "Error closing $file: $!\n"; +} +close $fh or die "Error whilst reading MANIFEST: $!"; + +for (sort keys %funcflags) { + next unless $funcflags{$_}{flags} =~ /d/; + warn "no docs for $_\n" +} + +foreach (sort keys %missing) { + next if $macro{$_}; + # Heuristics for known not-a-function macros: + next if /^[A-Z]/; + next if /^dj?[A-Z]/; + + warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc"; +} + +# walk table providing an array of components in each line to +# subroutine, printing the result + +# List of funcs in the public API that aren't also marked as experimental nor +# deprecated. +my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags; +output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_'); +=head1 NAME + +perlapi - autogenerated documentation for the perl public API + +=head1 DESCRIPTION +X<Perl API> X<API> X<api> + +This file contains the documentation of the perl public API generated by +F<embed.pl>, specifically a listing of functions, macros, flags, and variables +that may be used by extension writers. L<At the end|/Undocumented functions> +is a list of functions which have yet to be documented. The interfaces of +those are subject to change without notice. Anything not listed here is +not part of the public API, and should not be used by extension writers at +all. For these reasons, blindly using functions listed in proto.h is to be +avoided when writing extensions. + +Note that all Perl API global variables must be referenced with the C<PL_> +prefix. Again, those not listed here are not to be used by extension writers, +and can be changed or removed without notice; same with macros. +Some macros are provided for compatibility with the older, +unadorned names, but this support may be disabled in a future release. + +Perl was originally written to handle US-ASCII only (that is characters +whose ordinal numbers are in the range 0 - 127). +And documentation and comments may still use the term ASCII, when +sometimes in fact the entire range from 0 - 255 is meant. + +Note that Perl can be compiled and run under either ASCII or EBCDIC (See +L<perlebcdic>). Most of the documentation (and even comments in the code) +ignore the EBCDIC possibility. +For almost all purposes the differences are transparent. +As an example, under EBCDIC, +instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so +whenever this documentation refers to C<utf8> +(and variants of that name, including in function names), +it also (essentially transparently) means C<UTF-EBCDIC>. +But the ordinals of characters differ between ASCII, EBCDIC, and +the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes +than in UTF-8. + +The listing below is alphabetical, case insensitive. + +_EOB_ + +=head1 AUTHORS + +Until May 1997, this document was maintained by Jeff Okamoto +<okamoto@corp.hp.com>. It is now maintained as part of Perl itself. + +With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, +Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil +Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, +Stephen McCamant, and Gurusamy Sarathy. + +API Listing originally by Dean Roehrich <roehrich@cray.com>. + +Updated to be autogenerated from comments in the source by Benjamin Stuhl. + +=head1 SEE ALSO + +L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern> + +_EOE_ + +# List of non-static internal functions +my @missing_guts = + grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags; + +output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END'); +=head1 NAME + +perlintern - autogenerated documentation of purely B<internal> + Perl functions + +=head1 DESCRIPTION +X<internal Perl functions> X<interpreter functions> + +This file is the autogenerated documentation of functions in the +Perl interpreter that are documented using Perl's internal documentation +format but are not marked as part of the Perl API. In other words, +B<they are not for use in extensions>! + +END + +=head1 AUTHORS + +The autodocumentation system was originally added to the Perl core by +Benjamin Stuhl. Documentation is by whoever was kind enough to +document their functions. + +=head1 SEE ALSO + +L<perlguts>, L<perlapi> + +END