TCL：递归搜索子目录以获取所有 .tcl 文件

Question

我有一个主要的 TCL 进程，它在其他文件夹和后续子目录中获取大量其他 tcl 进程。例如，在主过程中它有：

source $basepath/folderA/1A.tcl
source $basepath/folderA/2A.tcl
source $basepath/folderA/3A.tcl
source $basepath/folderB/1B.tcl
source $basepath/folderB/2B.tcl
source $basepath/folderB/3B.tcl

当我总是知道我会在folderA和folderB中获取所有内容时，这样做似乎有点愚蠢。是否有一个函数（或简单的方法）允许我获取整个文件夹中的所有 .tcl 文件？

Answer 1

基于 ramanman 的回复，这里有一个例程，它使用内置的 TCL 文件命令来解决问题，并以递归方式沿着目录树向下工作。

# findFiles
# basedir - the directory to start looking in
# pattern - A pattern, as defined by the glob command, that the files must match
proc findFiles { basedir pattern } {

    # Fix the directory name, this ensures the directory name is in the
    # native format for the platform and contains a final directory seperator
    set basedir [string trimright [file join [file normalize $basedir] { }]]
    set fileList {}

    # Look in the current directory for matching files, -type {f r}
    # means ony readable normal files are looked at, -nocomplain stops
    # an error being thrown if the returned list is empty
    foreach fileName [glob -nocomplain -type {f r} -path $basedir $pattern] {
        lappend fileList $fileName
    }

    # Now look for any sub direcories in the current directory
    foreach dirName [glob -nocomplain -type {d  r} -path $basedir *] {
        # Recusively call the routine on the sub directory and append any
        # new files to the results
        set subDirList [findFiles $dirName $pattern]
        if { [llength $subDirList] > 0 } {
            foreach subDirFile $subDirList {
                lappend fileList $subDirFile
            }
        }
    }
    return $fileList
 }

Answer 2

有了 tcllib，事情就变得微不足道了：

package require fileutil
foreach file [fileutil::findByPattern $basepath *.tcl] {
    source $file
}

Answer 3

也许更加独立于平台并使用内置命令而不是管道到进程：

foreach script [glob [file join $basepath folderA *.tcl]] {
  source $script
}

对文件夹 B 重复此操作。

如果您有更严格的选择标准，并且不担心在任何其他平台上运行，那么使用 find 可能更灵活。

Answer 4

这是一种方法：

set includes [open "|find $basedir -name \*.tcl -print" r]

while { [gets $includes include] >= 0 } {
  source $include
}

close $includes

Answer 5

基于之前的答案，此版本处理由符号链接创建的循环，并在此过程中还消除了由于符号链接而导致的重复文件。

# findFiles
# basedir - the directory to start looking in
# pattern - A pattern, as defined by the glob command, that the files must match
proc findFiles {directory pattern} {

    # Fix the directory name, this ensures the directory name is in the
    # native format for the platform and contains a final directory seperator
    set directory [string trimright [file join [file normalize $directory] { }]]

    # Starting with the passed in directory, do a breadth first search for
    # subdirectories. Avoid cycles by normalizing all file paths and checking
    # for duplicates at each level.

    set directories [list]
    set parents $directory
    while {[llength $parents] > 0} {

        # Find all the children at the current level
        set children [list]
        foreach parent $parents {
            set children [concat $children [glob -nocomplain -type {d r} -path $parent *]]
        }

        # Normalize the children
        set length [llength $children]
        for {set i 0} {$i < $length} {incr i} {
            lset children $i [string trimright [file join [file normalize [lindex $children $i]] { }]]
        }

        # Make the list of children unique
        set children [lsort -unique $children]

        # Find the children that are not duplicates, use them for the next level
        set parents [list]
        foreach child $children {
            if {[lsearch -sorted $directories $child] == -1} {
                lappend parents $child
            }
        }

        # Append the next level directories to the complete list
        set directories [lsort -unique [concat $directories $parents]]
    }

    # Get all the files in the passed in directory and all its subdirectories
    set result [list]
    foreach directory $directories {
        set result [concat $result [glob -nocomplain -type {f r} -path $directory -- $pattern]]
    }

    # Normalize the filenames
    set length [llength $result]
    for {set i 0} {$i < $length} {incr i} {
        lset result $i [file normalize [lindex $result $i]]
    }

    # Return only unique filenames
    return [lsort -unique $result]
}

Answer 6

与schlenk相同的想法：

package require Tclx
for_recursive_glob scriptName $basepath *.tcl {
    source $scriptName
}

如果您只想要folderA和folderB而不想要$basepath下的其他文件夹：

package require Tclx
for_recursive_glob scriptName [list $basepath/folderA $basepath/folderB] *.tcl {
    source $scriptName
}

Answer 7

Joseph Bui 的答案效果很好，只是它跳过了初始文件夹中的文件。

改变：

设置目录[列表]

到：

设置目录[列表$目录]

修复

Answer 8

您可以使用

*.tcl 将 $basepath

 中的文件名（带有 

rglob 扩展名）递归重定向到变量（需要 tcl 8.5 或更高版本）：

redirect -variable tcls {echo [rglob $basepath *.tcl]}

然后获取它们：

foreach eachTcl $tcls {
    source $eachTcl
}

我在这里带来

rglob

功能：

proc rglob {dirlist globlist} {
        set result {}
        set recurse {}
        foreach dir $dirlist {
                if ![file isdirectory $dir] {
                        return -code error "'$dir' is not a directory"
                }
                foreach pattern $globlist {
                        lappend result {*}[glob -nocomplain -directory $dir -- $pattern]
                }
                foreach file [glob -nocomplain -directory $dir -- *] {
                        set file [file join $dir $file]
                        if [file isdirectory $file] {
                                set fileTail [file tail $file]
                                if {!($fileTail eq "." || $fileTail eq "..")} {
                                        lappend recurse $file
                                }
                        }
                }
        }
        if {[llength $recurse] > 0} {
                lappend result {*}[rglob $recurse $globlist]
        }
        return $result
}

借自 https://wiki.tcl-lang.org/page/recursive%5Fglob