我想要做的结果是编写一个相当于以下 shell 的 Tcl 函数:
get_real_home () {
dirname $(ls -l $(ls -l $(which "$1") | awk '{print $NF}') | awk '{print $NF'})
}
简而言之,这给了我包含实际二进制文件的目录名称,当我通过符号链接(通常在 /usr/bin
中)给它一个由
Debian 替代系统管理的程序名称时,它会运行到另一个符号链接在
/etc/alternatives/
中,它指向当前正在使用的替代方案的可执行文件(或其他内容)。例如:
$ get_real_home java
/usr/lib/jvm/java-6-openjdk-amd64/jre/bin
我想这样做的原因是我正在使用环境模块,其“母语”是Tcl,来管理许多编译器的环境设置(主要是
PATH
和LD_LIBRARY_PATH
),口译员和图书馆。这个实用程序是集群上事实上的标准。
特别是对于 Java(有很多替代方案),能够通过
Environment Modules模块将环境(例如
JAVA_HOME
)设置为当前 Debian 替代方案的正确值会很方便它会“知道”当前的 Debian 替代方案指向哪里。为此,上面的符号链接追踪器很方便。
当然,我可以只是将我已经拥有的(上面)粘贴到shell脚本中,并从环境模块中的Tcl调用它:一个实用但不优雅的解决方案。我更喜欢更好的“原生”Tcl解决方案,但由于我对Tcl完全无知,我很难做到这一点,尽管它看起来应该是微不足道的。
我确信这对于了解Tcl的人来说是微不足道的,但这不是我:(
file normalize
命令使这几乎毫不费力。
set javaBinDir [file dirname [file normalize {*}[auto_execok java]]]
(
auto_execok
命令是一个Tcl库过程,它使用Gipsy Magic来计算出如何运行给定的程序。对于
java
程序,它相当于
exec which
;对于shell内置程序,它更棘手。它返回一个列表,在本例中是一个单例。我正在扩展它以防万一你有一个名称中带有空格的目录,或者一些不平衡的大括号。不太可能......)
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
呈现相对和绝对分量时,它会做正确的事情;当我在(模拟)示例中尝试时,这似乎有效。
#!/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"