with_mounted_dir

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"
 }