ramvfs

WK The following is a sample code that uses memchan to mount a VFS that saves everything in RAM. I wrote this because some code (like tclcompiler) needs to write to a file, so it's easier to put it on a dummy VFS than in a temporary file. Enjoy.
DAS - also see vfs::inmem
 package provide vfs::ram 0.5
 
 # This works for basic operations, but has not been very debugged.
 
 namespace eval vfs::ram {}
 
 proc vfs::ram::Mount {domain local} {
    if {![catch {vfs::filesystem info $domain}]} {
        vfs::unmount $domain
    }
    # register the mount
    eval [concat [list vfs::filesystem mount] $args \
        [list $local [list vfs::ram::handler $domain]]]
    # Register command to unmount
    vfs::RegisterMount $local [list ::vfs::ram::Unmount $domain]
    return $domain
 }
 
 proc vfs::ram::Unmount {domain local} {
    vfs::filesystem unmount $local
 }
 
 proc vfs::ram::handler {dirurl cmd root relative actualpath args} {
    if {$cmd == "matchindirectory"} {
        eval [list $cmd $dirurl $relative $actualpath] $args
    } else {
        eval [list $cmd $dirurl $relative] $args
    }
 }
 
 # If we implement the commands below, we will have a perfect
 # virtual file system for remote http sites.
 
 proc vfs::ram::stat {dirurl name} {
    ::vfs::log "stat $name"
    if {[catch {_file_size $dirurl$name} size]} {
      vfs::filesystem posixerror $::vfs::posix(ENOENT)
      return
    }
    lappend res type file
    set mtime 0
    lappend res dev -1 uid -1 gid -1 nlink 1 depth 0 \
      atime $mtime ctime $mtime mtime $mtime mode 0777 size $size
    return $res
 }
 
 proc vfs::ram::access {dirurl 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::ram::open {dirurl name mode permissions} {
    ::vfs::log "open $name $mode $permissions"
    # return a list of two elements:
    # 1. first element is the Tcl channel name which has been opened
    # 2. second element (optional) is a command to evaluate when
    #    the channel is closed.
    set filed [vfs::memchan]
    vfs::ram::_onopen $mode $dirurl$name $filed
    return [list $filed [list vfs::ram::_onclose $mode $dirurl$name $filed]]
 }
 
 proc vfs::ram::matchindirectory {dirurl path actualpath pattern type} {
    ::vfs::log "matchindirectory $path $pattern $type"
    set res [list]
    return $res
 }
 
 proc vfs::ram::createdirectory {dirurl name} {
    ::vfs::log "createdirectory $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
 }
 
 proc vfs::ram::removedirectory {dirurl name recursive} {
    ::vfs::log "removedirectory $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
 }
 
 proc vfs::ram::deletefile {dirurl name} {
    ::vfs::log "deletefile $dirurl$name"
    if {[catch {_delete $dirurl$name}]} {
        vfs::filesystem posixerror $::vfs::posix(ENOENT)
    }
 }
 
 proc vfs::ram::fileattributes {dirurl 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::ram::utime {dirurl path actime mtime} {
    vfs::filesystem posixerror $::vfs::posix(EROFS)
 }
 
 proc vfs::ram::_onopen {mode filename filed} {
    if {![catch {_file_get $filename} data]} {
        fconfigure $filed -translation binary
        puts -nonewline $filed $data
        seek $filed 0
        fconfigure $filed -translation auto
    }
 }
 proc vfs::ram::_onclose {mode filename filed} {
    variable filedata
    fconfigure $filed -translation binary
    seek $filed 0
    set data [read $filed]
    _file_set $filename $data
 }
 if {[info exists ::tcl_platform(threaded)]&&$::tcl_platform(threaded)} {
    package require Thread
    proc vfs::ram::_delete {filename} {
        tsv::unset VfsRam $filename
    }
    proc vfs::ram::_file_get {filename} {
        variable filedata
        return [tsv::get VfsRam $filename]
    }
    proc vfs::ram::_file_set {filename data} {
        variable filedata
        tsv::set VfsRam $filename $data
    }
 }  else  {
    proc vfs::ram::_delete {filename} {
        variable filedata
        unset filedata($filename)
    }
    proc vfs::ram::_file_get {filename} {
        variable filedata
        return $filedata($filename)
    }
    proc vfs::ram::_file_set {filename data} {
        variable filedata
        set filedata($filename) $data
    }
 }
 
 proc vfs::ram::_file_size {filename} {
    variable filedata
    return [string length [_file_get $filename]]
 }
Category VFS