diff options
Diffstat (limited to 'gnu/usr.bin/perl/autodoc.pl')
| -rw-r--r-- | gnu/usr.bin/perl/autodoc.pl | 239 |
1 files changed, 108 insertions, 131 deletions
diff --git a/gnu/usr.bin/perl/autodoc.pl b/gnu/usr.bin/perl/autodoc.pl index 5317bc6da1c..042131e9760 100644 --- a/gnu/usr.bin/perl/autodoc.pl +++ b/gnu/usr.bin/perl/autodoc.pl @@ -1,12 +1,20 @@ #!/usr/bin/perl -w - -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'; -} +# +# 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 normally invoked as part of 'make all', but is also +# called from from regen.pl. use strict; @@ -17,52 +25,6 @@ use strict; # implicit interpreter context argument. # -open IN, "embed.fnc" or die $!; - -# walk table providing an array of components in each line to -# subroutine, printing the result -sub walk_table (&@) { - my $function = shift; - my $filename = shift || '-'; - my $leader = shift; - my $trailer = shift; - my $F; - local *F; - if (ref $filename) { # filehandle - $F = $filename; - } - else { - safer_unlink $filename; - open F, ">$filename" or die "Can't open $filename: $!"; - binmode F; - $F = \*F; - } - print $F $leader if $leader; - seek IN, 0, 0; # so we may restart - while (<IN>) { - chomp; - next if /^:/; - while (s|\\\s*$||) { - $_ .= <IN>; - chomp; - } - s/\s+$//; - my @args; - if (/^\s*(#|$)/) { - @args = $_; - } - else { - @args = split /\s*\|\s*/, $_; - } - s/\b(NN|NULLOK)\b\s+//g for @args; - print $F $function->(@args); - } - print $F $trailer if $trailer; - unless (ref $filename) { - close $F or die "Error closing $filename: $!"; - } -} - my %apidocs; my %gutsdocs; my %docfuncs; @@ -145,9 +107,12 @@ 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_"; +sub output { + my ($podname, $header, $dochash, $footer) = @_; + my $filename = "pod/$podname.pod"; + open my $fh, '>', $filename or die "Can't open $filename: $!"; + + print $fh <<"_EOH_", $header; -*- buffer-read-only: t -*- !!!!!!! DO NOT EDIT THIS FILE !!!!!!! @@ -155,15 +120,32 @@ This file is built by $0 extracting documentation from the C source files. _EOH_ -} -sub readonly_footer (*) { - my $fh = shift; - print $fh <<'_EOF_'; + my $key; + # case insensitive sort, with fallback for determinacy + for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$dochash) { + my $section = $dochash->{$key}; + print $fh "\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($fh, $key, $section->{$key}); + } + print $fh "\n=back\n"; + } + + print $fh $footer, <<'_EOF_'; =cut ex: set ro: _EOF_ + + close $fh or die "Can't close $filename: $!"; +} + +if (@ARGV) { + my $workdir = shift; + chdir $workdir + or die "Couldn't chdir to '$workdir': $!"; } my $file; @@ -182,36 +164,47 @@ for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) { close F or die "Error closing $file: $!\n"; } -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 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]; - } else { - $gutsdocs{$docref->[4]}{$func} = - [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; - } - } - else { - warn "no docs for $func\n" unless $seenfuncs{$func}; +open IN, "embed.fnc" or die $!; + +# walk table providing an array of components in each line to +# subroutine, printing the result + +while (<IN>) { + chomp; + next if /^:/; + while (s|\\\s*$||) { + $_ .= <IN>; + chomp; + } + s/\s+$//; + next if /^\s*(#|$)/; + + my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_; + + next unless $flags =~ /d/; + next unless $func; + + s/\b(NN|NULLOK)\b\s+//g for @args; + $func =~ s/\t//g; # 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]; + } else { + $gutsdocs{$docref->[4]}{$func} = + [$docref->[0], $docref->[1], $retval, $docref->[3], @args]; } } - return ""; -} \*DOC; + else { + warn "no docs for $func\n" unless $seenfuncs{$func}; + } +} for (sort keys %docfuncs) { # Have you used a full for apidoc or just a func name? @@ -219,9 +212,7 @@ for (sort keys %docfuncs) { warn "Unable to place $_!\n"; } -readonly_header(\*DOC); - -print DOC <<'_EOB_'; +output('perlapi', <<'_EOB_', \%apidocs, <<'_EOE_'); =head1 NAME perlapi - autogenerated documentation for the perl public API @@ -240,24 +231,33 @@ Note that all Perl API global variables must be referenced with the C<PL_> 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<perlebcdic>) +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<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. + +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_ -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"; - # 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 <<'_EOE_'; - =head1 AUTHORS Until May 1997, this document was maintained by Jeff Okamoto @@ -278,16 +278,7 @@ perlguts(1), perlxs(1), perlxstut(1), perlintern(1) _EOE_ -readonly_footer(\*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; -readonly_header(\*GUTS); -print GUTS <<'END'; +output('perlintern', <<'END', \%gutsdocs, <<'END'); =head1 NAME perlintern - autogenerated documentation of purely B<internal> @@ -303,17 +294,6 @@ B<they are not for use in extensions>! 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"; - for my $key (sort { uc($a) cmp uc($b); } keys %$section) { - docout(\*GUTS, $key, $section->{$key}); - } - print GUTS "\n=back\n"; -} - -print GUTS <<'END'; - =head1 AUTHORS The autodocumentation system was originally added to the Perl core by @@ -325,6 +305,3 @@ document their functions. perlguts(1), perlapi(1) END -readonly_footer(\*GUTS); - -close GUTS or die "Error closing pod/perlintern.pod: $!"; |