+2006-11-10 Steve Huntley <stephen.huntley@alum.mit.edu>
+
+ * 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 <stephen.huntley@alum.mit.edu>
* library/template/versionvfs.tcl: added code to ensure all
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
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.
########################
}
}
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)\"}
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 {
if ![string equal $index {}] {
return $attributes($attribute)
}
-
# otherwise, just return all attribute names
return [lsort [array names attributes]]
}
return -code error $::vfs::posix(ENOTEMPTY)
}
}
+ if {$relative == {}} {Unmount $root ; return}
RemoveDirectory $path $root $relative $actualpath
CacheClear $virtualName
}
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
-}
-
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.
########################
}
+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]
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:
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]
# 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]