X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=autodoc.pl;h=25fabf0ca48ef64bbca6138176c85e6d9082511d;hb=3e8320ccc2dd886d20b1a97fa344ac108baef38f;hp=5e7b3c289d5c48efb5066183b85a95b4258b256c;hpb=c333cfe784a03678e3e071720a240ed3993ae09b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/autodoc.pl b/autodoc.pl index 5e7b3c2..25fabf0 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -8,6 +8,7 @@ BEGIN { require 'regen_lib.pl'; } +use strict; # # See database of global and static function prototypes in embed.fnc @@ -32,7 +33,7 @@ sub walk_table (&@) { } else { safer_unlink $filename; - open F, ">$filename" or die "Can't open $filename: $!"; + $F = safer_open($filename); binmode F; $F = \*F; } @@ -45,6 +46,7 @@ sub walk_table (&@) { $_ .= ; chomp; } + s/\s+$//; my @args; if (/^\s*(#|$)/) { @args = $_; @@ -52,6 +54,7 @@ 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; @@ -63,6 +66,7 @@ sub walk_table (&@) { my %apidocs; my %gutsdocs; my %docfuncs; +my %seenfuncs; my $curheader = "Unknown section"; @@ -118,13 +122,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 @@ -140,6 +145,27 @@ removed without notice.\n\n" if $flags =~ /x/; print $fh "=for hackers\nFound in file $file\n\n"; } +sub readonly_header (*) { + my $fh = shift; + print $fh <<"_EOH_"; +-*- buffer-read-only: t -*- + +!!!!!!! DO NOT EDIT THIS FILE !!!!!!! +This file is built by $0 extracting documentation from the C source +files. + +_EOH_ +} + +sub readonly_footer (*) { + my $fh = shift; + print $fh <<'_EOF_'; +=cut + + ex: set ro: +_EOF_ +} + my $file; # glob() picks up docs from extra .c or .h files that may be in unclean # development trees. @@ -157,34 +183,33 @@ for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) { } safer_unlink "pod/perlapi.pod"; -open (DOC, ">pod/perlapi.pod") or - die "Can't create pod/perlapi.pod: $!\n"; -binmode DOC; +my $doc = safer_open("pod/perlapi.pod"); -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//; 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]; + $apidocs{$docref->[4]}{$func} = + [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3], + @args]; } else { - $gutsdocs{$docref->[4]}{$func} = + $gutsdocs{$docref->[4]}{$func} = [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; } } else { - warn "no docs for $func\n" unless $docref and @$docref; + warn "no docs for $func\n" unless $seenfuncs{$func}; } } return ""; -} \*DOC; +} $doc; for (sort keys %docfuncs) { # Have you used a full for apidoc or just a func name? @@ -192,12 +217,15 @@ for (sort keys %docfuncs) { warn "Unable to place $_!\n"; } -print DOC <<'_EOB_'; +readonly_header($doc); + +print $doc <<'_EOB_'; =head1 NAME 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 @@ -210,7 +238,30 @@ Note that all Perl API global variables must be referenced with the C prefix. Some macros are provided for compatibility with the older, unadorned names, but this support may be disabled in a future release. -The listing is alphabetical, case insensitive. +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 EBCDIC (See L) +or ASCII. 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 +(and variants of that name, including in function names), +it also (essentially transparently) means C. +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. + +Also, on some EBCDIC machines, functions that are documented as operating on +US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all +256 characters in the EBCDIC range, not just the subset corresponding to +US-ASCII. + +The listing below is alphabetical, case insensitive. _EOB_ @@ -218,14 +269,15 @@ my $key; # 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) { - docout(\*DOC, $key, $section->{$key}); + print $doc "\n=head1 $key\n\n=over 8\n\n"; + # 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"; + print $doc "\n=back\n"; } -print DOC <<'_EOE_'; +print $doc <<'_EOE_'; =head1 AUTHORS @@ -247,20 +299,21 @@ perlguts(1), perlxs(1), perlxstut(1), perlintern(1) _EOE_ +readonly_footer($doc); -close(DOC) or die "Error closing pod/perlapi.pod: $!"; +safer_close($doc); safer_unlink "pod/perlintern.pod"; -open(GUTS, ">pod/perlintern.pod") or - die "Unable to create pod/perlintern.pod: $!\n"; -binmode GUTS; -print GUTS <<'END'; +my $guts = safer_open("pod/perlintern.pod"); +readonly_header($guts); +print $guts <<'END'; =head1 NAME 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 @@ -271,14 +324,14 @@ END for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) { my $section = $gutsdocs{$key}; - print GUTS "\n=head1 $key\n\n=over 8\n\n"; + print $guts "\n=head1 $key\n\n=over 8\n\n"; for my $key (sort { uc($a) cmp uc($b); } keys %$section) { - docout(\*GUTS, $key, $section->{$key}); + docout($guts, $key, $section->{$key}); } - print GUTS "\n=back\n"; + print $guts "\n=back\n"; } -print GUTS <<'END'; +print $guts <<'END'; =head1 AUTHORS @@ -291,5 +344,6 @@ document their functions. perlguts(1), perlapi(1) END +readonly_footer($guts); -close GUTS or die "Error closing pod/perlintern.pod: $!"; +safer_close($guts);