text: Q:
  
  How to check if a path is a subpath of an other in perl?
  
  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.
  
  A:
  
  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"  (.)
  
  