#!/usr/bin/perl -w
use strict;
-use vars qw(%Found $Quiet %Lengths %MD5s);
+use vars qw($Quiet);
use File::Spec;
-use File::Find;
use FindBin;
use Text::Wrap;
use Getopt::Long;
-use Digest::MD5 'md5';
no locale;
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/Net/FTP/.+\.pm!; # Hi, Graham! :-)
- return if $file =~ m!XS/(?:APItest|Typemap)!;
- my $pod = $_;
- return if $pod =~ s/pm$/pod/ && -e $pod;
- open my $f, '<', $_ or my_die "Can't open file '$_': $!";
- {
- 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 $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
-my_die "Can't find any pods!\n" unless @modpods;
+my $found = pods_to_install();
-my %done;
-for (@modpods) {
- my $name = $_;
- $name =~ s/\.p(m|od)$//;
- $name =~ s-\Alib/--;
- $name =~ s-/-::-g;
- my_die("Duplicate files for $name, '$done{$name}' and '$_'")
- if exists $done{$name};
- $done{$name} = $_;
-
- $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
# 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}}) {
- $roffitall .= " \$mandir/$_->[4].1 \\\n";
- 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}}) {
- $roffitall .= " \$libdir/$name.3 \\\n"
- if 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
my ($inhead1, $inhead2, $initem);
sub podset {
- my ($pod, $file, $possibly_duplicated) = @_;
-
- local $/ = '';
+ my ($pod, $file) = @_;
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 /) {
}
$OUT .= $_;
}
- return 1;
}
sub unhead1 {