#!/usr/bin/perl -w
use strict;
-use vars qw(%Found $Quiet %Lengths %MD5s);
use File::Spec;
-use File::Find;
use FindBin;
use Text::Wrap;
use Getopt::Long;
-use Digest::MD5 'md5';
+our $Quiet;
no locale;
# Assumption is that we're either already being run from the top level (*nix,
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';
+ require './Porting/pod_lib.pl';
}
die "$0: Usage: $0 [--quiet]\n"
- unless GetOptions (quiet => \$Quiet) && !@ARGV;
-
-my $state = get_pod_metadata(0, 'pod/perltoc.pod');
-
-warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
-
-# Find all the modules
-my @modpods;
-find(sub {
- if (/\.p(od|m)$/) {
- my $file = $File::Find::name;
- return if $file =~ qr!/Pod/Functions.pm\z!; # Used only by pod itself
- return if $file =~ m!(?:^|/)t/!;
- return if $file =~ m!lib/Attribute/Handlers/demo/!;
- return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
- return if $file =~ m!lib/Math/BigInt/t/!;
- return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
- return if $file =~ m!XS/(?:APItest|Typemap)!;
- my $pod = $file;
- return if $pod =~ s/pm$/pod/ && -e $pod;
- unless (open my $f, '<', $_) {
- warn "$0: bogus <$file>: $!";
- system "ls", "-l", $file;
- }
- else {
- my $line;
- while ($line = <$f>) {
- if ($line =~ /^=head1\s+NAME\b/) {
- push @modpods, $file;
- return;
- }
- }
- warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
- }
- }
- }, 'lib');
+ unless GetOptions ('q|quiet' => \$Quiet) && !@ARGV;
-my_die "Can't find any pods!\n" unless @modpods;
+my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
-my %done;
-for (@modpods) {
- my $name = $_;
- $name =~ s/\.p(m|od)$//;
- $name =~ s-\Alib/--;
- $name =~ s-/-::-g;
- next if $done{$name}++;
+my $found = pods_to_install();
- $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
-}
+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
# further still, and used *only* to create pod/perltoc.pod by printing direct
my $OUT;
+my $roffitall;
($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
# 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
EOPOD2B
# All the things in the master list that happen to be pod filenames
-foreach (grep {defined $_ && @$_ == 5 && !$_->[0]{toc_omit}} @{$state->{master}}) {
- podset($_->[4], $_->[2], $_->[1] ne $_->[4]);
+foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
+ $roffitall .= " \$mandir/$_->[0].1 \\\n";
+ podset($_->[0], $_->[1]);
}
foreach my $type (qw(PRAGMA MODULE)) {
EOPOD2B
- foreach my $name (sort keys %{$Found{$type}}) {
- podset($name, $Found{$type}{$name});
+ foreach my $name (sort keys %{$found->{$type}}) {
+ $roffitall .= " \$libdir/$name.3 \\\n";
+ podset($name, $found->{$type}{$name});
}
}
EOPOD2B
-$_ .= join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
+$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}};
$_ .= <<"EOPOD2B" ;
=back
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, $possibly_duplicated) = @_;
+ my ($pod, $file) = @_;
- local $/ = '';
+ open my $fh, '<:raw', $file or my_die "Can't open file '$file' for $pod: $!";
- open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
- if ($possibly_duplicated) {
- # We are a dual-life perl*.pod file, which will have be copied to lib/
- # by the build process, and hence also found there.
- ++$Lengths{-s $file};
- ++$MD5s{md5(slurp_or_die($file))};
- } elsif (!defined $possibly_duplicated) {
- # We are a file in lib. Are we a duplicate?
- # Don't bother calculating the MD5 if there's no intersting file of this
- # length.
- return if $Lengths{-s $file} && $MD5s{md5(slurp_or_die($file))};
+ 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 /) {
$initem = 0;
}
-# Code added in commit 416302502f485afa, but never used.
-# Probably roffitall should become something that buildtoc generates, instead
-# of something that we ship in the distribution.
-
-sub generate_roffitall {
- (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
- "\t\t\\",
- map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
- "\t\t\\",
- map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{PRAGMA}}),
- "\t\t\\",
- map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{MODULE}}),
- )
-}
+# ex: set ts=8 sts=4 sw=4 et: