further vfs::attributes work

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 05be7d7eb901b4e3655c044a086097dd39d733a6..b54f7bb1d348ea1fe86f633447811bf14c52df33 100644 (file)
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -56,8 +56,18 @@ namespace eval vfs::mk4 {
        ::mk4vfs::_umount $db
     }
 
-    proc state {} {
-       return "translucent"
+    proc state {db args} {
+       switch -- [llength $args] {
+           0 {
+               return "translucent"
+           }
+           1 {
+               return -code error "Can't set state yet"
+           }
+           default {
+               return -code error "Wrong num args"
+           }
+       }
     }
     
     proc handler {db cmd root relative actualpath args} {

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 1888cf01c3a1bd6dcae61f4241f957dcfdf01c8e..0f016fbf95405ad621adbfca2365cfb4b701d917 100644 (file)
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -61,68 +61,44 @@ proc ::vfs::unmount {mountpoint} {
 
 # 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 handler [::vfs::filesystem info $mountpoint]
     
     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
-                   }
-               }
+       foreach attr $attrs {
+           regsub -- "::handler" $handler ::$attr cmd
+           if {[catch $cmd 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 {[llength $args] > 1} {
        set attr [string range [lindex $args 0] 1 end]
        set val [lindex $args 1]
        set args [lrange $args 2 end]
-       if {[info commands ::vfs::${ns}::$attr] != ""} {
-           if {![llength [info args ::vfs::${ns}::$attr]]} {
-               return -code error "filesystem attribute \"$attr\" is read-only"
-           }
-           if {[catch {::vfs::${ns}::$attr $val} err]} {
-               return -code error "error setting filesystem attribute\
-                 \"$attr\": $err"
-           } else {
-               set res $val
-           }
+       regsub -- "::handler" $handler ::$attr cmd
+       if {[catch {eval $cmd [list $val]} err]} {
+           return -code error "error setting filesystem attribute\
+             \"$attr\": $err"
        } else {
-           return -code error "filesystem attribute \"$attr\" not known"
+           set res $val
        }
     }
     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
-           }
+       set attr [string range [lindex $args 0] 1 end]
+       regsub -- "::handler" $handler ::$attr cmd
+       if {[catch $cmd val]} {
+           return -code error "error reading filesystem attribute\
+             \"$attr\": $val"
        } else {
-           return -code error "filesystem attribute \"$attr\" not known"
+           set res $val
        }
     }
     return $res