如何检查一个路径是否是perl中另一个路径的子路径？答案

【问题标题】：How to check if a path is a subpath of an other in perl?如何检查一个路径是否是perl中另一个路径的子路径？
【发布时间】：2016-08-18 17:18:12
【问题描述】：

这个问题有一些其他语言的答案。我是 perl 的新手，我正在这样做（更多的是比较字符串而不是使用文件系统函数）：

use File::Spec;

sub has_common_prefix {
  my ($path, $subpath) = @_;
  $path = uc (File::Spec->canonpath($path))."\\";
  $subpath = uc (File::Spec->canonpath($subpath));

  if ( substr($subpath, 0, length($path)) eq $path ) return 1;
  return 0;
};

has_common_prefix('c:\\/abCD/EFgh', 'C:\abcd\\efgh/ijk.txt');

我想知道是否有更好的方法来做到这一点，以及更多“perlisch”:-)

谢谢。

【问题讨论】：

你也可以检查一个字符串$x是否有前缀$y，使用$x =~ /^\Q$y/
index 函数可能也很方便。
stackoverflow.com/questions/7283274/…

标签： perl filesystems

【解决方案1】：

File::Spec 及其替代 Path::Class 不涉及文件系统，因此它们不处理大小写差异，也不处理短格式和长格式。

use Path::Class qw( dir file );
use Win32       qw( );

sub subsumes {
   my $dir  = dir(Win32::GetLongPathName($_[0]));
   my $file = file(Win32::GetLongPathName($_[1]));
   return $dir->subsumes($file);
}

【讨论】：

【解决方案2】：

好吧，我已经破解了这个，但我并不为此感到非常自豪，我希望有人能提出更好的东西。我搜索了 CPAN，但很惊讶没有发现任何相关内容

我的想法是使用File::Spec::Functions 中的abs2rel 函数。没关系，只是它为此目的努力过头并且会为abs2rel('/usr', '/usr/a/b') 返回../..。它还将在路径中使用卷的系统上返回未更改的第一个值

这只是将abs2rel 包装在一个函数is_within 中，该函数拒绝这两种情况，但否则会完整地返回相对路径（真值）。这意味着is within('/usr', '/usr') 将返回.，这是正确的，但如果您认为目录不应包含自身，您可以针对特定情况对其进行测试

注意这不会检查路径是否指向目录，也不会检查路径是否存在

use strict;
use warnings 'all';

use File::Spec::Functions qw/ abs2rel  file_name_is_absolute  updir /;

my @pairs = (
    [qw{ /usr      /usr/bin } ],
    [qw{ /usr/etc  /usr/bin } ],
    [qw{ /var      /usr/bin } ],
    [qw{ /usr/bin  /usr/bin } ],
);

for ( @pairs ) {
    my ($path, $subpath) = @$_;
    my $within = is_within($subpath, $path);
    printf qq{"%s" is %swithin "%s"  (%s)\n},
            $subpath,
            ($within ? '' : 'not '),
            $path,
            $within // 'undef';
}


sub is_within {
    my ($path, $container) = @_;

    my $a2r = abs2rel($path, $container);

    return if file_name_is_absolute($a2r) or index($a2r, updir) == 0;

    $a2r;
}

输出

"/usr/bin" is within "/usr"  (bin)
"/usr/bin" is not within "/usr/etc"  (undef)
"/usr/bin" is not within "/var"  (undef)
"/usr/bin" is within "/usr/bin"  (.)

【讨论】：