From: Steve Huntley Date: Sat, 11 Nov 2006 05:39:50 +0000 (+0000) Subject: *** empty log message *** X-Git-Tag: vfs-1-4~45 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=6a4e84486cd13cdfe021a64c7b39df80851afb81;p=tclvfs *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 3363e51..4a659cf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2006-11-10 Steve Huntley + + * library/template/templatevfs.tcl: file delete on vfs mount + point now causes vfs to unmount ; can now pass empty string + as arbitrary attribute value + + * library/template/versionvfs.tcl: more efficient directory + deletion code + 2006-10-31 Steve Huntley * library/template/versionvfs.tcl: added code to ensure all diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl index 26f0e71..79cce71 100644 --- a/library/template/templatevfs.tcl +++ b/library/template/templatevfs.tcl @@ -7,7 +7,7 @@ templatevfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.0 +Version 1.01 The template virtual filesystem is designed as a prototype on which to build new virtual filesystems. Only a few simple, abstract procedures have to be overridden to produce a new @@ -41,9 +41,8 @@ a procedure that ensures that all vfs's are explicitly unmounted before the shell terminates. When a vfs built on the template vfs is mounted, the mount command options are stored in an array named -vfs::template::mount with the virtual mount points as the array index name. On exit, the contents of -this array are stored in the file $HOME/.vfs_tcl. When this file is sourced, the array vfs::template::mount -is restored by reading $HOME/.vfs_tcl if the file exists. +vfs::template::mount with the virtual mount point as the array index name. Thus a vfs can be re-mounted +by executing "eval" on the contents of the array element whose index is the vfs's virtual mount point. ######################## } @@ -238,7 +237,7 @@ proc handler {path cmd root relative actualpath args} { } fileattributes { set index [lindex $args 0] - set value [lindex $args 1] + if {[llength $args] > 1} {set value [lindex $args 1]} set extra {} if [string equal $relative {}] {eval set extra \"-cache \$[namespace current]::cache(\$root)\"} @@ -253,7 +252,7 @@ proc handler {path cmd root relative actualpath args} { set attribute [lindex [lsort [array names attributes]] $index] # if value given in args, set it and return: - if ![string equal $value {}] { + if [info exists value] { if [string equal $attribute "-cache"] { set [namespace current]::cache($root) $value } else { @@ -267,7 +266,6 @@ proc handler {path cmd root relative actualpath args} { if ![string equal $index {}] { return $attributes($attribute) } - # otherwise, just return all attribute names return [lsort [array names attributes]] } @@ -337,6 +335,7 @@ proc handler {path cmd root relative actualpath args} { return -code error $::vfs::posix(ENOTEMPTY) } } + if {$relative == {}} {Unmount $root ; return} RemoveDirectory $path $root $relative $actualpath CacheClear $virtualName } @@ -616,31 +615,11 @@ namespace export -clear * catch {rename ::exit ::vfs::template::exit} proc ::exit {} { - foreach vfs [lsort -decreasing [::vfs::filesystem info]] { + foreach vfs [::vfs::filesystem info] { if [catch {$::vfs::_unmountCmd($vfs) $vfs} result] { puts "$vfs: $result" } } - - # save contents of array which stores historical mount command options - if [info exists ::vfs::template::mount] { - set startDir [pwd] - cd - set f [open .vfs_tcl w] - puts $f [array get ::vfs::template::mount] - close $f - cd $startDir - } ::vfs::template::exit } -# restore mount command options history to array: -if [file exists .vfs_tcl] { - set startDir [pwd] - cd - set f [open .vfs_tcl r] - array set ::vfs::template::mount [read $f] - close $f - cd $startDir -} - diff --git a/library/template/versionvfs.tcl b/library/template/versionvfs.tcl index 6bbe878..6226581 100644 --- a/library/template/versionvfs.tcl +++ b/library/template/versionvfs.tcl @@ -5,7 +5,7 @@ versionvfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.0 +Version 1.02 A versioning virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -72,13 +72,15 @@ The versioning vfs inherits the -cache and -volume options of the template vfs. ######################## } +package provide vfs::template::version 1.0 + +package require vfs::template + package require globfind namespace import -force ::globfind::globfind namespace eval ::vfs::template::version { -package require vfs_template - # read template procedures into current namespace. Do not edit: foreach templateProc [namespace eval ::vfs::template {info procs}] { set infoArgs [info args ::vfs::template::$templateProc] @@ -157,7 +159,7 @@ proc file_attributes {file {attribute {}} args} { eval return \$::vfs::template::version::${attribute}(\$root) } set ::vfs::template::version::${attribute}($root) [lindex $args 0] - if {[lindex $args 0] == {{}}} {unset ::vfs::template::version::${attribute}($root)} + if {[lindex $args 0] == {}} {unset ::vfs::template::version::${attribute}($root)} return } # process read-only vfs-specific attributes: @@ -196,8 +198,13 @@ proc file_delete {file} { if [file isdirectory $file] { set subfiles [globfind $file] set subfiles [lsort -decreasing $subfiles] - foreach sf $subfiles {globdelete $sf} + set deleted {} + foreach sf $subfiles { + if [file isdirectory $sf] {continue} + globdelete $sf + } set dir 1 + return } set fileName [VAcquireFile $path $root $relative] @@ -375,11 +382,12 @@ proc UnmountProcedure {path to} { # utility proc called by file_delete for recursive deletion of dir contents: proc globdelete {file} { - upvar root root - if [file isdirectory $file] {return} - set file [file join [file dirname $file] [lindex [split $file \;] 0]] + upvar root root deleted deleted + set file [file join [file dirname $file] [lindex [split [file tail $file] \;] 0]] + if {[lsearch $deleted $file] > -1} {return} + lappend deleted $file set fileName $file\;[VCreateTag $root] - set fileName [split $fileName \;] + set fileName [split $fileName \;] set fileName [linsert $fileName 2 "deleted"] set fileName [join $fileName \;] close [open $fileName w]