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/)");