summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-12-18 15:03:18 +0100
committerNicholas Clark <nick@ccl4.org>2011-12-19 13:55:19 +0100
commit4027e27b35630b1e4213355d1223d476fa09a600 (patch)
tree5b10fc4805ea0879fa65b925ca012564c792464f
parent9887f4486771327e32cc7026d4b939cc89ccc7b2 (diff)
downloadperl-4027e27b35630b1e4213355d1223d476fa09a600.tar.gz
Prime the duplicate Pod cache the first time is_duplicate_pod() is called.
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}}.
-rw-r--r--Porting/pod_lib.pl40
-rw-r--r--pod/buildtoc1
2 files changed, 25 insertions, 16 deletions
diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl
index e241208751..a40bdb4d3b 100644
--- a/Porting/pod_lib.pl
+++ b/Porting/pod_lib.pl
@@ -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 (/^$/) {
diff --git a/pod/buildtoc b/pod/buildtoc
index 839fbb16a4..c61a425c85 100644
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -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: $!";