state, commit attributes

diff --git a/ChangeLog b/ChangeLog
index 779286312729d198d09b815578d76433b3fd5032..468928c3299399cbf699212d83ad7362fac392e7 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2003-02-19  Vince Darley <vincentdarley@sourceforge.net>
+
+       * library/mk4vfs.tcl: added 'commit' attribute
+       * library/vfsUtils.tcl:
+       * library/tarvfs.tcl:
+       * library/zipvfs.tcl:
+       * library/ftpvfs.tcl: added support for 'state' attribute
+       of these filesystems.
+       
 2003-02-18  Vince Darley <vincentdarley@sourceforge.net>
 
        * generic/vfs.c:

diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 9baaa30fcb02bc1e889c485c4159b54a4681b6d0..9c7d65f5984b6aed8aa492169385285cec24ef08 100644 (file)
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -67,6 +67,11 @@ proc vfs::ftp::handler {fd path cmd root relative actualpath args} {
     }
 }
 
+proc vfs::ftp::attributes {fd} { return [list "state"] }
+proc vfs::ftp::state {fd args} {
+    vfs::attributeCantConfigure "state" "readwrite" $args
+}
+
 # If we implement the commands below, we will have a perfect
 # virtual file system for remote ftp sites.
 

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 8a36c3157abe60eeb9794c31981eecc88293f566..e154e5daab8c48cb41b0543bf82cb2f9d4b3f0cd 100644 (file)
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -56,6 +56,34 @@ namespace eval vfs::mk4 {
        ::mk4vfs::_umount $db
     }
 
+    proc attributes {db} { return [list "state" "commit"] }
+    
+    # Can use this to control commit/nocommit or whatever.
+    # I'm not sure yet of what functionality jcw needs.
+    proc commit {db args} {
+       switch -- [llength $args] {
+           0 {
+               if {$::mk4vfs::v::mode($db) == "readonly"} {
+                   return 0
+               } else {
+                   # To Do: read the commit state
+                   return 1
+               }
+           }
+           1 {
+               set val [lindex $args 0]
+               if {$val != 0 && $val != 1} {
+                   return -code error \
+                     "invalid commit value $val, must be 0,1"
+               }
+               # To Do: set the commit state.
+           }
+           default {
+               return -code error "Wrong num args"
+           }
+       }
+    }
+    
     proc state {db args} {
        switch -- [llength $args] {
            0 {

diff --git a/library/tarvfs.tcl b/library/tarvfs.tcl
index b042a57f57144f8b1ab8f957fd0da561139c715a..9ccd5aea066492255a4062985a52112a82359210 100644 (file)
--- a/library/tarvfs.tcl
+++ b/library/tarvfs.tcl
@@ -45,6 +45,11 @@ proc vfs::tar::handler {tarfd cmd root relative actualpath args} {
     }
 }
 
+proc vfs::tar::attributes {tarfd} { return [list "state"] }
+proc vfs::tar::state {tarfd args} {
+    vfs::attributeCantConfigure "state" "readonly" $args
+}
+
 # If we implement the commands below, we will have a perfect
 # virtual file system for tar files.
 # Completely copied from zipvfs.tcl

diff --git a/library/tclIndex b/library/tclIndex
index 4723cffc6e959835a21d33e5e73f532963e8beae..fd90e2fce72b6b95d5eab1b202d8c2ec7d9fadba 100644 (file)
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -9,6 +9,8 @@
 set auto_index(::vfs::ftp::Mount) [list source [file join $dir ftpvfs.tcl]]
 set auto_index(::vfs::ftp::Unmount) [list source [file join $dir ftpvfs.tcl]]
 set auto_index(::vfs::ftp::handler) [list source [file join $dir ftpvfs.tcl]]
+set auto_index(::vfs::ftp::attributes) [list source [file join $dir ftpvfs.tcl]]
+set auto_index(::vfs::ftp::state) [list source [file join $dir ftpvfs.tcl]]
 set auto_index(::vfs::ftp::stat) [list source [file join $dir ftpvfs.tcl]]
 set auto_index(::vfs::ftp::access) [list source [file join $dir ftpvfs.tcl]]
 set auto_index(::vfs::ftp::open) [list source [file join $dir ftpvfs.tcl]]
@@ -35,6 +37,8 @@ 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::attributes) [list source [file join $dir mk4vfs.tcl]]
+set auto_index(::vfs::mk4::commit) [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]]
@@ -47,10 +51,8 @@ set auto_index(::vfs::mk4::removedirectory) [list source [file join $dir mk4vfs.
 set auto_index(::vfs::mk4::deletefile) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::vfs::mk4::fileattributes) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::init) [list source [file join $dir mk4vfs.tcl]]
-set auto_index(::mk4vfs::mount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::_mount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::periodicCommit) [list source [file join $dir mk4vfs.tcl]]
-set auto_index(::mk4vfs::umount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::_umount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::stat) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::do_close) [list source [file join $dir mk4vfs.tcl]]
@@ -59,6 +61,8 @@ set auto_index(::mk4vfs::mkdir) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::getdir) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::mtime) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(::mk4vfs::delete) [list source [file join $dir mk4vfs.tcl]]
+set auto_index(::mk4vfs::mount) [list source [file join $dir mk4vfs.tcl]]
+set auto_index(::mk4vfs::umount) [list source [file join $dir mk4vfs.tcl]]
 set auto_index(loadvfs) [list source [file join $dir pkgIndex.tcl]]
 set auto_index(::starkit::header) [list source [file join $dir starkit.tcl]]
 set auto_index(::starkit::startup) [list source [file join $dir starkit.tcl]]
@@ -68,6 +72,8 @@ set auto_index(::starkit::panic) [list source [file join $dir starkit.tcl]]
 set auto_index(::vfs::tar::Mount) [list source [file join $dir tarvfs.tcl]]
 set auto_index(::vfs::tar::Unmount) [list source [file join $dir tarvfs.tcl]]
 set auto_index(::vfs::tar::handler) [list source [file join $dir tarvfs.tcl]]
+set auto_index(::vfs::tar::attributes) [list source [file join $dir tarvfs.tcl]]
+set auto_index(::vfs::tar::state) [list source [file join $dir tarvfs.tcl]]
 set auto_index(::vfs::tar::matchindirectory) [list source [file join $dir tarvfs.tcl]]
 set auto_index(::vfs::tar::stat) [list source [file join $dir tarvfs.tcl]]
 set auto_index(::vfs::tar::access) [list source [file join $dir tarvfs.tcl]]
@@ -134,6 +140,7 @@ 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::states) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::attributes) [list source [file join $dir vfsUtils.tcl]]
+set auto_index(::vfs::attributeCantConfigure) [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]]
@@ -166,6 +173,8 @@ set auto_index(::vfs::zip::Execute) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::Mount) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::Unmount) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::handler) [list source [file join $dir zipvfs.tcl]]
+set auto_index(::vfs::zip::attributes) [list source [file join $dir zipvfs.tcl]]
+set auto_index(::vfs::zip::state) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::matchindirectory) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::stat) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::access) [list source [file join $dir zipvfs.tcl]]

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 9be051022ba6a244c9da8750cf7166f5b6f1f1b1..f28ecb6548a53a36d4de5ed5c24cdcd4a11360ce 100644 (file)
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -67,8 +67,13 @@ proc vfs::states {} {
 proc ::vfs::attributes {mountpoint args} {
     set handler [::vfs::filesystem info $mountpoint]
     
-    set attrs [list "state"]
     set res {}
+    
+    if {[regsub -- "::handler" $handler ::attributes cmd]} {
+       set attrs [eval $cmd]
+    } else {
+       return -code error "No known attributes"
+    }
 
     if {![llength $args]} {
        foreach attr $attrs {
@@ -108,6 +113,20 @@ proc ::vfs::attributes {mountpoint args} {
     return $res
 }
 
+proc vfs::attributeCantConfigure {attr val largs} {
+    switch -- [llength $largs] {
+       0 {
+           return $val
+       }
+       1 {
+           return -code error "Can't set $attr"
+       }
+       default {
+           return -code error "Wrong num args"
+       }
+    }
+}
+
 ::vfs::autoMountExtension "" ::vfs::mk4::Mount vfs
 ::vfs::autoMountExtension .bin ::vfs::mk4::Mount vfs
 ::vfs::autoMountExtension .kit ::vfs::mk4::Mount vfs

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 5906abbae91ff29e3e82d78cd4909abcf0dc8080..b954f76df4bc8ef6a2082285b1a24509b9294080 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -40,6 +40,11 @@ proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
     }
 }
 
+proc vfs::zip::attributes {zipfd} { return [list "state"] }
+proc vfs::zip::state {zipfd args} {
+    vfs::attributeCantConfigure "state" "readonly" $args
+}
+
 # If we implement the commands below, we will have a perfect
 # virtual file system for zip files.