279 lines
6.1 KiB
Perl
279 lines
6.1 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
use strict;
|
|
use File::Spec;
|
|
use FindBin;
|
|
use Text::Wrap;
|
|
use Getopt::Long;
|
|
|
|
our $Quiet;
|
|
no locale;
|
|
|
|
# Assumption is that we're either already being run from the top level (*nix,
|
|
# VMS), or have absolute paths in @INC (Win32, pod/Makefile)
|
|
BEGIN {
|
|
my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
|
|
chdir $Top or die "Can't chdir to $Top: $!";
|
|
require './Porting/pod_lib.pl';
|
|
}
|
|
|
|
die "$0: Usage: $0 [--quiet]\n"
|
|
unless GetOptions ('q|quiet' => \$Quiet) && !@ARGV;
|
|
|
|
my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
|
|
|
|
my $found = pods_to_install();
|
|
|
|
my_die "Can't find any pods!\n" unless %$found;
|
|
|
|
# Accumulating everything into a lexical before writing to disk dates from the
|
|
# time when this script also provided the functionality of regen/pod_rules.pl
|
|
# and this code was in a subroutine do_toc(). In turn, the use of a file scoped
|
|
# lexical instead of a parameter or return value is because the code dates back
|
|
# further still, and used *only* to create pod/perltoc.pod by printing direct
|
|
|
|
my $OUT;
|
|
my $roffitall;
|
|
|
|
($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
|
|
|
|
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
|
|
# This file is autogenerated by buildtoc from all the other pods.
|
|
# Edit those files and run $0 to effect changes.
|
|
|
|
=encoding UTF-8
|
|
|
|
=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
|
|
|
|
# All the things in the master list that happen to be pod filenames
|
|
foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
|
|
$roffitall .= " \$mandir/$_->[0].1 \\\n";
|
|
podset($_->[0], $_->[1]);
|
|
}
|
|
|
|
foreach my $type (qw(PRAGMA MODULE)) {
|
|
($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
|
|
|
|
|
|
|
|
=head1 $type DOCUMENTATION
|
|
|
|
EOPOD2B
|
|
|
|
foreach my $name (sort keys %{$found->{$type}}) {
|
|
$roffitall .= " \$libdir/$name.3 \\\n";
|
|
podset($name, $found->{$type}{$name});
|
|
}
|
|
}
|
|
|
|
$_= <<"EOPOD2B";
|
|
|
|
|
|
=head1 AUXILIARY DOCUMENTATION
|
|
|
|
Here should be listed all the extra programs' documentation, but they
|
|
don't all have manual pages yet:
|
|
|
|
=over 4
|
|
|
|
EOPOD2B
|
|
|
|
$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}};
|
|
$_ .= <<"EOPOD2B" ;
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Larry Wall <F<larry\@wall.org>>, with the help of oodles
|
|
of other folks.
|
|
|
|
|
|
EOPOD2B
|
|
|
|
s/^\t//gm;
|
|
$OUT .= "$_\n";
|
|
|
|
$OUT =~ s/\n\s+\n/\n\n/gs;
|
|
$OUT =~ s/\n{3,}/\n\n/g;
|
|
|
|
$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
|
|
|
|
write_or_die('pod/perltoc.pod', $OUT);
|
|
|
|
write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT');
|
|
#!/bin/sh
|
|
#
|
|
# Usage: roffitall [-nroff|-psroff|-groff]
|
|
#
|
|
# Authors: Tom Christiansen, Raphael Manfredi
|
|
|
|
me=roffitall
|
|
tmp=.
|
|
|
|
if test -f ../config.sh; then
|
|
. ../config.sh
|
|
fi
|
|
|
|
mandir=$installman1dir
|
|
libdir=$installman3dir
|
|
|
|
test -d $mandir || mandir=/usr/new/man/man1
|
|
test -d $libdir || libdir=/usr/new/man/man3
|
|
|
|
case "$1" in
|
|
-nroff) cmd="nroff -man"; ext='txt';;
|
|
-psroff) cmd="psroff -t"; ext='ps';;
|
|
-groff) cmd="groff -man"; ext='ps';;
|
|
*)
|
|
echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2
|
|
exit 1
|
|
;;
|
|
esac
|
|
|
|
toroff=`
|
|
echo \
|
|
EOH
|
|
| perl -ne 'map { -r && print "$_ " } split'`
|
|
|
|
# Bypass internal shell buffer limit -- can't use case
|
|
if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
|
|
echo "$me: empty file list -- did you run install?" >&2
|
|
exit 1
|
|
fi
|
|
|
|
#psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
|
|
#nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
|
|
|
|
# First, create the raw data
|
|
run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
|
|
echo "$me: running $run"
|
|
eval $run $toroff
|
|
|
|
#Now create the TOC
|
|
echo "$me: parsing TOC"
|
|
perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
|
|
run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
|
|
echo "$me: running $run"
|
|
eval $run
|
|
|
|
# Finally, recreate the Doc, without the blank page 0
|
|
run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
|
|
echo "$me: running $run"
|
|
eval $run $toroff
|
|
rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
|
|
echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
|
|
EOT
|
|
|
|
exit(0);
|
|
|
|
# Below are all the auxiliary routines for generating perltoc.pod
|
|
|
|
my ($inhead1, $inhead2, $initem);
|
|
|
|
sub podset {
|
|
my ($pod, $file) = @_;
|
|
|
|
open my $fh, '<:raw', $file or my_die "Can't open file '$file' for $pod: $!";
|
|
|
|
local *_;
|
|
my $found_pod;
|
|
while (<$fh>) {
|
|
if (/^=head1\s+NAME\b/) {
|
|
++$found_pod;
|
|
last;
|
|
}
|
|
}
|
|
|
|
unless ($found_pod) {
|
|
warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
|
|
return;
|
|
}
|
|
|
|
seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
|
|
local $/ = '';
|
|
|
|
while(<$fh>) {
|
|
tr/\015//d;
|
|
if (s/^=head1 (NAME)\s*/=head2 /) {
|
|
unhead1();
|
|
$OUT .= "\n\n=head2 ";
|
|
$_ = <$fh>;
|
|
# Remove svn keyword expansions from the Perl FAQ
|
|
s/ \(\$Revision: \d+ \$\)//g;
|
|
if ( /^\s*\Q$pod\E\b/ ) {
|
|
s/$pod\.pm/$pod/; # '.pm' in NAME !?
|
|
} else {
|
|
s/^/$pod, /;
|
|
}
|
|
}
|
|
elsif (s/^=head1 (.*)/=item $1/) {
|
|
unhead2();
|
|
$OUT .= "=over 4\n\n" unless $inhead1;
|
|
$inhead1 = 1;
|
|
$_ .= "\n";
|
|
}
|
|
elsif (s/^=head2 (.*)/=item $1/) {
|
|
unitem();
|
|
$OUT .= "=over 4\n\n" unless $inhead2;
|
|
$inhead2 = 1;
|
|
$_ .= "\n";
|
|
}
|
|
elsif (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:/;
|
|
$OUT .= ", " if $initem;
|
|
$initem = 1;
|
|
s/\.$//;
|
|
s/^-X\b/-I<X>/;
|
|
}
|
|
else {
|
|
unhead1() if /^=cut\s*\n/;
|
|
next;
|
|
}
|
|
$OUT .= $_;
|
|
}
|
|
}
|
|
|
|
sub unhead1 {
|
|
unhead2();
|
|
if ($inhead1) {
|
|
$OUT .= "\n\n=back\n\n";
|
|
}
|
|
$inhead1 = 0;
|
|
}
|
|
|
|
sub unhead2 {
|
|
unitem();
|
|
if ($inhead2) {
|
|
$OUT .= "\n\n=back\n\n";
|
|
}
|
|
$inhead2 = 0;
|
|
}
|
|
|
|
sub unitem {
|
|
if ($initem) {
|
|
$OUT .= "\n\n";
|
|
}
|
|
$initem = 0;
|
|
}
|
|
|
|
# ex: set ts=8 sts=4 sw=4 et:
|