493 lines
9.3 KiB
Prolog
Executable File
493 lines
9.3 KiB
Prolog
Executable File
#!/usr/local/bin/perl
|
|
|
|
use Config;
|
|
use File::Basename qw(&basename &dirname);
|
|
use Cwd;
|
|
|
|
# List explicitly here the variables you want Configure to
|
|
# generate. Metaconfig only looks for shell variables, so you
|
|
# have to mention them as if they were shell variables, not
|
|
# %Config entries. Thus you write
|
|
# $startperl
|
|
# to ensure Configure will look for $Config{startperl}.
|
|
|
|
# This forces PL files to create target in same directory as PL file.
|
|
# This is so that make depend always knows where to find PL derivatives.
|
|
$origdir = cwd;
|
|
chdir(dirname($0));
|
|
($file = basename($0)) =~ s/\.PL$//;
|
|
$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
|
|
$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
|
|
|
|
open OUT,">$file" or die "Can't create $file: $!";
|
|
|
|
print "Extracting $file (with variable substitutions)\n";
|
|
|
|
# In this section, perl variables will be expanded during extraction.
|
|
# You can use $Config{...} to use Configure variables.
|
|
|
|
print OUT <<"!GROK!THIS!";
|
|
$Config{'startperl'}
|
|
eval 'exec perl -S \$0 "\$@"'
|
|
if 0;
|
|
!GROK!THIS!
|
|
|
|
# In the following, perl variables are not expanded during extraction.
|
|
|
|
print OUT <<'!NO!SUBS!';
|
|
|
|
#
|
|
# buildtoc
|
|
#
|
|
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
|
|
# This file is autogenerated by buildtoc.PL.
|
|
# Edit that file and run it to effect changes.
|
|
#
|
|
# Builds perltoc.pod and sanity checks the list of pods against all
|
|
# of the MANIFEST, perl.pod, and ourselves.
|
|
#
|
|
|
|
use File::Find;
|
|
use Cwd;
|
|
use Text::Wrap;
|
|
|
|
@PODS = glob("*.pod");
|
|
|
|
sub output ($);
|
|
|
|
if (-d "pod") {
|
|
die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
|
|
}
|
|
|
|
@pods = qw(
|
|
perl
|
|
perlfaq
|
|
perltoc
|
|
perlbook
|
|
|
|
perlsyn
|
|
perldata
|
|
perlop
|
|
perlsub
|
|
perlfunc
|
|
perlreftut
|
|
perldsc
|
|
perlrequick
|
|
perlpod
|
|
perlstyle
|
|
perltrap
|
|
|
|
perlrun
|
|
perldiag
|
|
perllexwarn
|
|
perldebtut
|
|
perldebug
|
|
|
|
perlvar
|
|
perllol
|
|
perlopentut
|
|
perlretut
|
|
|
|
perlre
|
|
perlref
|
|
|
|
perlform
|
|
|
|
perlboot
|
|
perltoot
|
|
perltootc
|
|
perlobj
|
|
perlbot
|
|
perltie
|
|
|
|
perlipc
|
|
perlfork
|
|
perlnumber
|
|
perlthrtut
|
|
|
|
perlport
|
|
perllocale
|
|
perlunicode
|
|
perlebcdic
|
|
|
|
perlsec
|
|
|
|
perlmod
|
|
perlmodlib
|
|
perlmodinstall
|
|
perlnewmod
|
|
|
|
perlfaq1
|
|
perlfaq2
|
|
perlfaq3
|
|
perlfaq4
|
|
perlfaq5
|
|
perlfaq6
|
|
perlfaq7
|
|
perlfaq8
|
|
perlfaq9
|
|
|
|
perlcompile
|
|
|
|
perlembed
|
|
perldebguts
|
|
perlxstut
|
|
perlxs
|
|
perlclib
|
|
perlguts
|
|
perlcall
|
|
perlutil
|
|
perlfilter
|
|
perldbmfilter
|
|
perlapi
|
|
perlintern
|
|
perlapio
|
|
perltodo
|
|
perlhack
|
|
|
|
perlhist
|
|
perldelta
|
|
perl5005delta
|
|
perl5004delta
|
|
|
|
perlaix
|
|
perlamiga
|
|
perlbs2000
|
|
perlcygwin
|
|
perldos
|
|
perlepoc
|
|
perlhpux
|
|
perlmachten
|
|
perlmacos
|
|
perlmpeix
|
|
perlos2
|
|
perlos390
|
|
perlsolaris
|
|
perlvmesa
|
|
perlvms
|
|
perlvos
|
|
perlwin32
|
|
);
|
|
|
|
@ARCHPODS = qw(
|
|
perlaix
|
|
perlamiga
|
|
perlbs2000
|
|
perlcygwin
|
|
perldos
|
|
perlepoc
|
|
perlhpux
|
|
perlmachten
|
|
perlmacos
|
|
perlmpeix
|
|
perlos2
|
|
perlos390
|
|
perlsolaris
|
|
perlvmesa
|
|
perlvms
|
|
perlvos
|
|
perlwin32
|
|
);
|
|
for (@ARCHPODS) { s/$/.pod/ }
|
|
@ARCHPODS{@ARCHPODS} = ();
|
|
|
|
for (@pods) { s/$/.pod/ }
|
|
@pods{@pods} = ();
|
|
@PODS{@PODS} = ();
|
|
|
|
open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
|
|
while (<MANI>) {
|
|
if (m!^pod/([^.]+\.pod)\s+!i) {
|
|
push @MANIPODS, $1;
|
|
}
|
|
}
|
|
close(MANI);
|
|
@MANIPODS{@MANIPODS} = ();
|
|
|
|
open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
|
|
while (<PERLPOD>) {
|
|
if (/^For ease of access, /../^\(If you're intending /) {
|
|
if (/^\s+(perl\S*)\s+\w/) {
|
|
push @PERLPODS, "$1.pod";
|
|
}
|
|
}
|
|
}
|
|
close(PERLPOD);
|
|
die "$0: could not find the pod listing of perl.pod\n"
|
|
unless @PERLPODS;
|
|
@PERLPODS{@PERLPODS} = ();
|
|
|
|
# Cross-check against ourselves
|
|
# Cross-check against the MANIFEST
|
|
# Cross-check against the perl.pod
|
|
|
|
foreach my $i (sort keys %PODS) {
|
|
warn "$0: $i exists but is unknown by buildtoc\n"
|
|
unless exists $pods{$i};
|
|
warn "$0: $i exists but is unknown by ../MANIFEST\n"
|
|
if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
|
|
warn "$0: $i exists but is unknown by perl.pod\n"
|
|
unless exists $PERLPODS{$i};
|
|
}
|
|
foreach my $i (sort keys %pods) {
|
|
warn "$0: $i is known by buildtoc but does not exist\n"
|
|
unless exists $PODS{$i};
|
|
}
|
|
foreach my $i (sort keys %MANIPODS) {
|
|
warn "$0: $i is known by ../MANIFEST but does not exist\n"
|
|
unless exists $PODS{$i};
|
|
}
|
|
foreach my $i (sort keys %PERLPODS) {
|
|
warn "$0: $i is known by perl.pod but does not exist\n"
|
|
unless exists $PODS{$i};
|
|
}
|
|
|
|
# We are ready to rock.
|
|
open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";
|
|
|
|
$/ = '';
|
|
@ARGV = @pods;
|
|
|
|
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
|
|
|
|
=head1 NAME
|
|
|
|
perltoc - perl documentation table of contents
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This page provides a brief table of contents for the rest of the Perl
|
|
documentation set. It is meant to be scanned quickly or grepped
|
|
through to locate the proper section you're looking for.
|
|
|
|
=head1 BASIC DOCUMENTATION
|
|
|
|
EOPOD2B
|
|
#' make emacs happy
|
|
|
|
podset(@pods);
|
|
|
|
find \&getpods => qw(../lib ../ext);
|
|
|
|
sub getpods {
|
|
if (/\.p(od|m)$/) {
|
|
# Skip .pm files that have corresponding .pod files, and Functions.pm.
|
|
return if /(.*)\.pm$/ && -f "$1.pod";
|
|
my $file = $File::Find::name;
|
|
return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
|
|
|
|
die "tut $name" if $file =~ /TUT/;
|
|
unless (open (F, "< $_\0")) {
|
|
warn "bogus <$file>: $!";
|
|
system "ls", "-l", $file;
|
|
}
|
|
else {
|
|
my $line;
|
|
while ($line = <F>) {
|
|
if ($line =~ /^=head1\s+NAME\b/) {
|
|
push @modpods, $file;
|
|
#warn "GOOD $file\n";
|
|
return;
|
|
}
|
|
}
|
|
warn "$0: $file: cannot find =head1 NAME\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
die "no pods" unless @modpods;
|
|
|
|
for (@modpods) {
|
|
#($name) = /(\w+)\.p(m|od)$/;
|
|
$name = path2modname($_);
|
|
if ($name =~ /^[a-z]/) {
|
|
push @pragmata, $_;
|
|
} else {
|
|
if ($done{$name}++) {
|
|
# warn "already did $_\n";
|
|
next;
|
|
}
|
|
push @modules, $_;
|
|
push @modname, $name;
|
|
}
|
|
}
|
|
|
|
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
|
|
|
|
|
|
|
|
=head1 PRAGMA DOCUMENTATION
|
|
|
|
EOPOD2B
|
|
|
|
podset(sort @pragmata);
|
|
|
|
($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
|
|
|
|
|
|
|
|
=head1 MODULE DOCUMENTATION
|
|
|
|
EOPOD2B
|
|
|
|
podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
|
|
|
|
($_= <<EOPOD2B) =~ s/^\t//gm;
|
|
|
|
|
|
=head1 AUXILIARY DOCUMENTATION
|
|
|
|
Here should be listed all the extra programs' documentation, but they
|
|
don't all have manual pages yet:
|
|
|
|
=over 4
|
|
|
|
=item a2p
|
|
|
|
=item s2p
|
|
|
|
=item find2perl
|
|
|
|
=item h2ph
|
|
|
|
=item c2ph
|
|
|
|
=item h2xs
|
|
|
|
=item xsubpp
|
|
|
|
=item pod2man
|
|
|
|
=item wrapsuid
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Larry Wall <F<larry\@wall.org>>, with the help of oodles
|
|
of other folks.
|
|
|
|
|
|
EOPOD2B
|
|
output $_;
|
|
output "\n"; # flush $LINE
|
|
exit;
|
|
|
|
sub podset {
|
|
local @ARGV = @_;
|
|
|
|
while(<>) {
|
|
if (s/^=head1 (NAME)\s*/=head2 /) {
|
|
$pod = path2modname($ARGV);
|
|
unhead1();
|
|
output "\n \n\n=head2 ";
|
|
$_ = <>;
|
|
if ( /^\s*$pod\b/ ) {
|
|
s/$pod\.pm/$pod/; # '.pm' in NAME !?
|
|
output $_;
|
|
} else {
|
|
s/^/$pod, /;
|
|
output $_;
|
|
}
|
|
next;
|
|
}
|
|
if (s/^=head1 (.*)/=item $1/) {
|
|
unhead2();
|
|
output "=over 4\n\n" unless $inhead1;
|
|
$inhead1 = 1;
|
|
output $_; nl(); next;
|
|
}
|
|
if (s/^=head2 (.*)/=item $1/) {
|
|
unitem();
|
|
output "=over 4\n\n" unless $inhead2;
|
|
$inhead2 = 1;
|
|
output $_; nl(); next;
|
|
}
|
|
if (s/^=item ([^=].*)/$1/) {
|
|
next if $pod eq 'perldiag';
|
|
s/^\s*\*\s*$// && next;
|
|
s/^\s*\*\s*//;
|
|
s/\n/ /g;
|
|
s/\s+$//;
|
|
next if /^[\d.]+$/;
|
|
next if $pod eq 'perlmodlib' && /^ftp:/;
|
|
##print "=over 4\n\n" unless $initem;
|
|
output ", " if $initem;
|
|
$initem = 1;
|
|
s/\.$//;
|
|
s/^-X\b/-I<X>/;
|
|
output $_; next;
|
|
}
|
|
if (s/^=cut\s*\n//) {
|
|
unhead1();
|
|
next;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub path2modname {
|
|
local $_ = shift;
|
|
s/\.p(m|od)$//;
|
|
s-.*?/(lib|ext)/--;
|
|
s-/-::-g;
|
|
s/(\w+)::\1/$1/;
|
|
return $_;
|
|
}
|
|
|
|
sub unhead1 {
|
|
unhead2();
|
|
if ($inhead1) {
|
|
output "\n\n=back\n\n";
|
|
}
|
|
$inhead1 = 0;
|
|
}
|
|
|
|
sub unhead2 {
|
|
unitem();
|
|
if ($inhead2) {
|
|
output "\n\n=back\n\n";
|
|
}
|
|
$inhead2 = 0;
|
|
}
|
|
|
|
sub unitem {
|
|
if ($initem) {
|
|
output "\n\n";
|
|
##print "\n\n=back\n\n";
|
|
}
|
|
$initem = 0;
|
|
}
|
|
|
|
sub nl {
|
|
output "\n";
|
|
}
|
|
|
|
my $NEWLINE; # how many newlines have we seen recently
|
|
my $LINE; # what remains to be printed
|
|
|
|
sub output ($) {
|
|
for (split /(\n)/, shift) {
|
|
if ($_ eq "\n") {
|
|
if ($LINE) {
|
|
print OUT wrap('', '', $LINE);
|
|
$LINE = '';
|
|
}
|
|
if ($NEWLINE < 2) {
|
|
print OUT;
|
|
$NEWLINE++;
|
|
}
|
|
}
|
|
elsif (/\S/ && length) {
|
|
$LINE .= $_;
|
|
$NEWLINE = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
!NO!SUBS!
|
|
|
|
close OUT or die "Can't close $file: $!";
|
|
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
|
|
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
|
|
chdir $origdir;
|