#!/usr/bin/perl -w
use strict;
-use vars qw(%Pragmata %Modules $Quiet);
use File::Spec;
-use File::Find;
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,
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('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!/lib/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');
-
-my_die "Can't find any pods!\n" unless @modpods;
-
-my %done;
-for (@modpods) {
- my $name = $_;
- $name =~ s/\.p(m|od)$//;
- $name =~ s-.*?/lib/--;
- $name =~ s-/-::-g;
- next if $done{$name}++;
-
- if ($name =~ /^[a-z]/) {
- $Pragmata{$name} = $_;
- } else {
- $Modules{$name} = $_;
- }
-}
+ 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
# 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 $_ && @$_ == 3 && !$_->[0]{toc_omit}} @{$state->{master}}) {
- podset(@$_);
+foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
+ $roffitall .= " \$mandir/$_->[0].1 \\\n";
+ podset($_->[0], $_->[1]);
}
-
-($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
+foreach my $type (qw(PRAGMA MODULE)) {
+ ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
- =head1 PRAGMA DOCUMENTATION
+ =head1 $type DOCUMENTATION
EOPOD2B
-foreach (sort keys %Pragmata) {
- podset($_, $Pragmata{$_});
-}
-
-($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
-
-
-
- =head1 MODULE DOCUMENTATION
-
-EOPOD2B
-
-foreach (sort keys %Modules) {
- podset($_, $Modules{$_});
+ foreach my $name (sort keys %{$found->{$type}}) {
+ $roffitall .= " \$libdir/$name.3 \\\n";
+ podset($name, $found->{$type}{$name});
+ }
}
$_= <<"EOPOD2B";
EOPOD2B
-$_ .= join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
+$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}};
$_ .= <<"EOPOD2B" ;
=back
$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
-my $filename = 'pod/perltoc.pod';
-open my $fh, '>', $filename
- or my_die "Can't open $filename for writing: $!";
-print $fh $OUT or my_die "Can't print to $filename: $!";
-close $fh or my_die "Can't close $filename: $!";
+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);
sub podset {
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: $!";
+ 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;
$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 %Pragmata),
- "\t\t\\",
- map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
- )
-}
+# ex: set ts=8 sts=4 sw=4 et:
https://perl5.git.perl.org / perl5.git / blobdiff