Question

我正在尝试做的事情的结果是编写一个 Tcl 函数，该函数等效于以下shell：

get_real_home () {
    dirname $(ls -l $(ls -l $(which "$1") | awk '{print $NF}') | awk '{print $NF'})
}

简而言之，这给了我包含实际二进制文件的目录的名称，当我通过符号链接给出Debian alternatives system管理的程序的名称时，通常在/usr/bin中，到/etc/alternatives/中的另一个符号链接，它指向当前正在使用的备选方案的可执行文件（或其他）。例如：

$ get_real_home java
/usr/lib/jvm/java-6-openjdk-amd64/jre/bin

我想这样做的原因是我使用Environment Modules，其“母语”是 Tcl 来管理环境设置（主要是PATH和LD_LIBRARY_PATH）用于许多编译器，解释器和库。该实用程序非常适合集群上的事实上的标准。

特别是对于 Java （有许多替代方案），能够将环境（例如JAVA_HOME）设置为当前 Debian 替代方案通过环境模块模块，它将“知道”当前 Debian 备选方案所在的位置。为此，上面的符号链接追踪器很方便。

当然，我可以将我已经拥有的内容（上图）粘贴到shell脚本中，然后从环境模块中的 Tcl 调用它：一个务实的，如果不优雅的解决方案。我更喜欢更好的“原生” Tcl 解决方案，但由于我完全不了解 Tcl ，我很难做到这一点，尽管看起来它应该是微不足道的。

我确定这个对于知道 Tcl 的人来说是微不足道的，但那不是我：（

Answer 1

file normalize命令使这几乎毫不费力。

set javaBinDir [file dirname [file normalize {*}[auto_execok java]]]

（auto_execok命令是一个Tcl库程序，可以让Gipsy Magic计算出如何运行给定的程序。对于java程序，它等同于{{1}对于shell builtins来说，它比较棘手。它返回一个列表，在这种情况下是一个单例。我在扩展它以防万一你有一个目录名字中的空格，或一些不平衡的大括号。不太可能......）

如果目标本身是一个链接，则需要多做一些工作。

exec which

set java [file normalize [lindex [auto_execok java] 0]] while {[file type $java] eq "link"} { # Ought to check for link loops... set java [file normalize [file join [file dirname $java] [file readlink $java]]] } puts "java really resolves to $java"不会自动为您执行此操作，因为您可能想要引用链接本身而不是它引用的内容。幸运的是，当file normalize呈现相对和绝对成分时，file join会做正确的事;当我在（模拟）示例中尝试它时，这似乎有效。

Answer 2

所以，几个小时后我回答了我自己的问题。它很冗长，但它确实有效。下面给出了我作为命令调用时想要的答案，尽管它不会像那样被使用。

#!/usr/bin/env tclsh

# Equivalent to shell "which", returning the first occurence of its
# argument, cmd, on the PATH:
proc which {cmd} {
    foreach dir [split $::env(PATH) :] {
        set fqpn $dir/$cmd
        if { [file exists $fqpn] } {
            return $fqpn
        }
    }
}

# True if 'path' exists and is a symbolic link:
proc is_link {path} {
    return [file exists $path] && [string equal [file type $path] link]
}

# Chases a symbolic link until it resolves to a file that
# isn't a symlink:
proc chase {link} {
    set max_depth 10 ; # Sanity check
    set i 0
    while { [is_link $link] && $i < $max_depth } {
        set link [file link $link]
        incr i
    }
    if { $i >= $max_depth } {
        return -code error "maximum link depth ($max_depth) exceeded"
    }
    return $link
}

# Returns the "true home" of its argument, a command:
proc get_real_home {cmd} {
    set utgt [chase [which $cmd]]    ; # Ultimate target
    set home [file dirname $utgt]    ; # Directory containing target
    if { [string equal bin [file tail $home]] } {
        set home [file dirname $home]
    }
    return $home
}

# Not worried about command-line argument validation because
# none of the above will be used in a command context
set cmd  [lindex $argv 0]       ; # Command
set home [get_real_home $cmd]   ; # Ultimate home
puts "$cmd -> $home"

在Tcl中追逐功能的两级符号链接

2 个答案: