X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/94bdecf9800c3bee967274854f7adf2933ffd42b..9ac4c1072a98d8d5ad54c6972c40921620c69d8e:/autodoc.pl diff --git a/autodoc.pl b/autodoc.pl index 8b6f3b4..cb77a14 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -3,8 +3,14 @@ require 5.003; # keep this compatible, an old perl is all we may have before # we build the new one +BEGIN { + push @INC, 'lib'; + require 'regen_lib.pl'; +} + + # -# See database of global and static function prototypes at the __END__. +# 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. @@ -25,7 +31,9 @@ sub walk_table (&@) { $F = $filename; } else { + safer_unlink $filename; open F, ">$filename" or die "Can't open $filename: $!"; + binmode F; $F = \*F; } print $F $leader if $leader; @@ -33,10 +41,11 @@ sub walk_table (&@) { while () { chomp; next if /^:/; - while (s|\\$||) { + while (s|\\\s*$||) { $_ .= ; chomp; } + s/\s+$//; my @args; if (/^\s*(#|$)/) { @args = $_; @@ -44,15 +53,19 @@ sub walk_table (&@) { else { @args = split /\s*\|\s*/, $_; } + s/\b(NN|NULLOK)\b\s+//g for @args; print $F $function->(@args); } print $F $trailer if $trailer; - close $F unless ref $filename; + unless (ref $filename) { + close $F or die "Error closing $filename: $!"; + } } my %apidocs; my %gutsdocs; my %docfuncs; +my %seenfuncs; my $curheader = "Unknown section"; @@ -66,17 +79,13 @@ FUNC: next FUNC; } $line++; - if ($in =~ /^=for\s+apidoc\s+(.*)\n/) { + 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 = <$fh>)) { - if ($doc =~ /^=head1 (.*)/) { - $curheader = $1; - next DOC; - } $line++; last DOC if $doc =~ /^=\w+/; if ($doc =~ m:^\*/$:) { @@ -98,7 +107,7 @@ DOC: $docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args]; } if (defined $doc) { - if ($doc =~ /^=for/) { + if ($doc =~ /^=(?:for|head)/) { $in = $doc; redo FUNC; } @@ -112,13 +121,14 @@ DOC: sub docout ($$$) { # output the docs for one function my($fh, $name, $docref) = @_; my($flags, $docs, $ret, $file, @args) = @$docref; + $name =~ s/\s*$//; $docs .= "NOTE: this function is experimental and may change or be removed without notice.\n\n" if $flags =~ /x/; $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" if $flags =~ /p/; - print $fh "=item $name\n$docs"; + print $fh "=item $name\nX<$name>\n$docs"; if ($flags =~ /U/) { # no usage # nothing @@ -135,33 +145,47 @@ removed without notice.\n\n" if $flags =~ /x/; } my $file; -for $file (glob('*.c'), glob('*.h')) { +# glob() picks up docs from extra .c or .h files that may be in unclean +# development trees. +my $MANIFEST = do { + local ($/, *FH); + open FH, "MANIFEST" or die "Can't open MANIFEST: $!"; + ; +}; + +for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) { 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"; } -unlink "pod/perlapi.pod"; +safer_unlink "pod/perlapi.pod"; open (DOC, ">pod/perlapi.pod") or die "Can't create pod/perlapi.pod: $!\n"; +binmode DOC; -walk_table { # load documented functions into approriate hash +walk_table { # load documented functions into appropriate hash if (@_ > 1) { my($flags, $retval, $func, @args) = @_; return "" unless $flags =~ /d/; $func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl $retval =~ s/\t//; - if ($flags =~ /A/) { - my $docref = delete $docfuncs{$func}; - warn "no docs for $func\n" unless $docref and @$docref; - $docref->[0].="x" if $flags =~ /M/; - $apidocs{$docref->[4]}{$func} = - [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3], @args]; - } else { - my $docref = delete $docfuncs{$func}; - $gutsdocs{$docref->[4]}{$func} = - [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; + my $docref = delete $docfuncs{$func}; + $seenfuncs{$func} = 1; + if ($docref and @$docref) { + if ($flags =~ /A/) { + $docref->[0].="x" if $flags =~ /M/; + $apidocs{$docref->[4]}{$func} = + [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3], + @args]; + } else { + $gutsdocs{$docref->[4]}{$func} = + [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; + } + } + else { + warn "no docs for $func\n" unless $seenfuncs{$func}; } } return ""; @@ -179,6 +203,7 @@ print DOC <<'_EOB_'; perlapi - autogenerated documentation for the perl public API =head1 DESCRIPTION +X X X This file contains the documentation of the perl public API generated by embed.pl, specifically a listing of functions, macros, flags, and variables @@ -196,10 +221,12 @@ The listing is alphabetical, case insensitive. _EOB_ my $key; -for $key (sort { uc($a) cmp uc($b); } keys %apidocs) { # case insensitive sort +# case insensitive sort, with fallback for determinacy +for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) { my $section = $apidocs{$key}; print DOC "\n=head1 $key\n\n=over 8\n\n"; - for my $key (sort { uc($a) cmp uc($b); } keys %$section) { + # Again, fallback for determinacy + for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) { docout(\*DOC, $key, $section->{$key}); } print DOC "\n=back\n"; @@ -228,10 +255,12 @@ perlguts(1), perlxs(1), perlxstut(1), perlintern(1) _EOE_ -close(DOC); +close(DOC) or die "Error closing pod/perlapi.pod: $!"; +safer_unlink "pod/perlintern.pod"; open(GUTS, ">pod/perlintern.pod") or die "Unable to create pod/perlintern.pod: $!\n"; +binmode GUTS; print GUTS <<'END'; =head1 NAME @@ -239,6 +268,7 @@ perlintern - autogenerated documentation of purely B Perl functions =head1 DESCRIPTION +X X This file is the autogenerated documentation of functions in the Perl interpreter that are documented using Perl's internal documentation @@ -270,5 +300,4 @@ perlguts(1), perlapi(1) END -close GUTS; - +close GUTS or die "Error closing pod/perlintern.pod: $!";