This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Module-Build to 0.4002
[perl5.git] / Porting / pod_lib.pl
index d6b4376..b257c66 100644 (file)
@@ -2,6 +2,7 @@
 
 use strict;
 use Digest::MD5 'md5';
+use File::Find;
 
 # make it clearer when we haven't run to completion, as we can be quite
 # noisy when things are working ok
@@ -37,6 +38,40 @@ sub write_or_die {
     close $fh or die "Can't close $filename: $!";
 }
 
+sub pods_to_install {
+    # manpages not to be installed
+    my %do_not_install = map { ($_ => 1) }
+        qw(Pod::Functions XS::APItest XS::Typemap);
+
+    my (%done, %found);
+
+    File::Find::find({no_chdir=>1,
+                      wanted => sub {
+                          if (m!/t\z!) {
+                              ++$File::Find::prune;
+                              return;
+                          }
+
+                          # $_ is $File::Find::name when using no_chdir
+                          return unless m!\.p(?:m|od)\z! && -f $_;
+                          return if m!lib/Net/FTP/.+\.pm\z!; # Hi, Graham! :-)
+                          # Skip .pm files that have corresponding .pod files
+                          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;
+
+                          return if $do_not_install{$_};
+                          return if is_duplicate_pod($File::Find::name);
+                          $found{/\A[a-z]/ ? 'PRAGMA' : 'MODULE'}{$_}
+                              = $File::Find::name;
+                      }}, 'lib');
+    return \%found;
+}
 
 my %state = (
              # Don't copy these top level READMEs
@@ -51,17 +86,18 @@ my %state = (
 
     sub is_duplicate_pod {
         my $file = shift;
+        local $_;
 
         # Initialise the list of possible source files on the first call.
         unless (%Lengths) {
             __prime_state() unless $state{master};
             foreach (@{$state{master}}) {
-                next if $_->[1] eq $_->[4];
+                next unless $_->[2]{dual};
                 # 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]))};
+                ++$Lengths{-s $_->[1]};
+                ++$MD5s{md5(slurp_or_die($_->[1]))};
             }
         }
 
@@ -152,6 +188,7 @@ sub __prime_state {
 
             my %flags;
             $flags{toc_omit} = 1 if $flags =~ tr/o//d;
+            $flags{dual} = $podname ne $leafname;
 
             $state{generated}{"$podname.pod"}++ if $flags =~ tr/g//d;
 
@@ -166,15 +203,13 @@ sub __prime_state {
             my_die "Unknown flag found in section line: $_" if length $flags;
 
             push @{$state{master}},
-                [\%flags, $podname, $filename, $desc, $leafname];
+                [$leafname, $filename, \%flags];
 
             if ($podname eq 'perldelta') {
                 local $" = '.';
-                my $delta_desc = "Perl changes in version @want";
                 push @{$state{master}},
-                    [{}, $state{delta_target}, "pod/$state{delta_target}",
-                     $delta_desc, $delta_leaf];
-                $state{pods}{$delta_leaf} = $delta_desc;
+                    [$delta_leaf, "pod/$state{delta_target}"];
+                $state{pods}{$delta_leaf} = "Perl changes in version @want";
             }
 
         } else {
@@ -182,6 +217,8 @@ sub __prime_state {
         }
     }
     close $master or my_die("close pod/perl.pod: $!");
+    # This has to be special-cased somewhere. Turns out this is cleanest:
+    push @{$state{master}}, ['a2p', 'x2p/a2p.pod', {toc_omit => 1}];
 
     my_die("perl.pod sets flags for unknown pods: "
            . join ' ', sort keys %flag_set)
@@ -193,6 +230,7 @@ sub get_pod_metadata {
     my $permit_missing_generated = shift;
     # Do they want a consistency report?
     my $callback = shift;
+    local $_;
 
     __prime_state() unless $state{master};
     return \%state unless $callback;
@@ -210,17 +248,15 @@ sub get_pod_metadata {
     my (%cpanpods, %cpanpods_leaf);
     my (%our_pods);
 
-    # These are stub files for deleted documents. We don't want them to show up
-    # in perl.pod, they just exist so that if someone types "perldoc perltoot"
-    # they get some sort of pointer to the new docs.
-    my %ignoredpods
-        = map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot );
+    # There are files that we don't want to list in perl.pod.
+    # Maybe the various stub manpages should be listed there.
+    my %ignoredpods = map { ( "$_.pod" => 1 ) } qw( );
 
     # Convert these to a list of filenames.
     ++$our_pods{"$_.pod"} foreach keys %{$state{pods}};
     foreach (@{$state{master}}) {
-        ++$our_pods{"$_->[4].pod"}
-            if $_->[0]{readme};
+        ++$our_pods{"$_->[0].pod"}
+            if $_->[2]{readme};
     }
 
     opendir my $dh, 'pod';
@@ -262,7 +298,7 @@ sub get_pod_metadata {
     my @inconsistent;
     foreach my $i (sort keys %disk_pods) {
         push @inconsistent, "$0: $i exists but is unknown by buildtoc\n"
-            unless $our_pods{$i};
+            unless $our_pods{$i} || $ignoredpods{$i};
         push @inconsistent, "$0: $i exists but is unknown by MANIFEST\n"
             if !$BuildFiles{'MANIFEST'} # Ignore if we're rebuilding MANIFEST
                 && !$manipods{$i} && !$manireadmes{$i} && !$state{copies}{$i}