filesystem configuration first cut

diff --git a/ChangeLog b/ChangeLog
index 18930a07fbca58f970bf886bcc05087964b30288..57c3bc10b724e8a092fd140d40f28df6b22171b2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2003-02-17  Vince Darley <vincentdarley@sourceforge.net>
+
+       * library/vfsUtils.tcl: added beginnings of interface for
+       filesystem configuration.
+       
 2003-02-01  Jean-Claude Wippler  <jcw@equi4.com>
 
        * library/vfslib.tcl: fixed bug in new vfs::zstream code,

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index e78dbc4f027139ac8ad4f70b4093e4c7bae87558..05be7d7eb901b4e3655c044a086097dd39d733a6 100644 (file)
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -56,7 +56,10 @@ namespace eval vfs::mk4 {
        ::mk4vfs::_umount $db
     }
 
-
+    proc state {} {
+       return "translucent"
+    }
+    
     proc handler {db cmd root relative actualpath args} {
        #puts stderr "handler: $db - $cmd - $root - $relative - $actualpath - $args"
        if {$cmd == "matchindirectory"} {

diff --git a/library/tclIndex b/library/tclIndex
index 2cf833eb91a87265feea7ece52c2c88ee061b450..6d19daf2b3deb19fd7dde5ad88f9cc26b39ac5d5 100644 (file)
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -35,6 +35,7 @@ set auto_index(::vfs::http::fileattributes) [list source [file join $dir httpvfs
 set auto_index(::vfs::http::utime) [list source [file join $dir httpvfs.tcl]]
 set auto_index(::vfs::mk4::Mount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::vfs::mk4::Unmount) [list source [file join $dir mk4vfs.tcl]]
+set auto_index(::vfs::mk4::state) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::vfs::mk4::handler) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::vfs::mk4::utime) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::vfs::mk4::matchindirectory) [list source [file join $dir mk4vfs.tcl]]
@@ -131,6 +132,7 @@ set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::log) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::RegisterMount) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::unmount) [list source [file join $dir vfsUtils.tcl]]
+set auto_index(::vfs::attributes) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::haveMount) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::urlMount) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::fileUrlMount) [list source [file join $dir vfsUtils.tcl]]

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 881ba9b9b2162faf2f2aef0916ab8ad4249ae204..330f6875963f593950227d6d59f3f88cd70c9f30 100644 (file)
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -59,6 +59,73 @@ proc ::vfs::unmount {mountpoint} {
     unset _unmountCmd($norm)
 }
 
+# vfs::attributes mountpoint ?-opt val? ?...-opt val?
+proc ::vfs::attributes {mountpoint args} {
+    if {![catch {::vfs::filesystem info $mountpoint} handler]} {
+       regexp {vfs::([^:]+)::handler} $handler -> ns
+    } else {
+       # Let's assume this is a ns directly (not sure if this
+       # code path is a good idea in the long term, but it is
+       # helpful for testing)
+       set ns $mountpoint
+       package require vfs::${ns}
+    }
+    
+    set attrs [list "state"]
+    set res {}
+
+    if {![llength $args]} {
+       if {[info exists ns]} {
+           foreach attr $attrs {
+               if {[info commands ::vfs::${ns}::$attr] != ""} {
+                   if {[catch {::vfs::${ns}::$attr} val]} {
+                       return -code error "error reading filesystem attribute\
+                         \"$attr\": $val"
+                   } else {
+                       lappend res -$attr $val
+                   }
+               }
+           }
+       }
+       return $res
+    }
+    
+    if {![info exists ns]} {
+       return -code error "filesystem not known or not configurable"
+    }
+    
+    while {1} {
+       foreach {attr val} $args {
+           set args [lrange $args 2 end]
+           break
+       }
+       if {[info commands ::vfs::${ns}::$attr] != ""} {
+           if {[catch {::vfs::${ns}::$attr $val} err]} {
+               return -code error "error setting filesystem attribute\
+                 \"$attr\": $err"
+           } else {
+               set res $val
+           }
+       } else {
+           return -code error "filesystem attribute \"$attr\" not known"
+       }
+    }
+    if {[llength $args]} {
+       set attr [lindex $args 0]
+       if {[info commands ::vfs::${ns}::$attr] != ""} {
+           if {[catch {::vfs::${ns}::$attr} val]} {
+               return -code error "error reading filesystem attribute\
+                 \"$attr\": $val"
+           } else {
+               set res $val
+           }
+       } else {
+           return -code error "filesystem attribute \"$attr\" not known"
+       }
+    }
+    return $res
+}
+
 ::vfs::autoMountExtension "" ::vfs::mk4::Mount vfs
 ::vfs::autoMountExtension .bin ::vfs::mk4::Mount vfs
 ::vfs::autoMountExtension .kit ::vfs::mk4::Mount vfs