From: Vince Darley Date: Wed, 19 Feb 2003 11:15:48 +0000 (+0000) Subject: state, commit attributes X-Git-Tag: vfs-1-3~45 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=dd651b72656c24078694aa17bc29e15da292d5ff;p=tclvfs state, commit attributes --- diff --git a/ChangeLog b/ChangeLog index 7792863..468928c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2003-02-19 Vince Darley + + * 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 * generic/vfs.c: diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl index 9baaa30..9c7d65f 100644 --- 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 8a36c31..e154e5d 100644 --- 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 b042a57..9ccd5ae 100644 --- 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 4723cff..fd90e2f 100644 --- 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 9be0510..f28ecb6 100644 --- 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 5906abb..b954f76 100644 --- 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.