#   Failed test 'comparePaths(/a/b, /a)'
#   in Monks/Snippet.pm at line 132.
#          got: '-2'
#     expected: '-1'

Monks/Snippet....NOK 24
#   Failed test 'comparePaths(/a/b, /a/)'
#   in Monks/Snippet.pm at line 133.
#          got: '-2'
#     expected: '-1'

Monks/Snippet....NOK 25
#   Failed test 'comparePaths(/a/b/, /a)'
#   in Monks/Snippet.pm at line 134.
#          got: '-2'
#     expected: '-1'

Monks/Snippet....NOK 26
#   Failed test 'comparePaths(/a/b/, /a/)'
#   in Monks/Snippet.pm at line 135.
#          got: '-2'
#     expected: '-1'
# Looks like you failed 4 tests of 36.

##</code><code>##

#   Failed test 'comparePaths(/, /a)'
#   in Monks/Snippet.pm at line 108.
#          got: '-2'
#     expected: '1'

#   Failed test 'comparePaths(/, /a/)'
#   in Monks/Snippet.pm at line 109.
#          got: '-2'
#     expected: '1'

#   Failed test 'comparePaths(/a, /)'
#   in Monks/Snippet.pm at line 137.
#          got: '-2'
#     expected: '-1'

#   Failed test 'comparePaths(/a/, /)'
#   in Monks/Snippet.pm at line 138.
#          got: '-2'
#     expected: '-1'
# Looks like you failed 4 tests of 36.

##</code><code>##

    #replace
    my @aDirs = File::Spec->splitdir($sDirPart);
    #with
    my @aDirs = $sDirPart eq File::Spec->rootdir()
      ? ('') : File::Spec->splitdir($sDirPart);
    
##</code><code>##

use strict;
use warnings;
use File::Spec;
use Test::More tests => 36;

#===============================================================
# comparePaths() and supporting functions 
#===============================================================

# returns
# 1  if $sPath1 owns/contains $sPath2
# 0  if $sPath1 equals $sPath2
# -1 if $sPath1 is owned *by* $sPath2
# -2 if $sPath1 is along side of $sPath2

sub comparePaths {
  my ($sPath1, $sPath2) = @_;
  my ($sVol1, $aDirs1, $sFile1) = parsePath($sPath1);
  my ($sVol2, $aDirs2, $sFile2) = parsePath($sPath2);

  # paths on two different volumes can't own one another
  return -2 if ($sVol1 ne $sVol2);

  # assume the most deeply nested path components are at the
  # end of the directory array.
  # files are "inside" directories, so just push them onto the
  # directory path
  push @$aDirs1, $sFile1 if $sFile1;
  push @$aDirs2, $sFile2 if $sFile2;

  # $"='|'; #to make leading and trailing '' more visible
  # print STDERR "dirs1=<@$aDirs1> <@$aDirs2>\n";

  # decide if we are inside or outside by comparing directory
  # components

  my $iSegments1 = scalar @$aDirs1;
  my $iSegments2 = scalar @$aDirs2;

  if ($iSegments1 <= $iSegments2) {
    for (my $i=0; $i < $iSegments1; $i++) {
      return -2 if $aDirs1->[$i] ne $aDirs2->[$i];
    }
    return $iSegments1 == $iSegments2 ? 0 : 1;
  } else {
    for (my $i=0; $i < $iSegments2; $i++) {
      return -2 if $aDirs1->[$i] ne $aDirs2->[$i];
    }
    return -1;
  }
}

sub parsePath {
  my $sPath = shift;

  # parse the canonical path
  $sPath = File::Spec->canonpath($sPath);

  # parse the canonical path
  $sPath = File::Spec->canonpath($sPath);

  # split the path into components
  my ($sVolume, $sDirPart, $sFilePart)
    = File::Spec->splitpath($sPath, 0);

  # maybe the nesting order of directories in $sDirPart
  # is right to left instead of left to right
  # (as in Unix,MsWin)?

  # If so, further split the directory portion into
  # components in the hope that splitdir produces
  # an array with most nested directory components at
  # the end... BUT this is an assumption. There is no
  # documentation guarenteeing it.

  # Also, canonize the directory part before splitting
  # it.  File::Spec::Unix sets the directory part to '.../'
  # but splitdir doesn't strip empty directories from UNIX.
  # this is explained in File::Spec's documentation for splitdir:
  #
  #   Unlike just splitting the directories on the separator,
  #   empty directory names ('') can be returned, because these
  #   are significant on some OSes.

  $sDirPart = File::Spec->canonpath($sDirPart);
  my @aDirs = File::Spec->splitdir($sDirPart);

  # return parsed path
  return ($sVolume, \@aDirs, $sFilePart);
}

#===============================================================
# TESTS
#===============================================================

  #inside root, relpath
is(comparePaths('a/b', 'a/b/c'), 1, "comparePaths(a/b, a/b/c)");
is(comparePaths('a/b', 'a/b/c/'), 1, "comparePaths(a/b, a/b/c)");
is(comparePaths('a/b/', 'a/b/c'), 1 , "comparePaths(a/b, a/b/c)");
is(comparePaths('a/b/', 'a/b/c/'), 1, "comparePaths(a/b, a/b/c)");

#inside root, abspath
is(comparePaths('/a/b', '/a/b/c'), 1, "comparePaths(/a/b, /a/b/c)");
is(comparePaths('/a/b', '/a/b/c/'), 1, "comparePaths(/a/b, /a/b/c)");
is(comparePaths('/a/b/', '/a/b/c'), 1, "comparePaths(/a/b, /a/b/c)");
is(comparePaths('/a/b/', '/a/b/c/'), 1, "comparePaths(/a/b, /a/b/c)");

is(comparePaths('/', '/a'), -1, "comparePaths(/, /a)");
is(comparePaths('/', '/a/'), -1, "comparePaths(/, /a/)");


#equal to root, relpath
is(comparePaths('a/b', 'a/b'), 0, "comparePaths(a/b, a/b)");
is(comparePaths('a/b', 'a/b/'), 0, "comparePaths(a/b, a/b/)");
is(comparePaths('a/b/', 'a/b'), 0, "comparePaths(a/b/, a/b)");
is(comparePaths('a/b/', 'a/b/'), 0, "comparePaths(a/b/, a/b/)");

#equal to root, abspath
is(comparePaths('/a/b', '/a/b'), 0, "comparePaths(/a/b, /a/b)");
is(comparePaths('/a/b', '/a/b/'), 0, "comparePaths(/a/b, /a/b/)");
is(comparePaths('/a/b/', '/a/b'), 0, "comparePaths(/a/b/, /a/b)");
is(comparePaths('/a/b/', '/a/b/'), 0, "comparePaths(/a/b/, /a/b/)");


#parent to root, relpath
is(comparePaths('a/b', 'a'), -1, "comparePaths(a/b, a)");
is(comparePaths('a/b', 'a/'), -1, "comparePaths(a/b, a/)");
is(comparePaths('a/b/', 'a'), -1, "comparePaths(a/b/, a)");
is(comparePaths('a/b/', 'a/'), -1, "comparePaths(a/b/, a/)");

#parent to root, abspath
is(comparePaths('/a/b', '/a'), -1, "comparePaths(/a/b, /a)");
is(comparePaths('/a/b', '/a/'), -1, "comparePaths(/a/b, /a/)");
is(comparePaths('/a/b/', '/a'), -1, "comparePaths(/a/b/, /a)");
is(comparePaths('/a/b/', '/a/'), -1, "comparePaths(/a/b/, /a/)");

is(comparePaths('/a', '/'), -1, "comparePaths(/a, /)");
is(comparePaths('/a/', '/'), -1, "comparePaths(/a/, /)");

#outside root, relpath
is(comparePaths('a/b', 'a/x'), -2, "comparePaths(a/b, a/x)");
is(comparePaths('a/b', 'a/x/'), -2, "comparePaths(a/b, a/x/)");
is(comparePaths('a/b/', 'a/x'), -2, "comparePaths(a/b/, a/x)");
is(comparePaths('a/b/', 'a/x/'), -2, "comparePaths(a/b/, a/x/)");

#outside root, abspath
is(comparePaths('/a/b', '/a/x'), -2, "comparePaths(/a/b, /a/x)");
is(comparePaths('/a/b', '/a/x/'), -2, "comparePaths(/a/b, /a/x/)");
is(comparePaths('/a/b/', '/a/x'), -2, "comparePaths(/a/b/, /a/x)");
is(comparePaths('/a/b/', '/a/x/'), -2, "comparePaths(/a/b/, /a/x/)");