3

问题

我不是 Tcl 新手，这个问题让我很困惑。我想遍历目录树并处理或忽略那些我无权访问的子目录或文件。这是一个小示例代码：

#!/usr/bin/env tclsh

package require fileutil::traverse

proc errorHandler {absPath errorMessage} {
    puts "ERROR: $absPath $errorMessage"
}

# Main
set searchDir /tmp
fileutil::traverse t $searchDir -errorcmd errorHandler

puts "\nFiles in $searchDir:"
t foreach fileName {
    puts $fileName
}

输出：

...
couldn't read directory "/tmp/launchd-56801.nzZRsA/": permission denied
    while executing
"glob -nocomplain -directory $current -types f          -- *"
    (procedure "GLOBF" line 2)
    invoked from within
"GLOBF $top"
    (procedure "::fileutil::traverse::Snit_methodnext" line 44)
    invoked from within
"$self next currentfile"
    (procedure "::fileutil::traverse::Snit_methodforeach" line 11)
    invoked from within
"t foreach fileName {
    puts $fileName
}"
    (file "./traverser1.tcl" line 17)

我知道问题所在：我无权阅读某些子目录。这就是我在每个文档中放入错误处理程序的原因。但是，从未调用过该错误处理程序。我怀疑这是 Tcl 中的一个错误，但这可能意味着我误解了文档并且没有正确使用包。我感谢任何帮助或建议来解决这个问题。

我的环境

  • Mac OS X 山狮
  • Tcl 8.5.9

更新

我查看了fileutil::traverseMac OS X 10.8.4 Moutain Lion 和 1.15 版（最新版本）附带的 1.12 版的源代码。我发现的是：

method next {fvar} {
    # code ...
    if {![ACCESS $top]} {
        Error ...
        ...

但是对于 Tcl 8.4 或更高版本，ACCESS 的实现是：

proc ::fileutil::traverse::ACCESS {args} {return 1}

而 Tcl 8.3 的实现是：

proc ::fileutil::traverse::ACCESS {current} {
    if {[catch {
        set h [pwd] ; cd $current ; cd $h
    }]} {return 0}
    return 1
}

当我用 8.3 版本替换 8.4 版本时，一切正常。这告诉我这是代码中的错误。我不知道为什么会这样。

4

1 回答 1

2

我通过添加一个预过滤器找到了一种解决方法，它尝试 cd 进入目录并在目录可访问时返回 True ：

#!/usr/bin/env tclsh

package require fileutil::traverse

# isAccessible: determines if the directory is accessible by attempting to cd into it
proc isAccessible {absPath} {
    set currentDir [pwd]
    if {[catch {cd $absPath}]} {
        set chdirOK False
    } else {
        set chdirOK True
    }
    cd $currentDir
    return $chdirOK
}

# Main
set searchDir /tmp
fileutil::traverse t $searchDir -prefilter isAccessible

puts "\nFiles in $searchDir:"
t foreach fileName {
    puts $fileName
}

更新

多纳尔的建议是一个很好的建议：它有效，简短而甜蜜：

proc isAccessible {absPath} {
    return [file readable $absPath]
}

我们甚至可以isAccessible完全取消写作：

fileutil::traverse t $searchDir -prefilter "file readable"
于 2013-07-14T06:53:13.550 回答