TCL: рекурсивный поиск в подкаталогах для получения всех файлов .tcl.

У меня есть основной процесс 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

и кажется глупым делать это таким образом, когда я всегда знаю, что буду искать все в папке A и папке B. Есть ли функция (или простой способ), которая позволит мне просто получить все файлы .tcl во всей папке?


tcl
person Lyndon    schedule 09.01.2009    source источник


Ответы (7)


Основываясь на ответе 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
 }
person Jackson    schedule 12.01.2009
comment
Спасибо Джексон. Думаю, теперь мы можем положить этому всему конец! - person Lyndon; 13.01.2009
comment
Если у вас есть символическая ссылка, которая создает цикл, вы получите слишком много вложенных вычислений (бесконечный цикл?). - person Joseph Bui; 15.01.2009
comment
sudo apt-get установить tcllib tcl tk - person Bimo; 06.06.2020

Это становится тривиальным с tcllib на борту:

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

Возможно, немного более независимым от платформы и с использованием встроенных команд вместо передачи в процесс:

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

Повторите для папки B.

Если у вас более строгие критерии выбора и вы не беспокоитесь о работе на каких-либо других платформах, использование find может быть более гибким.

person ramanman    schedule 10.01.2009
comment
Единственное, что я заметил, это то, что это возвращает ошибку, если файлы не совпадают, но, по общему признанию, я не проверял, что сделал другой ответ. - person Lyndon; 11.01.2009
comment
используйте параметр -nocomplain в команде glob, чтобы остановить выдачу и ошибку, если создается пустой список. - person Jackson; 12.01.2009

Вот один из способов:

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

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

close $includes
person Andru Luvisi    schedule 09.01.2009

Основываясь на предыдущем ответе, эта версия обрабатывает циклы, созданные символическими ссылками, и в процессе также устраняет дубликаты файлов из-за символических ссылок.

# 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]
}
person Community    schedule 15.01.2009

Та же идея, что и у schlenk:

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

Если вам нужны только папки A и папки B, а не другие папки в $basepath:

package require Tclx
for_recursive_glob scriptName [list $basepath/folderA $basepath/folderB] *.tcl {
    source $scriptName
}
person Hai Vu    schedule 14.09.2009

Ответ Джозефа Буи работает хорошо, за исключением того, что он пропускает файлы в исходной папке.

Change:

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

чинить

person Alexander Henket    schedule 24.01.2016