*** empty log message ***
authorSteve Huntley <stephen.huntley@alum.mit.edu>
Sat, 11 Nov 2006 05:39:50 +0000 (05:39 +0000)
committerSteve Huntley <stephen.huntley@alum.mit.edu>
Sat, 11 Nov 2006 05:39:50 +0000 (05:39 +0000)
ChangeLog
library/template/templatevfs.tcl
library/template/versionvfs.tcl

index 3363e518cda809f8b571c40321c7c424e262053b..4a659cfcc573464743da73e83dc10fa016c61ba0 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+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
index 26f0e712c35838ffd7d37e64b36965ce29f4fabb..79cce7126ea5eb67ebfcc71c869a9bf969e5ba4a 100644 (file)
@@ -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
-}
-
index 6bbe878ec44e0b554d724a3e3084c311742b6c8c..6226581e8313303b80a29aaf34d28cb2bce03244 100644 (file)
@@ -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]