Navigation Menu

Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

On Windows, File::Find should work if symlink support is not categorically disabled #1

Open
wants to merge 8 commits into
base: blead
Choose a base branch
from
24 changes: 16 additions & 8 deletions ext/File-Find/lib/File/Find.pm
Expand Up @@ -123,6 +123,16 @@ sub is_tainted_pp {
return length($@) != 0;
}

sub _is_absolute {
return $_[0] =~ m|^(?:[A-Za-z]:)?/| if $Is_Win32;
return substr($_[0], 0, 1) eq '/';
}

sub _is_root {
return $_[0] =~ m|^(?:[A-Za-z]:)?/\z| if $Is_Win32;
return $_[0] eq '/';
}

sub _find_opt {
my $wanted = shift;
return unless @_;
Expand Down Expand Up @@ -183,19 +193,17 @@ sub _find_opt {

($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;

if ($Is_Win32) {
$top_item =~ s|[/\\]\z||
unless $top_item =~ m{^(?:\w:)?[/\\]$};
}
else {
$top_item =~ s|/\z|| unless $top_item eq '/';
}
# canonicalize directory separators
$top_item =~ s|[/\\]|/|g if $Is_Win32;

# no trailing / unless path is root
$top_item =~ s|/\z|| unless _is_root($top_item);

$Is_Dir= 0;

if ($follow) {

if (substr($top_item,0,1) eq '/') {
if (_is_absolute($top_item)) {
$abs_dir = $top_item;
}
elsif ($top_item eq $File::Find::current_dir) {
Expand Down
63 changes: 63 additions & 0 deletions ext/File-Find/t/correct-absolute-path-with-follow.t
@@ -0,0 +1,63 @@
#!./perl

use strict;
use warnings;

use File::Find qw( find finddepth );
use File::Temp qw();
use Test::More;

my $warn_msg;

BEGIN {
$SIG{'__WARN__'} = sub {
$warn_msg = $_[0];
warn "# $_[0]";
return;
}
}

sub test_find_correct_paths_with_follow {
$warn_msg = '';
my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1);

find(
{
follow => 1,
wanted => sub { return },
},
$dir,
);

unlike(
$warn_msg,
qr/Couldn't chdir/,
'find: Derive absolute path correctly with follow => 1',
);
}

sub test_finddepth_correct_paths_with_follow {
$warn_msg = '';
my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1);

finddepth(
{
follow => 1,
wanted => sub { return },
},
$dir,
);

unlike(
$warn_msg,
qr/Couldn't chdir/,
'finddepth: Derive absolute path correctly with follow => 1',
);
}
sub run {
test_find_correct_paths_with_follow;
test_finddepth_correct_paths_with_follow;
done_testing;
}

run();
2 changes: 1 addition & 1 deletion ext/File-Find/t/find.t
Expand Up @@ -1060,7 +1060,7 @@ if ($^O eq 'MSWin32') {
'wanted' => sub {
-f or return; # the first call is for $root_dir itself.
my $got = $File::Find::name;
my $exp = "$root_dir$expected_first_file";
(my $exp = "$root_dir$expected_first_file") =~ s|\\|/|g;
print "# no_chdir=$no_chdir $root_dir '$got'\n";
is($got, $exp,
"Win32: Run 'find' with 'no_chdir' set to $no_chdir" );
Expand Down