From: Steve Huntley <stephen.huntley@alum.mit.edu>
Date: Fri, 16 Oct 2009 05:40:13 +0000 (+0000)
Subject: 2008-10-15  Steve Huntley  <stephen.huntley@alum.mit.edu>
X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=d8930b040799cd5f4f3df744eb6a6a4798dd8332;p=tclvfs

2008-10-15  Steve Huntley  <stephen.huntley@alum.mit.edu>

	vfs::template package update ver. 1.5.3:

	* templatevfs.tcl: Incorporated AK's fix below.
	* collatevfs.tcl: ensured binary file contents got written
	correctly, and ensured that not only file contents but
	also file attributes were updated to all write targets.
---

diff --git a/ChangeLog b/ChangeLog
index 7192e3e..7ffceaf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2008-10-15  Steve Huntley  <stephen.huntley@alum.mit.edu>
+
+	vfs::template package update ver. 1.5.3:
+
+	* templatevfs.tcl: Incorporated AK's fix below.
+	* collatevfs.tcl: ensured binary file contents got written
+	correctly, and ensured that not only file contents but 
+	also file attributes were updated to all write targets.
+
 2009-07-06  Andreas Kupries  <andreask@activestate.com>
 
 	* library/template/templatevfs.tcl (memchan): Fix result for
diff --git a/library/template/collatevfs.tcl b/library/template/collatevfs.tcl
index 45616bb..770f11e 100644
--- a/library/template/collatevfs.tcl
+++ b/library/template/collatevfs.tcl
@@ -5,7 +5,7 @@ collatevfs.tcl --
 
 Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
 License: Tcl license
-Version 1.5
+Version 1.5.3
 
 A collate/broadcast/collect/catchup virtual filesystem.  Requires the template vfs in templatevfs.tcl.
 
@@ -78,7 +78,6 @@ mount -read C:/install/package/images FTP:/pub/releases/package/images -collect
 }
 
 package require vfs::template 1.5
-package provide vfs::template::collate 1.5.2
 
 namespace eval ::vfs::template::collate {
 
@@ -93,7 +92,10 @@ foreach templateProc [namespace eval ::vfs::template {info procs}] {
 proc close_ {channel} {
 	upvar root root relative relative
 	foreach file [lrange [WriteFile $root $relative close] 1 end] {
+		if ![WriteTest $file] {continue}
+		file mkdir [file dirname $file]
 		set f [open $file w]
+		fconfigure $f -translation binary
 		seek $channel 0
 		fcopy $channel $f
 		close $f
@@ -102,17 +104,18 @@ proc close_ {channel} {
 }
 proc file_atime {file time} {
 	upvar root root relative relative
-	set file [AcquireFile $root $relative]
-	file atime $file $time
+	foreach file [WriteFile $root $relative open] {
+		file atime $file $time
+	}
 }
 proc file_mtime {file time} {
 	upvar root root relative relative
-	set file [AcquireFile $root $relative]
-	file mtime $file $time
+	foreach file [WriteFile $root $relative open] {
+		file mtime $file $time
+	}
 }
 proc file_attributes {file {attribute {}} args} {
 	upvar root root relative relative
-	set file [AcquireFile $root $relative]
 	if {($relative == {}) && ([string map {-read 1 -write 1 -collect 1 -catchup 1} $attribute] == 1)} {
 		set attribute [string range $attribute 1 end]
 		if {$args == {}} {eval return \$::vfs::template::collate::${attribute}(\$root)}
@@ -120,6 +123,13 @@ proc file_attributes {file {attribute {}} args} {
 		set ::vfs::template::collate::catchup [file isdirectory [lindex $::vfs::template::collate::catchupstore 0]]
 		return
 	}
+	if {$args != {}} {
+		foreach file [WriteFile $root $relative open] {
+			file attributes $file $attribute $args
+		}
+		return
+	}
+	set file [AcquireFile $root $relative]
 	set returnValue [eval file attributes \$file $attribute $args]
 	if {($relative == {}) && ($attribute == {})} {set returnValue [concat $returnValue [list -read $::vfs::template::collate::read($root) -write $::vfs::template::collate::write($root) -collect $::vfs::template::collate::collect($root) -catchup $::vfs::template::collate::catchupstore($root)]]}
 	return $returnValue
@@ -353,5 +363,9 @@ proc WriteFile {root relative action} {
 	return $returnValue
 }
 
+proc WriteTest {args} {
+	return 1
+}
+
 }
 # end namespace ::vfs::template::collate
diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl
index ccd04c5..d0aee64 100644
--- a/library/template/templatevfs.tcl
+++ b/library/template/templatevfs.tcl
@@ -550,7 +550,7 @@ proc memchan {args} {
 		set chan [uplevel 1 ::memchan $args]
 		return $chan
 	} else {
-	    return [eval [linsert $args 0 ::vfs::memchan]]
+		return [eval [linsert $args 0 ::vfs::memchan]]
 	}
 }