| Subject: | [PATCH] 0.36_09 - _case_tolerant, file_qr method, no uc paths |
- New method _case_tolerant to cache slow File::Spec::case_tolerant
calls.
I wrote those upstream methods, I should know.
This fixes RT#55162, improving performance from typically
5 min to 10 seconds.
- Make file_qr a method.
- Do not store uppercased paths on case_tolerant filesystems, only do
case-insensitive comparisons.
--
Reini Urban
| Subject: | 0001-0.36_09-_case_tolerant-file_qr-method-no-uc-paths.patch |
From 408db7a80028f08f47af5c8061b929f1ffdeb52c Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Mon, 12 Apr 2010 13:08:19 +0200
Subject: [PATCH] 0.36_09 - _case_tolerant, file_qr method, no uc paths
- New method _case_tolerant to cache slow File::Spec::case_tolerant calls.
I wrote those upstream methods, I should know.
This fixes RT#55162, improving performance from typically 5 min to 10 seconds.
- Make file_qr a method.
- Do not store uppercased paths on case_tolerant filesystems, only do
case-insensitive comparisons. [Reini Urban]
---
Changes | 11 +++++++++++
lib/Module/Build/Base.pm | 43 +++++++++++++++++++++++--------------------
2 files changed, 34 insertions(+), 20 deletions(-)
diff --git a/Changes b/Changes
index 5a7c6ca..efd6089 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,16 @@
Revision history for Perl extension Module::Build.
+0.36_09 -
+
+ Bug fixes:
+
+ - New method _case_tolerant to cache slow File::Spec::case_tolerant calls.
+ I wrote those upstream methods, I should know.
+ This fixes RT#55162, improving performance from typically 5 min to 10 seconds.
+ - Make file_qr a method.
+ - Do not store uppercased paths on case_tolerant filesystems, only do
+ case-insensitive comparisons. [Reini Urban]
+
0.36_08 -
Enhancements:
diff --git a/lib/Module/Build/Base.pm b/lib/Module/Build/Base.pm
index 5e1d960..d44f951 100644
--- a/lib/Module/Build/Base.pm
+++ b/lib/Module/Build/Base.pm
@@ -4,7 +4,7 @@ package Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.36_08';
+$VERSION = '0.36_09';
$VERSION = eval $VERSION;
BEGIN { require 5.00503 }
@@ -1686,9 +1686,6 @@ sub print_build_script {
my %q = map {$_, $self->$_()} qw(config_dir base_dir);
- my $case_tolerant = 0+(File::Spec->can('case_tolerant')
- && File::Spec->case_tolerant);
- $q{base_dir} = uc $q{base_dir} if $case_tolerant;
$q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;
$q{magic_numfile} = $self->config_file('magicnum');
@@ -2667,7 +2664,7 @@ sub ACTION_testcover {
# testcover was run. If so, start over.
if (-e 'cover_db') {
my $pm_files = $self->rscan_dir
- (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') );
+ (File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});
$self->do_system(qw(cover -delete))
@@ -2732,11 +2729,11 @@ sub process_support_files {
if (ref($p->{c_source}) eq "ARRAY") {
push @{$p->{include_dirs}}, @{$p->{c_source}};
for my $path (@{$p->{c_source}}) {
- push @$files, @{ $self->rscan_dir($path, file_qr('\.c(c|p|pp|xx|\+\+)?$')) };
+ push @$files, @{ $self->rscan_dir($path, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')) };
}
} else {
push @{$p->{include_dirs}}, $p->{c_source};
- $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(c|p|pp|xx|\+\+)?$'));
+ $files = $self->rscan_dir($p->{c_source}, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$'));
}
foreach my $file (@$files) {
@@ -2861,7 +2858,7 @@ sub find_PL_files {
return unless -d 'lib';
return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
- file_qr('\.PL$')) } };
+ $self->file_qr('\.PL$')) } };
}
sub find_pm_files { shift->_find_file_by_type('pm', 'lib') }
@@ -2914,7 +2911,7 @@ sub _find_file_by_type {
return { map {$_, $_}
map $self->localize_file_path($_),
grep !/\.\#/,
- @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
+ @{ $self->rscan_dir($dir, $self->file_qr("\\.$type\$")) } };
}
sub localize_file_path {
@@ -2987,7 +2984,7 @@ sub ACTION_testpod {
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
keys %{$self->_find_pods
($self->bindoc_dirs,
- exclude => [ file_qr('\.bat$') ])}
+ exclude => [ $self->file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package # hide from PAUSE
@@ -3050,7 +3047,7 @@ sub ACTION_manpages {
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ file_qr('\.bat$') ] );
+ exclude => [ $self->file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
@@ -3069,7 +3066,7 @@ sub manify_bin_pods {
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
- exclude => [ file_qr('\.bat$') ] );
+ exclude => [ $self->file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
@@ -3155,7 +3152,7 @@ sub ACTION_html {
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
exclude =>
- [ file_qr('\.(?:bat|com|html)$') ] );
+ [ $self->file_qr('\.(?:bat|com|html)$') ] );
next unless %$files;
if ( $self->invoked_action eq 'html' ) {
@@ -3182,7 +3179,7 @@ sub htmlify_pods {
$self->add_to_cleanup('pod2htm*');
my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ file_qr('\.(?:bat|com|html)$') ] );
+ exclude => [ $self->file_qr('\.(?:bat|com|html)$') ] );
return unless %$pods; # nothing to do
unless ( -d $htmldir ) {
@@ -3202,7 +3199,7 @@ sub htmlify_pods {
foreach my $pod ( keys %$pods ) {
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
- file_qr('\.(?:pm|plx?|pod)$'));
+ $self->file_qr('\.(?:pm|plx?|pod)$'));
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;
@@ -3293,7 +3290,7 @@ sub ACTION_diff {
delete $installmap->{read};
delete $installmap->{write};
- my $text_suffix = file_qr('\.(pm|pod)$');
+ my $text_suffix = $self->file_qr('\.(pm|pod)$');
while (my $localdir = each %$installmap) {
my @localparts = File::Spec->splitdir($localdir);
@@ -3891,6 +3888,12 @@ sub _slurp {
}
+sub _case_tolerant {
+ my $self = shift;
+ $self->{_case_tolerant} = File::Spec->case_tolerant
+ unless defined($self->{_case_tolerant});
+ return $self->{_case_tolerant};
+}
sub _append_maniskip {
my $self = shift;
@@ -3967,7 +3970,7 @@ sub ACTION_manifest {
# Case insensitive regex for files
sub file_qr {
- return File::Spec->case_tolerant ? qr($_[0])i : qr($_[0]);
+ return shift->{_case_tolerant} ? qr($_[0])i : qr($_[0]);
}
sub dist_dir {
@@ -4070,13 +4073,13 @@ sub script_files {
}
my %pl_files = map {
- File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ ) => 1
+ File::Spec->canonpath( $_ ) => 1
} keys %{ $self->PL_files || {} };
my @bin_files = $self->_files_in('bin');
my %bin_map = map {
- $_ => File::Spec->canonpath( File::Spec->case_tolerant ? uc $_ : $_ )
+ $_ => File::Spec->canonpath( $_ )
} @bin_files;
return $_ = { map {$_ => 1} grep !$pl_files{$bin_map{$_}}, @bin_files };
@@ -5248,7 +5251,7 @@ sub dir_contains {
return 0 if @second_dirs < @first_dirs;
- my $is_same = ( File::Spec->case_tolerant
+ my $is_same = ( $self->{_case_tolerant}
? sub {lc(shift()) eq lc(shift())}
: sub {shift() eq shift()} );
--
1.7.0.4