How to check if a path is a subpath of an other in perl?

Question

there are some answers to this problem in other languages. I'm new to perl and I'm doing this (is more comparing strings than using filesystem-functions):

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');

I want to know if there are better ways to do this, well more "perlisch" :-)

Thanks.

You can also check if a string `$x` has a prefix `$y`, using `$x =~ /^\Q$y/` — Håkon Hægland, Apr 25 '16 at 11:09
The [`index`](http://perldoc.perl.org/functions/index.html) function might be handy also. — simbabque, Apr 25 '16 at 11:29
http://stackoverflow.com/questions/7283274/check-whether-a-string-contains-a-substring — xxfelixxx, Apr 25 '16 at 11:40

score 0 · Accepted Answer · answered Apr 25 '16 at 12:01

Well I've hacked this, but I'm not very proud of it and I hope someone comes up with something better. I've searched the CPAN but am surprised to have found nothing relevant

My idea was to use the abs2rel function from File::Spec::Functions. That's fine, except that it tries too hard for this purpose and will return ../.. for abs2rel('/usr', '/usr/a/b'). It will also return the first value unchanged on systems that use volumes in the path

This just wraps abs2rel inside a function is_within which rejects both of those cases, but otherwise returns the relative path (a true value) intact. That means that is within('/usr', '/usr') will return ., which is true, but you can test it for that specific case if you think a directory shouldn't contain itself

Note that this doesn't check whether the paths are to directories, nor does it check whether the paths even exist

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;
}

output

"/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"  (.)

score 0 · Answer 2 · answered Apr 25 '16 at 19:36

File::Spec and its replacement Path::Class don't touch the file system, so they don't handle case differences, and they don't down handle short vs long forms.

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);
}

How to check if a path is a subpath of an other in perl?

2 Answers2

output