Bug fixes.

git-svn-id: svn://svn.tartarus.org/sgt/utils@4869 cda61777-01e9-0310-a592-d414129be87e

diff --git a/lns/lns b/lns/lns
index ebe9e62..f7a344c 100755 (executable)
--- a/lns/lns
+++ b/lns/lns
@@ -102,7 +102,6 @@ die "$0: multiple source files specified, $target not a directory\n"
   if $#ARGV > 0 && !-d $target;
 
 $multiple = (-d $target && !$FILE);
-$whereami = getcwd();
 
 $target =~ s/// if $target =~ /\/$/;    # strip trailing slash if present
 
@@ -136,8 +135,8 @@ sub makelink {
 
   # OK, now we're ready to do the link. Calculate the absolute path names
   # of both source and target.
-  $source = &absolute($source);
-  $target = &absolute($target);
+  $source = &normalise($source);
+  $target = &normalise($target);
 
   # If we're in Relative mode (the default), calculate the relative path
   # name we will reference the source by.
@@ -149,45 +148,28 @@ sub makelink {
   symlink($sourcename, $target) || die "$0: unable to make link to $target\n";
 }
 
-sub absolute {
-  local ($_) = @_;
-  $_ = "$whereami/$_" if !/^\//;
-  s//$whereami/ if /^\./;
-  1 while s/\/\.\//\//;
-  1 while s/\/\//\//;
-  1 while s/\/[^\/]+\/\.\.//;
-  1 while s/^\/\.\.\//\//;
-  $_;
-}
+sub normalise {
+    # Normalise a path into an absolute one containing no . or ..
+    # segments.
+    local ($_) = @_;
 
-sub relname {
-  local ($source, $target) = @_;
-  local $prefix;
+    # Make relative paths absolute.
+    $_ = getcwd() . "/" . $_ if !/^\//;
 
-  # Strip the last word off the target (the actual file name) to
-  # obtain the target _directory_.
-  $target =~ s/\/[^\/]*$//;
+    # Remove "." segments.
+    1 while s/^(.*)\/\.(\/.*)?$/$1$2/;
 
-  # Our starting prefix is empty. We will add one "../" at a time
-  # until we find a match.
+    # Remove redundant slashes.
+    s/\/+/\//;
 
-  while (1) {
+    # Remove a trailing slash if present.
+    s/\/$//;
 
-    # If $target is a prefix of $source, we are done. (No matter what
-    # symlinks may exist on the shared common pathname, if we are
-    # linking `a/b/c/foo' to `foo' then a simple relative link will
-    # work.)
-    if (substr($source, 0, length $target) eq $target) {
-       return $prefix . substr($source, 1 + length $target); # skip the slash
-    }
-
-    # Otherwise, descend to "..".
-
-    $target = $target . "/..";
-
-    # Now normalise the path by removing all ".." segments. We want
-    # to do this while _as far as possible_ preserving symlinks. So
-    # the algorithm is:
+    # Remove ".." segments. This is the hard bit, because a
+    # directory segment that's a _symlink_ doesn't do the obvious
+    # thing if followed by "..". But we can't just call realpath,
+    # because we do want to preserve symlinks where they _don't_
+    # interfere with this sort of work. So the algorithm is:
     #
     #  - Repeatedly search for the rightmost `directory/..'
     #   fragment.
@@ -196,27 +178,58 @@ sub relname {
     #      remove both it and the .. from the string.
     #    * If it _is_ a symlink, we substitute it for its link
     #      text, and loop round again.
-    while ($target =~
-          /^(.*)\/((\.|\.\.[^\/]+|\.?[^\/\.][^\/]*)\/\.\.)(\/.*)?$/)
+    while (/^(.*)\/((\.|\.\.[^\/]+|\.?[^\/\.][^\/]*)\/\.\.)(\/.*)?$/)
     {
        my ($pre, $dir, $frag, $post) = ($1,$2,$3,$4);
        my $log = "transforming $target -> ";
        if (-l "$pre/$frag") {
            my $linktext = readlink "$pre/$frag";
            if ($linktext =~ /^\//) { # absolute link
-               $target = $linktext;
+               $_ = $linktext;
            } else { # relative link
-               $target = "$pre/$linktext";
+               $_ = "$pre/$linktext";
            }
-           $target .= "/.." . $post;
+           $_ .= "/.." . $post;
        } else {
-           $target = $pre . $post;
+           $_ = $pre . $post;
        }
-       $target = "/" if $target eq ""; # special case
+       $_ = "/" if $_ eq ""; # special case
        $log .= "$target";
        warn "$0: $log\n" if $verbose > 1;
     }
 
+    # The only place where a ".." fragment might still remain is at
+    # the very start of the string, and "/.." is defined to be
+    # equivalent to "/".
+    1 while s/^\/\.\.\//\//;
+
+    return $_;
+}
+
+sub relname {
+  local ($source, $target) = @_;
+  local $prefix;
+
+  # Strip the last word off the target (the actual file name) to
+  # obtain the target _directory_.
+  $target =~ s/\/[^\/]*$//;
+
+  # Our starting prefix is empty. We will add one "../" at a time
+  # until we find a match.
+
+  while (1) {
+
+    # If $target is a prefix of $source, we are done. (No matter what
+    # symlinks may exist on the shared common pathname, if we are
+    # linking `a/b/c/foo' to `foo' then a simple relative link will
+    # work.)
+    if (substr($source, 0, 1 + length $target) eq "$target/") {
+       return $prefix . substr($source, 1 + length $target); # skip the slash
+    }
+
+    # Otherwise, descend to "..".
+    $target = &normalise($target . "/..");
+
     # Now we have replaced $target with a pathname equivalent to
     # `$target/..'. So add a "../" to $prefix, and try matching
     # again.