[SEH] As a self-teaching exercise, I wrote a sample virtual filesystem that utilizes as much of the [Tclvfs] API as possible, although its function is trivially simple. The virtual filesystems included with the Tclvfs distribution are instructive, but they take a lot of shortcuts. ---- [LV] Would it be beneficial a) to include this template with tclvfs and b) to upgrade the existing tclvfs examples with the features your template provide? [SEH] I would love to have my work incorporated into the tcllib, but I don't think it's my decision. [CMcC] With all respect to SEH, whose idea the template vfs is, I would like to suggest that the template vfs either be rewritten in Snit, or a parallel version in [Snit] written and maintained as part of the same package. I have rewritten Steve's template vfs in Snit, for the reasons I give below (although I'm not suggesting that my version is necessarily the best possible version.) The reasons to use Snit for template vfs: 1. Very often in [tclvfs] code one is forced to carry state around with each mount-point. There's no easy/neat way to do this in pure templates (as code inspection will reveal :) 2. Consistent -option handling, with defaults. 3. Clearer interface definition and composition - Snit is designed to plug components together. 4. OO paradigms are interconvertable more easily than rewriting something into OO. Now's a good time to make the choice to go OO - before it's too late. 5. Easier to extend a Snit type to extend functionality than to do the same with pure-namespace implementations. 6. (add here) Rubbish reasons not to use Snit for vfs: 1. ''I don't know/use Snit'' ... either it's worth using or not, lack of training isn't an excuse.. 2. ''I don't like Snit'' ... suggest another system, suggest some improvements - argue about it. 3. ''I don't like OO'' / ''I've got my own OO style'' ... two words: code reuse Real reasons not to use Snit for tclvfs: 1. Snit's slower than pure template code aka ''Snit is no speed demon''... This is the hardest one to answer for tclvfs file systems which are speed critical - but what are you doing using tclvfs for a speed-critical facility? Snit's getting a lot of optimisation attention, and this will only improve the performance over time. Finally, the best reason for using Snit for tclvfs: Much of the need for this Template vfs is that the tclvfs raw interface has some anomalies and some lacks. The template vfs is really a shim to provide: 1. a consistent interface to tclvfs where there are some incongruities (smoothing out the rough spots.) 2. genuine extensions of tclvfs functionality which could be better implemented in tcl than in C. Some of the provisions in point 1 can eventually be moved into the tclvfs C core. Doing this over an OO interface is (I believe) easier and less disruptive than doing it over a pure namespace implementation. Therefore: I would like to argue, passionately, for at least *some* OO interface, and preferably Snit (because it seems to be the ostensive standard for pure tcl OO,) whether or not this is maintained in parallel with or alternative to a pure namespace template tclvfs shim. I would also like to see the existing tclvfs' migrated to whatever system is adopted, and new tclvfs' adhering to whatever that system is. ---- Because it simply mirrors a real filesystem location, I believe this [vfs] is maximally featureful. My aim for this vfs is to use it as a template for rapid development of new and more complex filesystems. The Mount, Unmount and handler procedures are completely generic and should never need customization for new filesystems. Thus the task of creating a new virtual filesystem is reduced to filling in the procedures for handling the eight subcommands of the Tclvfs API, as well as mounting and unmounting specifics. [SEH] -- 10/14/04 -- I tidied things up a bit, and added an execution [trace] to the 'close' command so that it will throw a proper error if an error occurs in the close callback procedure. Not too relevant for this vfs, but for more complex ones built on the template. I also added a "-volume" option to the Mount command, so you can now do things like: ::vfs::template::Mount -volume $env(HOME) C:/ on Unix, and make pathnames originating on Windows acceptable. Problems syncing cross-platform filesystems solved! Schweet! package require vfs 1 namespace eval ::vfs::template {} # The template vfs simply mirrors a real directory to a virtual location. # Usage: Mount ?-volume? proc ::vfs::template::Mount {args} { set volume {} if {[lindex $args 0] == "-volume"} {set volume "-volume"} set pathto [eval MountProcedure $args] set path [lindex $pathto 0] set to [lindex $pathto 1] eval ::vfs::filesystem mount $volume \$to \[list ::vfs::template::handler \$path\] ::vfs::RegisterMount $to [list ::vfs::template::Unmount] if {[trace info execution close] == {}} { trace add execution close leave ::vfs::template::CloseTrace } return $to } proc ::vfs::template::Unmount {to} { set to [file normalize $to] set path [lindex [::vfs::filesystem info $to] end] UnmountProcedure $path $to ::vfs::filesystem unmount $to } proc ::vfs::template::CloseTrace {commandString code result op} { set errorCode $::errorCode set errorInfo $::errorInfo set channelID [lindex $commandString 1] if [regexp {::Close ([^ ]+?) } $errorInfo trash errorChannelID] { if [string equal $channelID $errorChannelID] { if {[lindex $errorCode 0] == "POSIX"} { set pError [lindex $errorCode 1] ::vfs::filesystem posixerror $::vfs::posix($pError) ; return -code error $::vfs::posix($pError) } set message [lindex [split $errorInfo \n] 0] error $message $errorInfo $errorCode } } } proc ::vfs::template::handler {path cmd root relative actualpath args} { switch -- $cmd { access { set mode [lindex $args 0] set error [catch {Access $path $root $relative $actualpath $mode}] if $error {::vfs::filesystem posixerror $::vfs::posix(EACCES) ; return -code error $::vfs::posix(EACCES)} } createdirectory { CreateDirectory $path $root $relative $actualpath } deletefile { DeleteFile $path $root $relative $actualpath } fileattributes { set index [lindex $args 0] set value [lindex $args 1] array set attributes [FileAttributes $path $root $relative $actualpath] if {$index == {}} { return [lsort [array names attributes]] } set attribute [lindex [lsort [array names attributes]] $index] if {$value == {}} { return $attributes($attribute) } FileAttributesSet $path $root $relative $actualpath $attribute $value } matchindirectory { set pattern [lindex $args 0] set types [lindex $args 1] return [MatchInDirectory $path $root $relative $actualpath $pattern $types] } open { set mode [lindex $args 0] if {$mode == {}} {set mode r} set permissions [lindex $args 1] set channelID [Open $path $root $relative $actualpath $mode $permissions] switch -glob -- $mode { "" - "r*" - "w*" { seek $channelID 0 } "a*" { seek $channelID 0 end } default { ::vfs::filesystem posixerror $::vfs::posix(EINVAL) return -code error $::vfs::posix(EINVAL) } } set result $channelID lappend result [list ::vfs::template::Close $channelID $path $root $relative $actualpath $mode] return $result } removedirectory { set recursive [lindex $args 0] if !$recursive { if {[MatchInDirectory $path $root $relative $actualpath * 0] != {}} { ::vfs::filesystem posixerror $::vfs::posix(EEXIST) return -code error $::vfs::posix(EEXIST) } } RemoveDirectory $path $root $relative $actualpath } stat { return [Stat $path $root $relative $actualpath] } utime { set atime [lindex $args 0] set mtime [lindex $args 1] Utime $path $root $relative $actualpath $atime $mtime } } } namespace eval ::vfs::template { proc MountProcedure {args} { if {[lindex $args 0] == "-volume"} { set args [lrange $args 1 end] set to [lindex $args 1] } else { set to [file normalize [lindex $args 1]] } set path [file normalize [lindex $args 0]] if [info exists ::vfs::_unmountCmd($to)] {::vfs::unmount $to} file mkdir $path lappend pathto $path lappend pathto $to return $pathto } proc UnmountProcedure {path to} { return } proc Access {path root relative actualpath mode} { set modeString [::vfs::accessMode $mode] if {$modeString == "F"} {set modeString RWX} set modeString [split $modeString {}] set fileName [file join $path $relative] set fileString {} if [file readable $fileName] {lappend fileString R} if [file writable $fileName] {lappend fileString W} if [file executable $fileName] {lappend fileString X} foreach mS $modeString { set errorMessage "not [string map {R readable W writable X executable} $mS]" if {[lsearch $fileString $mS] == -1} {error $errorMessage} } } proc CreateDirectory {path root relative actualpath} { file mkdir [file join $path $relative] } proc DeleteFile {path root relative actualpath} { set fileName [file join $path $relative] file delete $fileName } proc FileAttributes {path root relative actualpath} { set fileName [file join $path $relative] file attributes $fileName } proc FileAttributesSet {path root relative actualpath attribute value} { set fileName [file join $path $relative] file attributes $fileName $attribute $value } proc MatchInDirectory {path root relative actualpath pattern types} { if [::vfs::matchDirectories $types] {lappend typeString d} if [::vfs::matchFiles $types] {lappend typeString f} if [::vfs::matchFiles $types] {lappend typeString f} set globList [glob -directory [file join $path $relative] -nocomplain -types $typeString $pattern] set pathLength [expr [string length $path] - 1] set newGlobList {} foreach gL $globList { set gL [string replace $gL 0 $pathLength $root] lappend newGlobList $gL } return $newGlobList } proc Open {path root relative actualpath mode permissions} { set fileName [file join $path $relative] set newFile 0 if ![file exists $fileName] {set newFile 1} set channelID [open $fileName $mode] if $newFile {catch {file attributes $fileName -permissions $permissions}} return $channelID } proc Close {channelID path root relative actualpath mode} { # Do not close the channel in the close callback! # It will crash Tcl! Honest! # The core will close the channel after you've taken what info you need from it. # close $channelID return } proc RemoveDirectory {path root relative actualpath} { file delete -force [file join $path $relative] } proc Stat {path root relative actualpath} { file stat [file join $path $relative] fs return [list dev $fs(dev) ino $fs(ino) mode $fs(mode) nlink $fs(nlink) uid $fs(uid) gid $fs(gid) size $fs(size) atime $fs(atime) mtime $fs(mtime) ctime $fs(ctime) type $fs(type)] } proc Utime {path root relative actualpath atime mtime} { set fileName [file join $path $relative] file atime $fileName $atime file mtime $fileName $mtime } } # end namespace eval ::vfs::template ---- 20040720 [CMcC]: I just saw a real use for this - a trace fs. Someone was trying to work out why copy -force was failing, it would have been nice to be able to say to them: mount this on your directory and look at the log. Trivial addition to this template - log each argument to, and result from, underlying file system. [snitvfs] has a reimplementation of this, in [Snit]. ---- [[ [Category Example] | [Category VFS] ]]