Skip Menu |
 

This queue is for tickets about the Module-Build CPAN distribution.

Report information
The Basics
Id: 56518
Status: resolved
Priority: 0/
Queue: Module-Build

People
Owner: Nobody in particular
Requestors: RURBAN [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.36_06
Fixed in: (no value)

Attachments
0001-0.36_09-_case_tolerant-file_qr-method-no-uc-paths.patch



Subject: [PATCH] 0.36_09 - _case_tolerant, file_qr method, no uc paths
Download (untitled) / with headers
text/plain 353b
- 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
Patch applied to repo.
Download (untitled) / with headers
text/plain 103b
Now that there has been a stable Module::Build release, I'm marking this "patched" issue as "resolved".


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.