SC -- Here's a little convenience routine I wrote as part of CANTCL which ensures that a directory is mounted either as a regular directory or via VFS:
# with_mounted_dir --
#
# Since packages can be either inside a regular directory on
# the file system or within some kind of vfs mountable
# archive (or remote location), this wrapper is used to
# perform all operations on packages. It ensures that the given
# directory is readable, mounting it with tclvfs if needed.
#
# Arguments:
# dir -- a directory or archive
# body -- code to run with dir guaranteed to be mounted
# "except" -- the word except, introduces optional exception block
# exceptblock -- code to execute if the dir can't be mounted for some
# reason
# Results:
# Returns the result of evaluating the body or exceptblock in the caller's
# context
#
proc with_mounted_dir {dir body {"except" {}} {exceptbody {}}} {
variable mountpoints
if {[file isdirectory $dir]} {
return [uplevel 1 $body]
} else {
# we need to try to mount it with tclvfs
# the file system types we know about
set vfstypes {zip mk4 tar}; # also: ftp http webdav
set mounted {}
foreach fs $vfstypes {
if {![catch {
package require vfs::$fs
set mountpoint [vfs::${fs}::Mount $dir $dir]
} fp]} {
set mounted $fs
break
}
}
if {$mounted != {}} {
catch {uplevel 1 $body} result
# now unmount before leaving
vfs::${mounted}::Unmount $mountpoint $dir
return $result
}
}
# if we're here we couldn't mount the dir
return [uplevel 1 $exceptbody]
}I realise this isn't as robust as it might be in running the body code — any suggestions appreciated.
And here's an example:
set dir /path/to/starkit.kit
with_mounted_dir $dir {
set files [glob -join $dir *]
puts "Files in starkit are: $files"
}