Merge installman and pod/buildtoc improvements to blead.

6 files changed, 191 insertions, 162 deletions

diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl
index 25e33d58bc..95bea6114b 100644
--- a/Porting/pod_lib.pl
+++ b/Porting/pod_lib.pl
@@ -1,6 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
+use Digest::MD5 'md5';
 
 # make it clearer when we haven't run to completion, as we can be quite
 # noisy when things are working ok
@@ -36,30 +37,45 @@ sub write_or_die {
     close $fh or die "Can't close $filename: $!";
 }
 
-sub get_pod_metadata {
-    # Do we expect to find generated pods on disk?
-    my $permit_missing_generated = shift;
-    my %BuildFiles;
 
-    foreach my $path (@_) {
-        $path =~ m!([^/]+)$!;
-        ++$BuildFiles{$1};
-    }
+my %state = (
+             # Don't copy these top level READMEs
+             ignore => {
+                        micro => 1,
+                        # vms => 1,
+                       },
+            );
 
-    my %state =
-        (
-         # Don't copy these top level READMEs
-         ignore =>
-         {
-          micro => 1,
-          # vms => 1,
-         },
-     );
+{
+    my (%Lengths, %MD5s);
+
+    sub is_duplicate_pod {
+        my $file = shift;
+
+        # Initialise the list of possible source files on the first call.
+        unless (%Lengths) {
+            __prime_state() unless $state{master};
+            foreach (@{$state{master}}) {
+                next if !$_ || @$_ < 4 || $_->[1] eq $_->[4];
+                # This is a dual-life perl*.pod file, which will have be copied
+                # to lib/ by the build process, and hence also found there.
+                # These are the only pod files that might become duplicated.
+                ++$Lengths{-s $_->[2]};
+                ++$MD5s{md5(slurp_or_die($_->[2]))};
+            }
+        }
+
+        # We are a file in lib. Are we a duplicate?
+        # Don't bother calculating the MD5 if there's no interesting file of
+        # this length.
+        return $Lengths{-s $file} && $MD5s{md5(slurp_or_die($file))};
+    }
+}
 
+sub __prime_state {
     my $source = 'perldelta.pod';
     my $filename = "pod/$source";
-    my $fh = open_or_die($filename);
-    my $contents = do {local $/; <$fh>};
+    my $contents = slurp_or_die($filename);
     my @want =
         $contents =~ /perldelta - what is new for perl v(5)\.(\d+)\.(\d+)\n/;
     die "Can't extract version from $filename" unless @want;
@@ -73,7 +89,6 @@ sub get_pod_metadata {
 
 
     # process pod.lst
-    my %Readmepods;
     my $master = open_or_die('pod.lst');
 
     foreach (<$master>) {
@@ -107,7 +122,7 @@ sub get_pod_metadata {
             if ($flags =~ tr/r//d) {
                 my $readme = $podname;
                 $readme =~ s/^perl//;
-                $Readmepods{$podname} = $state{readmes}{$readme} = $desc;
+                $state{readmes}{$readme} = $desc;
                 $flags{readme} = 1;
             } elsif ($flags{aux}) {
                 $state{aux}{$podname} = $desc;
@@ -116,6 +131,7 @@ sub get_pod_metadata {
             }
             my_die "Unknown flag found in section line: $_" if length $flags;
             my ($leafname) = $podname =~ m!([^/]+)$!;
+
             push @{$state{master}},
                 [\%flags, $podname, $filename, $desc, $leafname];
         } elsif (/^$/) {
@@ -125,6 +141,23 @@ sub get_pod_metadata {
         }
     }
     close $master or my_die "close pod.lst: $!";
+}
+
+sub get_pod_metadata {
+    # Do we expect to find generated pods on disk?
+    my $permit_missing_generated = shift;
+    # Do they want a consistency report?
+    my $callback = shift;
+
+    __prime_state() unless $state{master};
+    return \%state unless $callback;
+
+    my %BuildFiles;
+
+    foreach my $path (@_) {
+        $path =~ m!([^/]+)$!;
+        ++$BuildFiles{$1};
+    }
 
     # Sanity cross check
 
@@ -139,8 +172,10 @@ sub get_pod_metadata {
         = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot );
 
     # Convert these to a list of filenames.
-    foreach (keys %{$state{pods}}, keys %Readmepods) {
-        $our_pods{"$_.pod"}++;
+    ++$our_pods{"$_.pod"} foreach keys %{$state{pods}};
+    foreach (@{$state{master}}) {
+        ++$our_pods{"$_->[1].pod"}
+            if defined $_ && @$_ == 5 && $_->[0]{readme};
     }
 
     opendir my $dh, 'pod';
@@ -225,7 +260,7 @@ sub get_pod_metadata {
                     or $not_yet_there{$i};
         }
     }
-    $state{inconsistent} = \@inconsistent;
+    &$callback(@inconsistent);
     return \%state;
 }
 
diff --git a/Porting/pod_rules.pl b/Porting/pod_rules.pl
index acea2d22f5..d23f86f935 100644
--- a/Porting/pod_rules.pl
+++ b/Porting/pod_rules.pl
@@ -62,23 +62,20 @@ if ($Verbose) {
     print "I will be building $_\n" foreach keys %Build;
 }
 
+my $test = 1;
 # For testing, generated files must be present and we're rebuilding nothing.
 # For normal rebuilding, generated files may not be present, and we mute
 # warnings about inconsistencies in any file we're about to rebuild.
-my $state = get_pod_metadata($Test ? () : (1, values %Build));
-
-my $test = 1;
-if ($Test) {
-    printf "1..%d\n", 1 + scalar keys %Build;
-    if (@{$state->{inconsistent}}) {
-        print "not ok $test\n";
-        die @{$state->{inconsistent}};
-    }
-    print "ok $test\n";
-}
-else {
-    warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
-}
+my $state = $Test
+    ? get_pod_metadata(0, sub {
+                           printf "1..%d\n", 1 + scalar keys %Build;
+                           if (@_) {
+                               print "not ok $test\n";
+                               die @_;
+                           }
+                           print "ok $test\n";
+                       })
+    : get_pod_metadata(1, sub { warn @_ if @_ }, values %Build);
 
 sub generate_perlpod {
     my @output;
diff --git a/installman b/installman
index 2c20790def..e986a78410 100755
--- a/installman
+++ b/installman
@@ -9,12 +9,13 @@ use strict;
 
 use Getopt::Long;
 use File::Find;
-use File::Copy;
 use File::Path qw(mkpath);
 use ExtUtils::Packlist;
 use Pod::Man;
-use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_NetWare
-	    %opts $packlist);
+use vars qw(%opts $packlist);
+
+require './Porting/pod_lib.pl';
+my $state = get_pod_metadata();
 
 $ENV{SHELL} = 'sh' if $^O eq 'os2';
 
@@ -26,7 +27,6 @@ die "Patchlevel of perl ($patchlevel)",
 my $usage =
 "Usage:  installman --man1dir=/usr/wherever --man1ext=1
                    --man3dir=/usr/wherever --man3ext=3
-		   --batchlimit=40
 	           --notify --verbose --silent --help
 	Defaults are:
 	man1dir = $Config{'installman1dir'};
@@ -38,7 +38,7 @@ my $usage =
         --silent  (or -S) be silent. Only report errors.\n";
 
 GetOptions( \%opts,
-            qw( man1dir=s man1ext=s man3dir=s man3ext=s batchlimit=i
+            qw( man1dir=s man1ext=s man3dir=s man3ext=s
                 destdir:s notify n help silent S verbose V))
 	|| die $usage;
 die $usage if $opts{help};
@@ -68,10 +68,15 @@ $packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.pack
 my %do_not_install = map { ($_ => 1) } qw(
     Pod/Functions.pm
     XS/APItest.pm
+    XS/Typemap.pm
 );
 
 # Install the main pod pages.
-pod2man('pod', $opts{man1dir}, $opts{man1ext});
+pod2man({
+         map {
+             $_ && @$_ > 2 && !$_->[0]{aux} ? ($_->[4], $_->[2]): ()
+         } @{$state->{master}}
+        }, $opts{man1dir}, $opts{man1ext});
 
 # Install the pods for library modules.
 pod2man('lib', $opts{man3dir}, $opts{man3ext});
@@ -83,12 +88,12 @@ while (<UTILS>) {
     next if /^#/;
     chomp;
     $_ = $1 if /#.*pod\s*=\s*(\S+)/;
-    my ($where, $what) = m|^(\S*)/(\S+)|;
-    pod2man($where, $opts{man1dir}, $opts{man1ext}, $what);
+    my ($path, $leaf) = m|^(\S*/(\S+))|;
+    pod2man({$leaf, $path}, $opts{man1dir}, $opts{man1ext});
     if ($has_man1dir) {
-	if (my ($where2, $what2) = m|#.*link\s*=\s*(\S+)/(\S+)|) {
-	    my $old = "$opts{man1dir}/$what.$opts{man1ext}";
-	    my $new = "$opts{man1dir}/$what2.$opts{man1ext}";
+        if (my ($link) = m|#.*link\s*=\s*\S+/(\S+)|) {
+            my $old = "$opts{man1dir}/$leaf.$opts{man1ext}";
+            my $new = "$opts{man1dir}/$link.$opts{man1ext}";
 	    unlink($new);
 	    link($old, $new);
 	    my $xold = $old;
@@ -101,54 +106,53 @@ while (<UTILS>) {
 }
 
 sub pod2man {
-    # @script is scripts names if we are installing manpages embedded
-    # in scripts, () otherwise
-    my($poddir, $mandir, $manext, @script) = @_;
+    my($what, $mandir, $manext) = @_;
     if ($mandir eq ' ' or $mandir eq '') {
-	if (@script) {
-	    warn "Skipping installation of $poddir/$_ man page.\n"
-		foreach @script;
+        if (ref $what) {
+            warn "Skipping installation of $_ man page.\n"
+                foreach values %$what;
 	} else {
-	    warn "Skipping installation of $poddir man pages.\n";
+            warn "Skipping installation of $what man pages.\n"
 	}
 	return;
     }
 
-    print "installing from $poddir\n" if $opts{verbose};
+    if ($opts{verbose}) {
+        if (ref $what) {
+            print "installing $_\n"
+                foreach sort keys %$what;
+        } else {
+            print "installing from $what\n";
+        }
+    }
 
     mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify};  # In File::Path
-    # Make a list of all the .pm and .pod files in the directory.  We avoid
-    # chdir because we are running with @INC = '../lib', and modules may wish
-    # to dynamically require Carp::Heavy or other diagnostics warnings.
-    # Hash the names of files we find, keys are names relative to perl build
-    # dir ('.'), values are names relative to $poddir.
-    my %modpods;
-    if (@script) {
-	%modpods = (map {+"$poddir/$_", $_} @script);
+
+    my $modpods;
+    if (ref $what) {
+        $modpods = $what;
     }
     else {
+        # Make a list of all the .pm and .pod files in the directory.
 	File::Find::find({no_chdir=>1,
                           wanted => sub {
                               # $_ is $File::Find::name when using no_chdir
                               if (-f $_ and /\.p(?:m|od)$/) {
-                                  my $fullname = $_;
-                                  s!^\Q$poddir\E/!!;
-                                  # perlfaq manpages are installed in section 1,
-                                  # so skip when searching files for section 3
-                                  return if m(perlfaq.?\.pod|perlglossary.pod);
-                                  $modpods{$fullname} = $_;
+                                  my $pod = $_;
+                                  # Skip .pm files that have corresponding .pod files
+                                  return if $pod =~ s/\.pm$/.pod/ && -f $pod;
+                                  return if m!(?:^|/)t/!;
+                                  s!^\Q$what\E/!!;
+                                  return if $do_not_install{$_};
+                                  return if is_duplicate_pod($File::Find::name);
+                                  $modpods->{$_} = $File::Find::name;
                               }
                           }},
-                         $poddir);
+                         $what);
     }
-    my @to_process;
-    foreach my $mod (sort keys %modpods) {
-        my $manpage = $modpods{$mod};
-	my $tmp;
-	# Skip .pm files that have corresponding .pod files, and Functions.pm.
-	next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp);
-	next if $mod =~ m:/t/:; # no pods from test directories
-	next if $do_not_install{$manpage};
+
+    foreach my $manpage (sort keys %$modpods) {
+        my $mod = $modpods->{$manpage};
 
 	# Skip files without pod docs
 	my $has_pod;
@@ -157,7 +161,7 @@ sub pod2man {
 	    local $_;
 	    while (<T>)
 	    {
-		++$has_pod and last if /^=(?:head\d+|item|pod)\b/;
+                ++$has_pod and last if /^=head1\b/;
 	    }
 
 	    close T;
@@ -178,13 +182,8 @@ sub pod2man {
 	else {
 	  $manpage =~ s#/#::#g;
 	}
-	$tmp = "${mandir}/${manpage}.tmp";
+        my $tmp = "${mandir}/${manpage}.tmp";
 	$manpage = "${mandir}/${manpage}.${manext}";
-	push @to_process, [$mod, $tmp, $manpage];
-    }
-
-    foreach my $page (@to_process) {
-	my($pod, $tmp, $manpage) = @$page;
 
         my $parser = Pod::Man->new( section => $manext,
                                     official=> 1,
@@ -193,7 +192,7 @@ sub pod2man {
 	my $xmanpage = $manpage;
 	$xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
         print "  $xmanpage\n";
-	if (!$opts{notify} && $parser->parse_from_file($pod, $tmp)) {
+        if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) {
             if (-s $tmp) {
                 if (rename($tmp, $manpage)) {
                     $packlist->{$xmanpage} = { type => 'file' };
@@ -223,3 +222,10 @@ sub rename {
     link($from,$to) || return 0;
     unlink($from);
 }
+
+# Local variables:
+# cperl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
+#
+# ex: set ts=8 sts=4 sw=4 et:
diff --git a/pod/buildtoc b/pod/buildtoc
index 4024d070a6..a8a05ff414 100644
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -1,13 +1,12 @@
 #!/usr/bin/perl -w
 
 use strict;
-use vars qw(%Found $Quiet %Lengths %MD5s);
+use vars qw(%Found $Quiet);
 use File::Spec;
 use File::Find;
 use FindBin;
 use Text::Wrap;
 use Getopt::Long;
-use Digest::MD5 'md5';
 
 no locale;
 
@@ -22,53 +21,30 @@ BEGIN {
 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}};
+my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
 
 # 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');
-
-my_die "Can't find any pods!\n" unless @modpods;
-
 my %done;
-for (@modpods) {
-    my $name = $_;
-    $name =~ s/\.p(m|od)$//;
-    $name =~ s-\Alib/--;
-    $name =~ s-/-::-g;
-    next if $done{$name}++;
-
-    $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
-}
+find({no_chdir => 1,
+      wanted => sub {
+          if (/\.p(od|m)$/) {
+              return if m!/Pod/Functions.pm\z!; # Used only by pod itself
+              return if m!(?:^|/)t/!;
+              return if m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
+              return if m!XS/(?:APItest|Typemap)!;
+              return if s!pm\z!pod! && -e $_;
+              s!\.pod\z!!;
+              s!\Alib/!!;
+              s!/!::!g;
+              my_die("Duplicate files for $_, '$done{$_}' and '$File::Find::name'")
+                  if exists $done{$_};
+
+              $done{$_} = $File::Find::name;
+              $Found{/\A[a-z]/ ? 'PRAGMA' : 'MODULE'}{$_} = $File::Find::name;
+          }
+      }}, 'lib');
+
+my_die "Can't find any pods!\n" unless %done;
 
 # 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
@@ -102,7 +78,7 @@ 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]);
+    podset($_->[4], $_->[2]);
 }
 
 foreach my $type (qw(PRAGMA MODULE)) {
@@ -115,8 +91,9 @@ 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});
+        next if is_duplicate_pod($Found{$type}{$name});
+        $roffitall .= "    \$libdir/$name.3 \\\n";
+        podset($name, $Found{$type}{$name});
     }
 }
 
@@ -226,23 +203,27 @@ exit(0);
 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 /) {
@@ -288,7 +269,6 @@ sub podset {
 	}
 	$OUT .= $_;
     }
-    return 1;
 }
 
 sub unhead1 {
@@ -313,3 +293,10 @@ sub unitem {
     }
     $initem = 0;
 }
+
+# Local variables:
+# cperl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
+#
+# ex: set ts=8 sts=4 sw=4 et:
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e01b799c82..7dca8bfc63 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -676,6 +676,21 @@ XXX Is that Perl version correct?  Is the file path correct?
 
 =item *
 
+The man page for C<XS::Typemap> is no longer installed. C<XS::Typemap> is
+a test module which is not installed, hence installing its documentation
+makes no sense.
+
+=for 5.16.0 Merge this with the entry for "Stop installing XS::APItest*"
+
+=item *
+
+The man pages for the perl FAQ, L<perlxs>, L<perlxstut> and L<perldoc> are
+once again correctly installed in F<man1>, not F<man3>
+
+=for 5.16.0 This isn't a regression from 5.14.x, so don't mention this.
+
+=item *
+
 The -Dusesitecustomize and -Duserelocatableinc options now work together
 properly.
 
diff --git a/utils.lst b/utils.lst
index 8ce291eefd..7dd49859a5 100644
--- a/utils.lst
+++ b/utils.lst
@@ -1,14 +1,3 @@
-cpan/perlfaq/lib/perlfaq.pod
-cpan/perlfaq/lib/perlfaq1.pod
-cpan/perlfaq/lib/perlfaq2.pod
-cpan/perlfaq/lib/perlfaq3.pod
-cpan/perlfaq/lib/perlfaq4.pod
-cpan/perlfaq/lib/perlfaq5.pod
-cpan/perlfaq/lib/perlfaq6.pod
-cpan/perlfaq/lib/perlfaq7.pod
-cpan/perlfaq/lib/perlfaq8.pod
-cpan/perlfaq/lib/perlfaq9.pod
-cpan/perlfaq/lib/perlglossary.pod
 cpan/Pod-LaTeX/blib/script/pod2latex
 cpan/podlators/blib/script/pod2man
 cpan/podlators/blib/script/pod2text