2009-01-09 266 views
10

我有一個主要的TCL過程,它會在其他文件夾和後續子目錄中生成大量其他tcl過程。例如,在主PROC有: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文件?

回答

10

基於ramanman的回覆,heres是一個例程,它使用內置的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 
} 
1

這裏有一種方法:

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

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

close $includes 
+0

謝謝。這工作完美。 – Lyndon 2009-01-09 21:27:13

5

也許有點多平臺獨立的,並使用內建命令而不是管道的過程:

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

重複的FolderB中。

如果您有更嚴格的選擇標準,並且不用擔心在任何其他平臺上運行,使用find可能會更靈活。

+0

我唯一注意到的是,如果沒有文件匹配,這將返回一個錯誤,但我承認我沒有檢查其他答案。 – Lyndon 2009-01-11 08:50:14

+0

在glob命令中使用-nocomplain選項可以在生成空列表時停止它拋出和錯誤。 – Jackson 2009-01-12 10:06:10

2

基於前面的回答,這個版本處理由於符號鏈接的符號鏈接,並在這個過程中消除重複文件創建的循環。

# 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] 
} 
9

稱臣變得瑣碎tcllib:

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

原理相同的舒倫克:

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

如果你只是想在$基本路徑folderA和FolderB中,而不是其他文件夾:

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

Joseph Bui的答案很好,只是它跳過了初始文件夾中的文件。

變化:

set directories [list]
要:
set directories [list $directory]

修復