This queue is for tickets about the lib-filter CPAN distribution.

Report information
The Basics
Id:
123968
Status:
rejected
Priority:
Low/Low
Queue:

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

BugTracker
Severity:
(no value)
Broken in:
(no value)
Fixed in:
(no value)

Attachments


Subject: Normalize INC paths, so, eg, allow_noncore,0 doesn't fail unexpectedly
I have submitted a patch here (link below) that normalizes paths, which solves the problem that arises when archlib(exp) and privlib(exp) differ from what's actually in @INC, which seems to mostly happen with the combination of relocatable INCs and symlinked lib dirs. This patch also allows proper path normalizing on Win32 (resolving NTFS junctions and symlinks) just as it does on Unix-like systems. https://github.com/perlancar/perl-lib-filter/pull/5
On Fri Dec 29 17:05:50 2017, BAYMAX wrote:
Show quoted text
> I have submitted a patch here (link below) that normalizes paths, > which solves the problem that arises when archlib(exp) and > privlib(exp) differ from what's actually in @INC, which seems to > mostly happen with the combination of relocatable INCs and symlinked > lib dirs. This patch also allows proper path normalizing on Win32 > (resolving NTFS junctions and symlinks) just as it does on Unix-like > systems. > > https://github.com/perlancar/perl-lib-filter/pull/5
Thought I might also include the patch here as well.
Subject: lib-filter_inc-path-normalize.patch
--- filter.pm 2016-08-23 19:34:57.000000000 -0700 +++ filter.pm 2017-12-29 12:45:27.000000000 -0800 @@ -8,6 +8,9 @@ use warnings; use Config; +# Custom real_path, to make $core_inc and $noncore_inc generation more reliable. +sub real_path; + # BEGIN snippet from Module::Path::More, with mods/simplification my $SEPARATOR; BEGIN { @@ -41,6 +44,7 @@ my $hook; my ($orig_inc, $orig_inc_sorted_by_len); +my @INC_normalized = map real_path($_), @INC; # Normalize the paths in @INC. sub import { my ($class, %opts) = @_; @@ -70,17 +74,21 @@ } if ($opts{extra_inc}) { - unshift @INC, split(/:/, $opts{extra_inc}); + unshift @INC_normalized, split(/:/, $opts{extra_inc}); } if (!$orig_inc) { - $orig_inc = [@INC]; - $orig_inc_sorted_by_len = [sort {length($b) <=> length($a)} @INC]; + $orig_inc = [@INC_normalized]; + $orig_inc_sorted_by_len = + [sort {length($b) <=> length($a)} @INC_normalized]; } - my $core_inc = [@Config{qw(privlibexp archlibexp)}]; - my $noncore_inc = [grep {$_ ne $Config{privlibexp} && - $_ ne $Config{archlibexp}} @$orig_inc]; + my ($privlibexp, $archlibexp) = + map real_path($_), @Config{qw(privlibexp archlibexp)}; + + my $core_inc = [$privlibexp, $archlibexp]; + my $noncore_inc = [grep {$_ ne $privlibexp && + $_ ne $archlibexp} @$orig_inc]; my %allow; if ($opts{allow}) { for (split /\s*;\s*/, $opts{allow}) { @@ -220,6 +228,55 @@ #use DD; dd \@INC; } + +# Modules needed for custom real_path() sub routine below. +use File::Spec (); +use Cwd (); + +BEGIN { # Needed so readlink() recognizes NTFS junctions and symlinks on Win32. + if ( $^O eq q{MSWin32} ) { + require Win32::Symlink && Win32::Symlink->import( 'readlink' ); + } +} + +# Custom real_path, to make $core_inc and $noncore_inc generation more reliable. +sub real_path { + my $start = @_ ? shift : '.'; + $start = File::Spec->rel2abs($start) + unless File::Spec->file_name_is_absolute($start); + + my @path = File::Spec->splitdir( $start ); + pop @path until defined $path[-1] && length $path[-1]; + + my $path = ''; + my %seen; # For symlink infinite-loop prevention. + + while (1) { # Loop until no symlinks (or NTFS junctions) are found. + my @found; + + for my $i ( 0 .. $#path ) { + my $curr_path = join '/', @path[0 .. $i]; + + # Using readlink intad of an -l test to accomidate Win32/NTFS. + if ( my $target = readlink $curr_path ) { + $target = join('/', @path[0 .. $i-1], $target) + unless File::Spec->file_name_is_absolute($target); + + $target = Cwd::abs_path $target; + push @found, $target; + + splice @path, 0, ($i + 1), File::Spec->splitdir($target); + } + } + + $path = join '/', @path; + last if !@found || exists $seen{$path}; + $seen{$path}++; + } + + return $path; +} + sub unimport { return unless $hook; @INC = grep { "$_" ne "$hook" } @INC;
I'll respond on github instead.


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

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