Updated 2013-09-07 16:06:32 by RLE

WK a VFS that allows creating volumes that are actually mapped using a Tcl command.
 package provide vfs::map 0.5
 package require vfs 1.0
 # This works for basic operations, but has not been very debugged.
 namespace eval vfs::map {}
 proc vfs::map::Mount {args} {
    set command [lindex $args end-1]
    set local [lindex $args end]
    if {![catch {vfs::filesystem info $command}]} {
        vfs::unmount $command
    eval [concat [list vfs::filesystem mount] [lrange $args 0 end-2] [list $local [list vfs::map::handler $command]]]
    # Register command to unmount
    vfs::RegisterMount $local [list ::vfs::map::Unmount $command]
    return $local
 proc vfs::map::Unmount {command local} {
    vfs::filesystem unmount $local
 proc vfs::map::handler {command cmd root relative actualpath args} {
    if {$cmd == "matchindirectory"} {
        eval [list $cmd $command $relative $actualpath] $args
    } else {
        eval [list $cmd $command $relative] $args
 # If we implement the commands below, we will have a perfect
 # virtual file system for remote http sites.
 proc vfs::map::getFileName {name} {
    upvar mapcommand mapcommand
    return [eval [concat $mapcommand] [list $name]]
 proc vfs::map::stat {mapcommand name} {
    ::vfs::log "stat $name"
    file stat [getFileName $name] a
    return [array get a]
 proc vfs::map::access {mapcommand name mode} {
    ::vfs::log "access $name $mode"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
    return 1
 # We've chosen to implement these channels by using a memchan.
 # The alternative would be to use temporary files.
 proc vfs::map::open {mapcommand name mode permissions} {
    set permissions [format 0%03o $permissions]
    if {$mode == ""} {set mode "r"}
    ::vfs::log "open $name $mode $permissions"
    set filed [::open [getFileName $name] $mode $permissions]
    return [list $filed [list vfs::map::_onclose $mode $mapcommand $filed]]
 proc vfs::map::matchindirectory {mapcommand path actualpath pattern type} {
    ::vfs::log "matchindirectory $path $pattern $type"
    set rc [list]
    foreach res [vfs::matchCorrectTypes $type [glob -tails -nocomplain -directory [getFileName $path] $pattern]] {
        lappend rc [file join $actualpath $res]
    return $rc
 proc vfs::map::createdirectory {mapcommand name} {
    ::vfs::log "createdirectory $name"
    file mkdir [getFileName $name]
 proc vfs::map::removedirectory {mapcommand name recursive} {
    ::vfs::log "removedirectory $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
    file delete [getFileName $name]
 proc vfs::map::deletefile {mapcommand name} {
    ::vfs::log "deletefile $mapcommand$name"
    file delete [getFileName $name]
 proc vfs::map::fileattributes {mapcommand path args} {
    ::vfs::log "fileattributes $args"
    switch -- [llength $args] {
        0 {
            # list strings
            return [list]
        1 {
            # get value
            vfs::filesystem posixerror $::vfs::posix(EROFS)
        2 {
            # set value
            vfs::filesystem posixerror $::vfs::posix(EROFS)
 proc vfs::map::utime {mapcommand path actime mtime} {
    vfs::filesystem posixerror $::vfs::posix(EROFS)
 proc vfs::map::_onclose {mapcommand filename filed} {
 # handlers
 proc vfs::map::handleMultidir {args} {
    set dirs [::lrange $args 0 end-1]
    set relativename [::lindex $args end]
    set split [::file split $relativename]
    set rc [file join [lindex $dirs 0] $relativename]
    for {set i 0} {$i < [llength $split]} {incr i} {
        foreach dir $dirs {
            set rname [eval [concat [list ::file join $dir] [lrange $split 0 $i]]]
            if {[file exists $rname]} {
                set rc [eval [concat [list ::file join $rname] [lrange $split [expr {$i+1}] end]]]
    return $rc

For example on Windows:
 vfs::map::Mount -volume [concat [list vfs::map::handleMultidir] [split $::env(PATH) \;]] PATH: 

and on UNIX:
 vfs::map::Mount -volume [concat [list vfs::map::handleMultidir] [split $::env(PATH) :]] PATH: 

Creates a virtual mapping by which you can easily do:
 if {![file exists PATH:dqkit.exe]} {
     puts "dqkit.exe not in PATH."

It can also be used to map multiple directories to one virtual directory. Note that globbing does not work as one would expect - it should actually join globs, but it does not. This idea is based on Symbian's ?: virtual mapping.

escargo 22 Mar 2006 - Could you give a little more explanation of what is mapped to what?

WK The idea is simple - you can write a procedure that will translate names relative to vfs root (ie PATH: above) to names either native or on a different VFS.

vfs::map::handleMultidir is a proc that looks for a specific file in multiple directories - so you can for example have your application's data on CD and updated files on your harddrive and you just access appdata:data/myfile.dat, without actually looking for those files in multiple directories manually.

SEH 2006Mar24 -- See A collate/broadcast virtual filesystem