recursively dig through directories?

R. Scott Truesdell

unread,

Mar 26, 1998, 3:00:00 AM3/26/98

to

Does anyone have a snippet of tcl code that recursively traverses
directories like Unix's `find` command?

I hate reinventing the wheel...

Scott Truesdell
true...@ics.uci.edu

Eric Galluzzo

unread,

Mar 27, 1998, 3:00:00 AM3/27/98

to

R. Scott Truesdell wrote:

> Does anyone have a snippet of tcl code that recursively traverses
> directories like Unix's `find` command?

No, but it would be trivial to write one. How about:

proc findFiles {baseDir pattern {command {}}} {
set fileList {}
set oldDir [pwd]
cd $baseDir
foreach file [glob -nocomplain *] {
set fullFile [file join $baseDir $file]
if [file isdirectory $file] {
eval lappend fileList [findFiles $fullFile $pattern $command]
} elseif [string match $pattern $file] {
lappend fileList $fullFile
if [string compare $command {}] {
catch {eval $command \$fullFile}
}
}
}
return $fileList
}

I haven't actually tested this, but it ought to work. Tweak as
necessary. :)

> I hate reinventing the wheel...

Oops. :)

- Eric

--
------=--=-=-==-===-=====//=====-===-==-=-=--=--------------------------
"God is real, unless // Eric Galluzzo Product Development Engineer
declared integer." // Structural Dynamics Research Corporation
// E-mail: Eric.G...@sdrc.com
-- Unknown // WWW: http://www.sdrc.com/
-=--=-=-==-===-=====//=====-===-==-=-=--=-------------------------------

Eric Galluzzo

unread,

Mar 27, 1998, 3:00:00 AM3/27/98

to

Eric Galluzzo wrote:

> R. Scott Truesdell wrote:
>
> > Does anyone have a snippet of tcl code that recursively traverses
> > directories like Unix's `find` command?
>
> No, but it would be trivial to write one. How about:
>
> proc findFiles {baseDir pattern {command {}}} {
> set fileList {}
> set oldDir [pwd]
> cd $baseDir
> foreach file [glob -nocomplain *] {
> set fullFile [file join $baseDir $file]
> if [file isdirectory $file] {
> eval lappend fileList [findFiles $fullFile $pattern $command]
> } elseif [string match $pattern $file] {
> lappend fileList $fullFile
> if [string compare $command {}] {
> catch {eval $command \$fullFile}
> }
> }
> }
> return $fileList
> }
>
> I haven't actually tested this, but it ought to work. Tweak as
> necessary. :)

Argh. Once again, I seem to have posted without actually proofreading my code.
Try this instead:

proc findFiles {baseDir pattern {command {}}} {
set fileList {}

foreach file [glob -nocomplain [file join $baseDir *]] {
if [file isdirectory $file] {
eval lappend fileList [findFiles $file $pattern $command]
} elseif [string match $pattern [file basename $file]] {
lappend fileList $file
if [string compare $command {}] {
catch {eval $command \$file}
}
}
}
return $fileList

Adam Foust

unread,

Apr 1, 1998, 3:00:00 AM4/1/98

to

Here's mine...

#
# Delve -- Recursively List All Non-Dir Files in a File Tree
#
# PARAMETERS
# dir -- directory to search
# (root) -- cummulative path passed recursively down
#
# RETURNS
# list of files
#

proc delve { dir {root ""} } {

if {($dir != "") && ($dir != ".")} {
if {![file isdirectory $dir]} return
cd $dir
}
if {$dir != ""} {
append root $dir/
}

set files ""
foreach item [glob -nocomplain *] {
if {![file isdirectory $item]} {
lappend files $root$item
continue
}
append files " [delve $item $root]"
}

if {($dir != ".") && ($dir != "")} {
cd ..
}
return $files
}

Cameron Laird

unread,

Apr 2, 1998, 3:00:00 AM4/2/98

to

Perl and Python both have find-like modules-extensions-...
publicly available. Is it time for someone to volunteer to
do the same for Tcl?
--

Cameron Laird http://starbase.neosoft.com/~claird/home.html
cla...@NeoSoft.com +1 713 996 8546 FAX

Jean-Claude Wippler

unread,

Apr 2, 1998, 3:00:00 AM4/2/98

to Cameron Laird

Cameron Laird wrote:
>
> Adam Foust <agf...@tva.gov> wrote:
> >Here's mine...
> >
> >#
> ># Delve -- Recursively List All Non-Dir Files in a File Tree
> >#
> ># PARAMETERS
> ># dir -- directory to search
> ># (root) -- cummulative path passed recursively down
> >#
> ># RETURNS
> ># list of files
> >#
> >
> >proc delve { dir {root ""} } {

[...]

> > append files " [delve $item $root]"

[...]
> >}

Ok, then here's another one, no recursion this time:

proc findFiles {baseDir pattern} {
set fileList {}
set dirList $baseDir

while {[llength $dirList]>0} {
set subDir [lindex $dirList 0]
set dirList [lreplace $dirList 0 0]

foreach entry [glob -nocomplain [file join $subDir *]] {
if {[file isdirectory $entry]} {
lappend dirList $entry
} elseif [string match $pattern $entry] {
lappend fileList $entry
}
}
}

return $fileList
}

puts "[findFiles . *]"

(please ignore any silly stuff in here, I'm still learning Tcl...)

> Perl and Python both have find-like modules-extensions-...
> publicly available. Is it time for someone to volunteer to
> do the same for Tcl?

Yes, but... from a extension writer's point of view it would seem more
effective to write a few variations *once*, and then interface it to
Tcl, Perl, Python, C/C++, whatever... perhaps even with a common shared
library and a very thin interface layer for each of the languages?

-- Jean-Claude

________________________________________________________________________
Jean-Claude Wippler MetaKit home page - http://www.equi4.com/metakit/
Equi4 Software "Portable database software for a changing world"

Andreas Kupries

unread,

Apr 3, 1998, 3:00:00 AM4/3/98

to

cla...@Starbase.NeoSoft.COM (Cameron Laird) writes:

> In article <3522B1C4...@tva.gov>, Adam Foust <agf...@tva.gov> wrote:
> >Here's mine...

Ok, another one :-)

proc ::pool::file::descendDirs {var path script} {
# @c Executes <a script> for all directories found in the
# @c directory hierarchy beginning at <a path>. The
# @c <a script> has immediate access to the variable
# @c <a var>, which will be set to the current directory
# @c before each execution. The working directory, as delivered
# @c by `pwd`, will be set to the current directory too.
# @c The command takes great care to avoid looping
# @c (which might be caused by circular links)

# @a var: Variable used to transfer the current path into the
# @a var: <a script>.
# @a path: Start of the directory hierarchy to follow.
# @a script: Tcl code executed upon each iteration.

# @i descend directories, directory hierarchy, directory scan

global errorInfo errorCode

if {![file isdirectory $path]} {
error "$path does not refer to a directory"
}

# table of visited inodes, to prevent looping
::pool::array::def inodes

set pathlist $path
upvar $var loopvar

while {[llength $pathlist] > 0} {
# loop until list of directories is exhausted

set p [::pool::list::shift pathlist]

# get path info, ignore directores non-stat'able
if {[catch {file stat $p stat}]} {
continue
}

# ignore inodes visited earlier
if {[info exists inodes($stat(ino))]} {
continue
}
set inodes($stat(ino)) 1

# ------------------------------------------------
# execute script for path

set here [pwd]
catch {
cd $p
set loopvar $p

set res [catch {uplevel $script} msg]
# handling of script result is defered behind catch
# and restoration of current directory
}
cd $here

# possible results
# 0 - ok, nothing
# 1 - error, reflect up
# 2 - return, reflect up
# 3 - break, this loop!
# 4 - continue, nothing
# any other: user defined, reflect up.

switch -- $res {
0 {}
1 {
return -code error \
-errorinfo $errorInfo \
-errorcode $errorCode $msg}

2 {
return -code return $msg
}
3 {
return {}
}
4 {}
default {
return -code $res
}
}

# ------------------------------------------------
# tack subdirectories of 'p' to the start of the list,
# this implements the depth first order.

set pathlist [concat [subdirs $p] $pathlist]
}
}

>
> Perl and Python both have find-like modules-extensions-...
> publicly available. Is it time for someone to volunteer to
> do the same for Tcl?

See
http://www.westend.com/~kupries/doc/pool/f723.htm
http://www.westend.com/~kupries/doc/pool/index.htm

Actually the version above, without namespaces.

--
Sincerely,
Andreas Kupries <a.ku...@westend.com>
<http://www.westend.com/~kupries/>
-------------------------------------------------------------------------------