—

              
#!/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 '$x = shift; exit($x =~ 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, '<:', $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>) {
        s/\r$//;
        if (s/^=head1 (NAME)\s*/=head2 /) {
            unhead1();
            $OUT .= "\n\n=head2 ";
            $_ = <$fh>;
            last unless defined $_;
            # 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+$//;
            # make sure inner links include the target page
            s{L<(?:[^|>]+\|)?\K/}{$pod/}g;
            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;
}
HideShow 38 lines of Pod
=head1 NAME
pod/buildtoc - Generate table of contents
=head1 DESCRIPTION
This program generates a table of contents for the documentation included in the Perl core distribution.  This table of contents takes two forms:
=over 4
=item 1 F<pod/perltoc.pod>
A file in Perl's Plain Old Documentation (POD) format found in the F<pod/> directory in the core distribution.  Once Perl is installed, this file becomes accessible system-wide via C<perldoc perltoc>.
=item 2 F<pod/roffitall>
A shell script originally written by Tom Christiansen and Raphael Manfredi, also found in the F<pod/> directory, which can be used to translate Perl documentation into F<man> pages.
=back
=head1 USAGE
This program will typically B<not> need to be called directly by a user.  Rather, it is one of the last commands invoked during C<make test_prep>:
    ./perl -Ilib -I. -f pod/buildtoc -q
The only command-line switch is C<-q|--quiet>, which quiets some non-critical warnings.
=head2 Diagnosing Problems
This program C<require>s F<Porting/pod_lib.pl> and makes use of several subroutines found in that file:  C<get_pod_metadata()> and C<pods_to_install()> in particular.  Consequently, any warnings or exceptions you see when this program is running may be being passed through from those subroutines.  You may have to (a) examine those subroutines and/or (b) run that program from the command-line to fully understand what is causing such warnings or exceptions.
=head2 AUTHORS and MAINTENANCE
This program was introduced into the Perl 5 core distribution by Andy Dougherty, based on earlier work by Tom Christiansen.  It is maintained by the Perl 5 Porters.
=cut
# ex: set ts=8 sts=4 sw=4 et: