| 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 normally invoked as part of 'make all', but is also |
| 17 |
+ |
# called from from regen.pl. |
| 18 |
|
|
| 3 |
– |
require 5.003; # keep this compatible, an old perl is all we may have before |
| 4 |
– |
# we build the new one |
| 5 |
– |
|
| 6 |
– |
BEGIN { |
| 7 |
– |
push @INC, 'lib'; |
| 8 |
– |
require 'regen_lib.pl'; |
| 9 |
– |
} |
| 10 |
– |
|
| 19 |
|
use strict; |
| 20 |
|
|
| 21 |
|
# |
| 25 |
|
# implicit interpreter context argument. |
| 26 |
|
# |
| 27 |
|
|
| 20 |
– |
open IN, "embed.fnc" or die $!; |
| 21 |
– |
|
| 22 |
– |
# walk table providing an array of components in each line to |
| 23 |
– |
# subroutine, printing the result |
| 24 |
– |
sub walk_table (&@) { |
| 25 |
– |
my $function = shift; |
| 26 |
– |
my $filename = shift || '-'; |
| 27 |
– |
my $leader = shift; |
| 28 |
– |
my $trailer = shift; |
| 29 |
– |
my $F; |
| 30 |
– |
local *F; |
| 31 |
– |
if (ref $filename) { # filehandle |
| 32 |
– |
$F = $filename; |
| 33 |
– |
} |
| 34 |
– |
else { |
| 35 |
– |
safer_unlink $filename; |
| 36 |
– |
open F, ">$filename" or die "Can't open $filename: $!"; |
| 37 |
– |
binmode F; |
| 38 |
– |
$F = \*F; |
| 39 |
– |
} |
| 40 |
– |
print $F $leader if $leader; |
| 41 |
– |
seek IN, 0, 0; # so we may restart |
| 42 |
– |
while (<IN>) { |
| 43 |
– |
chomp; |
| 44 |
– |
next if /^:/; |
| 45 |
– |
while (s|\\\s*$||) { |
| 46 |
– |
$_ .= <IN>; |
| 47 |
– |
chomp; |
| 48 |
– |
} |
| 49 |
– |
s/\s+$//; |
| 50 |
– |
my @args; |
| 51 |
– |
if (/^\s*(#|$)/) { |
| 52 |
– |
@args = $_; |
| 53 |
– |
} |
| 54 |
– |
else { |
| 55 |
– |
@args = split /\s*\|\s*/, $_; |
| 56 |
– |
} |
| 57 |
– |
s/\b(NN|NULLOK)\b\s+//g for @args; |
| 58 |
– |
print $F $function->(@args); |
| 59 |
– |
} |
| 60 |
– |
print $F $trailer if $trailer; |
| 61 |
– |
unless (ref $filename) { |
| 62 |
– |
close $F or die "Error closing $filename: $!"; |
| 63 |
– |
} |
| 64 |
– |
} |
| 65 |
– |
|
| 28 |
|
my %apidocs; |
| 29 |
|
my %gutsdocs; |
| 30 |
|
my %docfuncs; |
| 107 |
|
print $fh "=for hackers\nFound in file $file\n\n"; |
| 108 |
|
} |
| 109 |
|
|
| 110 |
< |
sub readonly_header (*) { |
| 111 |
< |
my $fh = shift; |
| 112 |
< |
print $fh <<"_EOH_"; |
| 110 |
> |
sub output { |
| 111 |
> |
my ($podname, $header, $dochash, $footer) = @_; |
| 112 |
> |
my $filename = "pod/$podname.pod"; |
| 113 |
> |
open my $fh, '>', $filename or die "Can't open $filename: $!"; |
| 114 |
> |
|
| 115 |
> |
print $fh <<"_EOH_", $header; |
| 116 |
|
-*- buffer-read-only: t -*- |
| 117 |
|
|
| 118 |
|
!!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
| 120 |
|
files. |
| 121 |
|
|
| 122 |
|
_EOH_ |
| 158 |
– |
} |
| 123 |
|
|
| 124 |
< |
sub readonly_footer (*) { |
| 125 |
< |
my $fh = shift; |
| 126 |
< |
print $fh <<'_EOF_'; |
| 124 |
> |
my $key; |
| 125 |
> |
# case insensitive sort, with fallback for determinacy |
| 126 |
> |
for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$dochash) { |
| 127 |
> |
my $section = $dochash->{$key}; |
| 128 |
> |
print $fh "\n=head1 $key\n\n=over 8\n\n"; |
| 129 |
> |
# Again, fallback for determinacy |
| 130 |
> |
for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) { |
| 131 |
> |
docout($fh, $key, $section->{$key}); |
| 132 |
> |
} |
| 133 |
> |
print $fh "\n=back\n"; |
| 134 |
> |
} |
| 135 |
> |
|
| 136 |
> |
print $fh $footer, <<'_EOF_'; |
| 137 |
|
=cut |
| 138 |
|
|
| 139 |
|
ex: set ro: |
| 140 |
|
_EOF_ |
| 141 |
+ |
|
| 142 |
+ |
close $fh or die "Can't close $filename: $!"; |
| 143 |
|
} |
| 144 |
|
|
| 145 |
+ |
if (@ARGV) { |
| 146 |
+ |
my $workdir = shift; |
| 147 |
+ |
chdir $workdir |
| 148 |
+ |
or die "Couldn't chdir to '$workdir': $!"; |
| 149 |
+ |
} |
| 150 |
+ |
|
| 151 |
|
my $file; |
| 152 |
|
# glob() picks up docs from extra .c or .h files that may be in unclean |
| 153 |
|
# development trees. |
| 164 |
|
close F or die "Error closing $file: $!\n"; |
| 165 |
|
} |
| 166 |
|
|
| 167 |
< |
safer_unlink "pod/perlapi.pod"; |
| 186 |
< |
open (DOC, ">pod/perlapi.pod") or |
| 187 |
< |
die "Can't create pod/perlapi.pod: $!\n"; |
| 188 |
< |
binmode DOC; |
| 167 |
> |
open IN, "embed.fnc" or die $!; |
| 168 |
|
|
| 169 |
< |
walk_table { # load documented functions into appropriate hash |
| 170 |
< |
if (@_ > 1) { |
| 171 |
< |
my($flags, $retval, $func, @args) = @_; |
| 172 |
< |
return "" unless $flags =~ /d/; |
| 173 |
< |
$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl |
| 174 |
< |
$retval =~ s/\t//; |
| 175 |
< |
my $docref = delete $docfuncs{$func}; |
| 176 |
< |
$seenfuncs{$func} = 1; |
| 177 |
< |
if ($docref and @$docref) { |
| 178 |
< |
if ($flags =~ /A/) { |
| 179 |
< |
$docref->[0].="x" if $flags =~ /M/; |
| 180 |
< |
$apidocs{$docref->[4]}{$func} = |
| 181 |
< |
[$docref->[0] . 'A', $docref->[1], $retval, $docref->[3], |
| 182 |
< |
@args]; |
| 183 |
< |
} else { |
| 184 |
< |
$gutsdocs{$docref->[4]}{$func} = |
| 185 |
< |
[$docref->[0], $docref->[1], $retval, $docref->[3], @args]; |
| 186 |
< |
} |
| 169 |
> |
# walk table providing an array of components in each line to |
| 170 |
> |
# subroutine, printing the result |
| 171 |
> |
|
| 172 |
> |
while (<IN>) { |
| 173 |
> |
chomp; |
| 174 |
> |
next if /^:/; |
| 175 |
> |
while (s|\\\s*$||) { |
| 176 |
> |
$_ .= <IN>; |
| 177 |
> |
chomp; |
| 178 |
> |
} |
| 179 |
> |
s/\s+$//; |
| 180 |
> |
next if /^\s*(#|$)/; |
| 181 |
> |
|
| 182 |
> |
my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_; |
| 183 |
> |
|
| 184 |
> |
next unless $flags =~ /d/; |
| 185 |
> |
next unless $func; |
| 186 |
> |
|
| 187 |
> |
s/\b(NN|NULLOK)\b\s+//g for @args; |
| 188 |
> |
$func =~ s/\t//g; # clean up fields from embed.pl |
| 189 |
> |
$retval =~ s/\t//; |
| 190 |
> |
|
| 191 |
> |
my $docref = delete $docfuncs{$func}; |
| 192 |
> |
$seenfuncs{$func} = 1; |
| 193 |
> |
if ($docref and @$docref) { |
| 194 |
> |
if ($flags =~ /A/) { |
| 195 |
> |
$docref->[0].="x" if $flags =~ /M/; |
| 196 |
> |
$apidocs{$docref->[4]}{$func} = |
| 197 |
> |
[$docref->[0] . 'A', $docref->[1], $retval, $docref->[3], |
| 198 |
> |
@args]; |
| 199 |
> |
} else { |
| 200 |
> |
$gutsdocs{$docref->[4]}{$func} = |
| 201 |
> |
[$docref->[0], $docref->[1], $retval, $docref->[3], @args]; |
| 202 |
|
} |
| 209 |
– |
else { |
| 210 |
– |
warn "no docs for $func\n" unless $seenfuncs{$func}; |
| 211 |
– |
} |
| 203 |
|
} |
| 204 |
< |
return ""; |
| 205 |
< |
} \*DOC; |
| 204 |
> |
else { |
| 205 |
> |
warn "no docs for $func\n" unless $seenfuncs{$func}; |
| 206 |
> |
} |
| 207 |
> |
} |
| 208 |
|
|
| 209 |
|
for (sort keys %docfuncs) { |
| 210 |
|
# Have you used a full for apidoc or just a func name? |
| 212 |
|
warn "Unable to place $_!\n"; |
| 213 |
|
} |
| 214 |
|
|
| 215 |
< |
readonly_header(\*DOC); |
| 223 |
< |
|
| 224 |
< |
print DOC <<'_EOB_'; |
| 215 |
> |
output('perlapi', <<'_EOB_', \%apidocs, <<'_EOE_'); |
| 216 |
|
=head1 NAME |
| 217 |
|
|
| 218 |
|
perlapi - autogenerated documentation for the perl public API |
| 231 |
|
prefix. Some macros are provided for compatibility with the older, |
| 232 |
|
unadorned names, but this support may be disabled in a future release. |
| 233 |
|
|
| 234 |
< |
The listing is alphabetical, case insensitive. |
| 234 |
> |
Perl was originally written to handle US-ASCII only (that is characters |
| 235 |
> |
whose ordinal numbers are in the range 0 - 127). |
| 236 |
> |
And documentation and comments may still use the term ASCII, when |
| 237 |
> |
sometimes in fact the entire range from 0 - 255 is meant. |
| 238 |
|
|
| 239 |
< |
_EOB_ |
| 239 |
> |
Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>) |
| 240 |
> |
or ASCII. Most of the documentation (and even comments in the code) |
| 241 |
> |
ignore the EBCDIC possibility. |
| 242 |
> |
For almost all purposes the differences are transparent. |
| 243 |
> |
As an example, under EBCDIC, |
| 244 |
> |
instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so |
| 245 |
> |
whenever this documentation refers to C<utf8> |
| 246 |
> |
(and variants of that name, including in function names), |
| 247 |
> |
it also (essentially transparently) means C<UTF-EBCDIC>. |
| 248 |
> |
But the ordinals of characters differ between ASCII, EBCDIC, and |
| 249 |
> |
the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes |
| 250 |
> |
than in UTF-8. |
| 251 |
|
|
| 252 |
< |
my $key; |
| 253 |
< |
# case insensitive sort, with fallback for determinacy |
| 254 |
< |
for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) { |
| 255 |
< |
my $section = $apidocs{$key}; |
| 251 |
< |
print DOC "\n=head1 $key\n\n=over 8\n\n"; |
| 252 |
< |
# Again, fallback for determinacy |
| 253 |
< |
for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) { |
| 254 |
< |
docout(\*DOC, $key, $section->{$key}); |
| 255 |
< |
} |
| 256 |
< |
print DOC "\n=back\n"; |
| 257 |
< |
} |
| 252 |
> |
Also, on some EBCDIC machines, functions that are documented as operating on |
| 253 |
> |
US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all |
| 254 |
> |
256 characters in the EBCDIC range, not just the subset corresponding to |
| 255 |
> |
US-ASCII. |
| 256 |
|
|
| 257 |
< |
print DOC <<'_EOE_'; |
| 257 |
> |
The listing below is alphabetical, case insensitive. |
| 258 |
|
|
| 259 |
+ |
_EOB_ |
| 260 |
+ |
|
| 261 |
|
=head1 AUTHORS |
| 262 |
|
|
| 263 |
|
Until May 1997, this document was maintained by Jeff Okamoto |
| 278 |
|
|
| 279 |
|
_EOE_ |
| 280 |
|
|
| 281 |
< |
readonly_footer(\*DOC); |
| 282 |
< |
|
| 283 |
< |
close(DOC) or die "Error closing pod/perlapi.pod: $!"; |
| 284 |
< |
|
| 285 |
< |
safer_unlink "pod/perlintern.pod"; |
| 286 |
< |
open(GUTS, ">pod/perlintern.pod") or |
| 287 |
< |
die "Unable to create pod/perlintern.pod: $!\n"; |
| 288 |
< |
binmode GUTS; |
| 289 |
< |
readonly_header(\*GUTS); |
| 290 |
< |
print GUTS <<'END'; |
| 281 |
> |
output('perlintern', <<'END', \%gutsdocs, <<'END'); |
| 282 |
|
=head1 NAME |
| 283 |
|
|
| 284 |
|
perlintern - autogenerated documentation of purely B<internal> |
| 294 |
|
|
| 295 |
|
END |
| 296 |
|
|
| 306 |
– |
for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) { |
| 307 |
– |
my $section = $gutsdocs{$key}; |
| 308 |
– |
print GUTS "\n=head1 $key\n\n=over 8\n\n"; |
| 309 |
– |
for my $key (sort { uc($a) cmp uc($b); } keys %$section) { |
| 310 |
– |
docout(\*GUTS, $key, $section->{$key}); |
| 311 |
– |
} |
| 312 |
– |
print GUTS "\n=back\n"; |
| 313 |
– |
} |
| 314 |
– |
|
| 315 |
– |
print GUTS <<'END'; |
| 316 |
– |
|
| 297 |
|
=head1 AUTHORS |
| 298 |
|
|
| 299 |
|
The autodocumentation system was originally added to the Perl core by |
| 305 |
|
perlguts(1), perlapi(1) |
| 306 |
|
|
| 307 |
|
END |
| 328 |
– |
readonly_footer(\*GUTS); |
| 329 |
– |
|
| 330 |
– |
close GUTS or die "Error closing pod/perlintern.pod: $!"; |
