This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Prime the duplicate Pod cache the first time is_duplicate_pod() is called.
authorNicholas Clark <nick@ccl4.org>
Sun, 18 Dec 2011 14:03:18 +0000 (15:03 +0100)
committerNicholas Clark <nick@ccl4.org>
Mon, 19 Dec 2011 12:55:19 +0000 (13:55 +0100)
Previously it was primed when get_pod_metadata() was called. This removes the
undocumented assumption that is_duplicate_pod() will only be called after
get_pod_metadata(), and avoids reading 14 Pod files to calculate their MD5s
unless actually necessary.

This change means that the array references in @{$state{master}} are being
accessed much later during runtime. This reveals that podset() in buildtoc
had been clobbering its callers $_, which happened to be an alias to the
current element of @{$state{master}}.

Porting/pod_lib.pl
pod/buildtoc

index e241208..a40bdb4 100644 (file)
@@ -48,14 +48,30 @@ my %state = (
 
 my %Readmepods;
 
-my (%Lengths, %MD5s);
-
-sub is_duplicate_pod {
-    my $file = shift;
-    # 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))};
+{
+    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 {
@@ -119,14 +135,6 @@ sub __prime_state {
             my_die "Unknown flag found in section line: $_" if length $flags;
             my ($leafname) = $podname =~ m!([^/]+)$!;
 
-            if ($leafname ne $podname) {
-                # We are 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 $filename};
-                ++$MD5s{md5(slurp_or_die($filename))};
-            }
-
             push @{$state{master}},
                 [\%flags, $podname, $filename, $desc, $leafname];
         } elsif (/^$/) {
index 839fbb1..c61a425 100644 (file)
@@ -223,6 +223,7 @@ sub podset {
     my ($pod, $file) = @_;
 
     local $/ = '';
+    local *_;
 
     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";