From: Steve Huntley <stephen.huntley@alum.mit.edu>
Date: Wed, 27 Feb 2008 04:36:38 +0000 (+0000)
Subject: Minor bug fixes and reformatting.
X-Git-Tag: vfs-1-4~31
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=359c1d97cecc5174af751e025ec7b6ea3189f788;p=tclvfs

Minor bug fixes and reformatting.
---

diff --git a/library/template/deltavfs.tcl b/library/template/deltavfs.tcl
index 1e17158..499fcd0 100644
--- a/library/template/deltavfs.tcl
+++ b/library/template/deltavfs.tcl
@@ -5,7 +5,7 @@ deltavfs.tcl --
 
 Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
 License: Tcl license
-Version 1.5
+Version 1.5.1
 
 A delta virtual filesystem.  Requires the template vfs in templatevfs.tcl.
 
@@ -232,6 +232,9 @@ proc Delta {filename} {
 }
 
 proc GetFileName {file} {
+	set isdir 0
+	if {([string first \; $file] == -1) && ![set isdir [file isdirectory $file]]} {return {}}
+	if $isdir {return $file}
 	set fileNames [glob -nocomplain -path $file *]
 	if {[lindex [file system $file] 0] != "tclvfs"} {append fileNames " [glob -nocomplain -path $file -type hidden *]"}
 	set fileName [lindex $fileNames 0]
diff --git a/library/template/pkgIndex.tcl b/library/template/pkgIndex.tcl
index a74ecd8..e8a09d4 100644
--- a/library/template/pkgIndex.tcl
+++ b/library/template/pkgIndex.tcl
@@ -8,7 +8,7 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.
 
-package ifneeded vfs::template 1.5 [list source [file join $dir templatevfs.tcl]]
+package ifneeded vfs::template 1.5.1 [list source [file join $dir templatevfs.tcl]]
 
 set ::auto_index(::vfs::template::mount) [list package require vfs::template 1.5]
 set ::auto_index(::vfs::template::collate::mount) [list source [file join $dir collatevfs.tcl]]
diff --git a/library/template/quotavfs.tcl b/library/template/quotavfs.tcl
index 021d7d2..e258b90 100644
--- a/library/template/quotavfs.tcl
+++ b/library/template/quotavfs.tcl
@@ -5,7 +5,7 @@ quotavfs.tcl --
 
 Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
 License: Tcl license
-Version 1.5
+Version 1.5.1
 
 A quota-enforcing virtual filesystem.  Requires the template vfs in templatevfs.tcl.
 
@@ -170,7 +170,7 @@ proc file_stat {file array} {upvar $array fs ; ::file stat $file fs}
 proc file_writable {file} {file writable $file}
 proc glob_ {directory dir nocomplain tails types typeString dashes pattern} {glob -directory $dir -nocomplain -tails -types $typeString -- $pattern}
 proc open_ {file mode} {
-	upvar root root
+	upvar root root permissions permissions
 	upvar newFile newFile
 	if {$mode == "r"} {
 		set atime [clock seconds]
@@ -178,18 +178,24 @@ proc open_ {file mode} {
 		set ::vfs::template::quota::files($file) $atime
 		return [open $file r]
 	}
+
+if $newFile {
+	set now [clock seconds]
+	set fstat "mtime $now atime $now mode $permissions type file ctime $now size 0"
+	QuotaAdd $file
+}
 	set channel [open $file $mode]
 
 # Check if new file violates any quotas by adding it to quota tallies:
-	if $newFile {
-		set err [catch {QuotaAdd $file} result]
-		if $err {
-			close $channel
-			file delete -force -- $file
-			vfs::filesystem posixerror $::vfs::posix(EDQUOT)
-			error "Disk quota exceeded"
-		}
-	}
+#	if $newFile {
+#		set err [catch {QuotaAdd $file} result]
+#		if $err {
+#			close $channel
+#			file delete -force -- $file
+#			vfs::filesystem posixerror $::vfs::posix(EDQUOT)
+#			error "Disk quota exceeded"
+#		}
+#	}
 # remove file from quota tallies until channel is closed:
 	array set quotaArray $::vfs::template::quota::quota($root)
 	QuotaDelete $file 0
@@ -274,7 +280,7 @@ proc CheckPattern {pattern value} {
 proc QuotaAdd {fileName} {
 	set caller [lindex [info level -1] 0]
 	if {$caller == "MountProcedure"} {set init 1} else {set init 0}
-	upvar path path root root quotaSize quotaSize
+	upvar path path root root quotaSize quotaSize fstat fstat
 	if ![string first ".vfs_" [file tail $fileName]] {return 0}
 	if {[info exists path] && ($fileName == $path)} {return 0}
 	array set quotaArray $::vfs::template::quota::quota($root)
@@ -282,8 +288,12 @@ proc QuotaAdd {fileName} {
 	set items [lsort -unique [string map {",type " " " ",rule " " " ",quota " " " ",current " " "} " [array names quotaArray] "]]
 
 	set delete 1
+if [info exists fstat] {
+	array set fs $fstat	
+} else {
 	set noexist [catch {file stat $fileName fs}]
 	if $noexist {return 0}
+}
 	set fs(filename) $fileName
 
 # if this call is being used to check edits, replace file size with channel size and don't delete file if edit too big:
@@ -296,7 +306,7 @@ proc QuotaAdd {fileName} {
 # Check each defined quota to see if given file violates it:
 	foreach item $items {
 		regexp {([0-9]*),(.*)} $item trash groupCount item
-		if ![info exists fs($item)] {array set fs [file attributes $fileName]}
+		if ![info exists fs($item)] {if [file exists $fileName] {array set fs [file attributes $fileName]}}
 		if ![info exists fs($item)] {continue}
 		set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]]
 		if $contrib	{	
@@ -422,7 +432,7 @@ proc QuotaDelete {fileName {delete 1}} {
 		# Check each quota to see if current file contributes to it:
 		foreach item $items {
 		 	regexp {([0-9]*),(.*)} $item trash groupCount item
-			if ![info exists fs($item)] {array set fs [file attributes $file] ; set stat($file) [array get fs]}
+			if ![info exists fs($item)] {if [file exists $file] {array set fs [file attributes $file]} ; set stat($file) [array get fs]}
 			if ![info exists fs($item)] {continue}
 			set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]]
 			if $contrib	{
diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl
index 7f64113..386df88 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.5
+Version 1.5.1
 
 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
@@ -54,7 +54,7 @@ set vfs::posix(load) x
 vfs::posixError load
 unset vfs::posix(load)
 
-package provide vfs::template 1.5
+package provide vfs::template 1.5.1
 
 namespace eval ::vfs::template {
 
diff --git a/library/template/versionvfs.tcl b/library/template/versionvfs.tcl
index fb6bb5f..aff036c 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.5
+Version 1.5.1
 
 A versioning virtual filesystem.  Requires the template vfs in templatevfs.tcl.
 
@@ -221,12 +221,15 @@ proc file_delete {file} {
 proc file_executable {file} {
 	upvar path path root root relative relative
 	set fileName [VAcquireFile $path $root $relative]
+	if ![string first .&dir [file tail $fileName]] {return 0}
 	file executable $fileName
 }
 proc file_exists {file} {
 	upvar path path root root relative relative
 	set fileName [VAcquireFile $path $root $relative]
-	file exists $fileName
+	if ![string first .&dir [file tail $fileName]] {return 0}
+	if [file isdirectory $fileName] {return 1}
+	expr ![string equal [file join $path $relative] $fileName]
 }
 proc file_mkdir {file} {
 	upvar root root
@@ -242,6 +245,7 @@ proc file_mkdir {file} {
 proc file_readable {file} {
 	upvar path path root root relative relative
 	set fileName [VAcquireFile $path $root $relative]
+	if ![string first .&dir [file tail $fileName]] {return 0}
 	file readable $fileName
 }
 proc file_stat {file array} {
@@ -258,6 +262,7 @@ proc file_stat {file array} {
 proc file_writable {file} {
 	upvar path path root root relative relative
 	set fileName [VAcquireFile $path $root $relative]
+	if ![string first .&dir [file tail $fileName]] {return 0}
 	file writable $fileName
 }
 proc glob_ {directory dir nocomplain tails types typeString dashes pattern} {