From d8930b040799cd5f4f3df744eb6a6a4798dd8332 Mon Sep 17 00:00:00 2001 From: Steve Huntley Date: Fri, 16 Oct 2009 05:40:13 +0000 Subject: [PATCH] 2008-10-15 Steve Huntley 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. --- ChangeLog | 9 +++++++++ library/template/collatevfs.tcl | 28 +++++++++++++++++++++------- library/template/templatevfs.tcl | 2 +- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7192e3e..7ffceaf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2008-10-15 Steve Huntley + + 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 * 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]] } } -- 2.23.0