From 4027e27b35630b1e4213355d1223d476fa09a600 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 18 Dec 2011 15:03:18 +0100 Subject: 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}}. --- Porting/pod_lib.pl | 40 ++++++++++++++++++++++++---------------- pod/buildtoc | 1 + 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: $!"; -- cgit v1.2.1