TclVFS

2008-10-15  Steve Huntley  <[email protected]>

	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  <[email protected]>

	* library/template/templatevfs.tcl (memchan): Fix result for
	* pkgIndex.tcl: unix. The bug was reported on the wiki. The fix
	  there was wrong, did improper handling of the $args argument.
	  Fixed here. Version bumped to 1.5.3.

if 0 {
########################

collatevfs.tcl --

Written by Stephen Huntley ([email protected])
License: Tcl license
Version 1.5.3

A collate/broadcast/collect/catchup virtual filesystem.  Requires the template vfs in templatevfs.tcl.

Collate: reads from multiple specified directories and presents the results as one at the mount location.

Broadcast: applies all writes in the mount location to multiple specified directories.

mount -read C:/install/package/images FTP:/pub/releases/package/images -collect C:/install/package/images C:/collate/images


########################
}

package require vfs::template 1.5


namespace eval ::vfs::template::collate {

# read template procedures into current namespace. Do not edit:
foreach templateProc [namespace eval ::vfs::template {info procs}] {
	set infoArgs [info args ::vfs::template::$templateProc]
	set infoBody [info body ::vfs::template::$templateProc]
	proc $templateProc $infoArgs $infoBody
}

# edit following procedures:
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
	}
	return
}
proc file_atime {file time} {
	upvar root root relative relative
	foreach file [WriteFile $root $relative open] {
		file atime $file $time
	}
}
proc file_mtime {file time} {
	upvar root root relative relative
	foreach file [WriteFile $root $relative open] {
		file mtime $file $time
	}
}
proc file_attributes {file {attribute {}} args} {
	upvar root root relative 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)}
		set ::vfs::template::collate::${attribute}($root) [lindex $args 0]
		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
}
proc file_delete {file} {
	upvar root root relative relative
	foreach file [WriteFile $root $relative delete] {

				}
			} result]
			unset ::vfs::template::vfs_retrieve
		}
	}
	return $returnValue
}

proc WriteTest {args} {
	return 1
}

}
# end namespace ::vfs::template::collate

# workaround for bug in tclkit:
proc memchan {args} {
	if {$::tcl_platform(platform) == "windows"} {
		package require Memchan
		set chan [uplevel 1 ::memchan $args]
		return $chan
	} else {
		return [eval [linsert $args 0 ::vfs::memchan]]
	}
}

}
# end namespace eval ::vfs::template

# overload exit command so that all vfs's are explicitly