[SEH] A versioning virtual filesystem.

First untested rough draft.

Usage: Mount <existing directory> <virtual versioning directory>

Similar to historical versioning filesystems, each edited version of a file is saved separately;
each version file is tagged with a timestamp.  A tag is a semi-colon and tag info appended to the file name.
A deleted file is represented by a new zero-length file with timestamp and a tag reading "deleted".
By default only the latest versions of files are visible.  If the latest version is marked deleted, it is invisible.
Choice of the visible version can be customized in the VersionSort procedure.
All versions can be accessed simply by looking into the existing directory used in the Mount command.

Based on [A template virtual filesystem]

 package require vfs 1

 namespace eval ::vfs::template::version {}

 proc ::vfs::template::version::Mount {args} {
	set pathto [eval MountProcedure $args]
	set path [lindex $pathto 0]
	set to [lindex $pathto 1]
	::vfs::filesystem mount $to [list ::vfs::template::version::handler $path]
	::vfs::RegisterMount $to [list ::vfs::template::version::Unmount]
	return $to
 }

 proc ::vfs::template::version::Unmount {to} {
	set path [lindex [::vfs::filesystem info $to] end]
	UnmountProcedure $path $to
	::vfs::filesystem unmount $to
 }

 proc ::vfs::template::version::handler {path cmd root relative actualpath args} {
	switch -- $cmd {
		access {
			set mode [lindex $args 0]
			set error [catch {Access $path $root $relative $actualpath $mode}]
			if $error {vfs::filesystem posixerror $::vfs::posix(EACCES) ; return -code error $::vfs::posix(EACCES)}
		}
		createdirectory {
			CreateDirectory $path $root $relative $actualpath
		}
		deletefile {
			DeleteFile $path $root $relative $actualpath
		}
		fileattributes {
			set index [lindex $args 0]
			set value [lindex $args 1]
			array set attributes [FileAttributes $path $root $relative $actualpath]
			if {$index == {}} {
				return [lsort [array names attributes]]
			}
			set attribute [lindex [lsort [array names attributes]] $index]
			if {$value == {}} {
				return $attributes($attribute)
			}
			FileAttributesSet $path $root $relative $actualpath $attribute $value
		}
		matchindirectory {
			set pattern [lindex $args 0]
			set types [lindex $args 1]
			return [MatchInDirectory $path $root $relative $actualpath $pattern $types]
		} open {
			set mode [lindex $args 0]
			if {$mode == {}} {set mode r}
			set permissions [lindex $args 1]
			set channelID [Open $path $root $relative $actualpath $mode $permissions]
			switch -glob -- $mode {
				"" -
				"r*" -
				"w*" {
					seek $channelID 0
				}
				"a*" {
	    				seek $channelID 0 end
				}
				default {
					::vfs::filesystem posixerror $::vfs::posix(EINVAL)
					return -code error $::vfs::posix(EINVAL)
				}
			}
			set result $channelID
			lappend result [list ::vfs::template::version::Close $channelID $path $root $relative $actualpath $mode]
			return $result
		}
		removedirectory {
			set recursive [lindex $args 0]
			if !$recursive {
				if {[MatchInDirectory $path $root $relative $actualpath * 0] != {}} {
					::vfs::filesystem posixerror $::vfs::posix(EEXIST)
					return -code error $::vfs::posix(EEXIST)
				}
			}
			RemoveDirectory $path $root $relative $actualpath
		}
		stat {
			return [Stat $path $root $relative $actualpath]
		}
		utime {
			set atime [lindex $args 0]
			set mtime [lindex $args 1]
			Utime $path $root $relative $actualpath $atime $mtime
		}
	}
 }

 namespace eval ::vfs::template::version {

 proc MountProcedure {args} {
	set path [lindex $args 0]
	set to [lindex $args 1]
	if {![catch {vfs::filesystem info $to}]} {
		# unmount old mount
		Unmount $to
	}


	file mkdir $path

	lappend pathto $path
	lappend pathto $to
	return $pathto
 }

 proc UnmountProcedure {path to} {
	return
 }

 proc Access {path root relative actualpath mode} {
	set modeString [::vfs::accessMode $mode]
	if {$modeString == "F"} {set modeString RWX}
	set modeString [split $modeString {}]
	set fileName [VAcquireFile $path $root $relative $actualpath]
	if [file readable $fileName] {lappend fileString R}
	if [file writable $fileName] {lappend fileString W}
	if [file executable $fileName] {lappend fileString X}
	foreach mS $modeString {
		set errorMessage "not [string map {R readable W writable X executable} $mS]"
		if {[lsearch $fileString $mS] == -1} {error $errorMessage}
	}
 }

 proc CreateDirectory {path root relative actualpath} {
	file mkdir [file join $path $relative]
 }

 proc DeleteFile {path root relative actualpath} {
	set fileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag]\;deleted
	close [open $fileName w]
 }

 proc FileAttributes {path root relative actualpath} {
	set fileName [VAcquireFile $path $root $relative $actualpath]
	file attributes $fileName
 }

 proc FileAttributesSet {path root relative actualpath attribute value} {
	set fileName [VAcquireFile $path $root $relative $actualpath]
	set newFileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag]
	file copy $fileName $newFileName
	file attributes $newFileName $attribute $value
 }

 proc MatchInDirectory {path root relative actualpath pattern types} {
	if [::vfs::matchDirectories $types] {lappend typeString d}
	if [::vfs::matchFiles $types] {lappend typeString f}
	
	set globList [glob -directory [file join $path $relative] -nocomplain -types $typeString *]
	set pathLength [expr [string length $path] - 1]
	set newGlobList {}
	foreach gL $globList {
		if [file isfile $gL] {
			if {[lindex [split [file tail $gL] \;] 2] == "deleted"} {continue}
			set gL [VFileNameDecode $gL]
		}
		set gL [string replace $gL 0 $pathLength $root]
		if [string match $pattern [file tail $gL]] {lappend newGlobList $gL}
	}
	return [lsort -unique $newGlobList]
 }

 proc Open {path root relative actualpath mode permissions} {
	set fileName [VAcquireFile $path $root $relative $actualpath]
	if {$fileName == [file join $path $relative]} {
		set fileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag]
		set channelID [open $fileName $mode]
		catch {file attributes $fileName -permissions $permissions}
		return $channelID
	}
	set f [open $fileName r]
	fconfigure $f -translation binary
	set filed [vfs::memchan]
	fconfigure $filed -translation binary
	fcopy $f $filed
	close $f
	fconfigure $filed -translation auto
	seek $filed 0
	return $filed
 }

 proc Close {channelID path root relative actualpath mode} {
 # Do not close the channel in the close callback!
 # It will crash Tcl!  Honest!
 # The core will close the channel after you've taken what info you need from it.

 #	close $channelID
	if {$mode == "r"} {return}
	set fileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag]
	set f [open $fileName w]
	fconfigure $f -translation binary
	fconfigure $channelID -translation binary
	seek $channelID 0
	fcopy $channelID $f
	close $f
	return
 }

 proc RemoveDirectory {path root relative actualpath} {
	file delete -force [file join $path $relative]
 }

 proc Stat {path root relative actualpath} {
	set fileName [VAcquireFile $path $root $relative $actualpath]
	file stat $fileName fs
	return [array get $fs]
 }

 proc Utime {path root relative actualpath atime mtime} {
	set fileName [VAcquireFile $path $root $relative $actualpath]
	set newFileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag]
	file copy $fileName $newFileName
	file atime $newFileName $atime
	file mtime $newFileName $mtime
 }

 proc VCreateTag {} {
	return [clock seconds][string range [clock clicks -milliseconds] end-2 end]
 }

 proc VAcquireFile {path root relative actualpath} {
	if [file isdirectory [file join $path $relative]] {return [file join $path $relative]}
	set fileName [VFileNameEncode [file join $path $relative]]
	set versions [glob -path $fileName -nocomplain -types f "\;*"]
	if {$versions == {}} {return [file join $path $relative]}
	foreach ver $versions {
		set ver [file tail $ver]
		lappend versionFiles $ver
	}
	unset versions
	set fileName $path/[lindex [lsort -command VersionSort $versionFiles] 0]
	if {[lindex [split [file tail $fileName] \;] 2] == "deleted"} {return [file join $path $relative]}
 }

 proc VersionSort {element1 element2} {
	if {$element1 == $element2} {return 0}
	set sorted [lsort -dictionary "$element1 $element2"]
	if {[lindex $sorted 0] == $element1} {return -1}
	if {[lindex $sorted 0] == $element2} {return 1}
 }

 proc VFileNameEncode {filename} {
	set filename [file dirname $filename]/[string map {& &a} [file tail $filename]]
	set filename [file dirname $filename]/[string map {; &s} [file tail $filename]]
 }

 proc VFileNameDecode {filename} {
	set filename [file dirname $filename]/[lindex [split [file tail $filename] \;] 0]
	set filename [file dirname $filename]/[string map {&s ;} [file tail $filename]]
	set filename [file dirname $filename]/[string map {&a &} [file tail $filename]]
 }

 }
 # end namespace eval vfs::template::version
----
'''Wow!''' -[jcw]

Word - [CMcC]

''[escargo] 17 Jul 2004'' - I remember using the Digital Equipment Corporation's VMS
operating system, which had a feature for saving multiple versions of files.  You could
set a limit on how many past versions you wanted retained, so that there would be some
bounds on how much disk space you consumed.  It might be worthwhile digging into old
VMS manuals to see if there are utility functions related to versioned files that are
worth implementing.  The first that comes to mind would be '''purge''', where only
current versions of files are retained.

''[GWL] 18 Jul 2004'' - Actually the purge command took an argument specifing how many versions to keep (/keep=N if my memory is working), the default was just one.

''[escargo] 18 Jul 2004'' - It's that kind of detail from 15 years ago that made me
suggest going to the manuals.  Being able to set the limit on how many versions to keep
would also be a good thing. 

----

''[wcf3] 18 Jul 2004'' - I found a problem using ''glob'' while running on linux that I fixed by removing the ''file tail'' from the call to '''VFileNameDecode''' in the procedure '''MatchInDirectory'''. Everything worked great after that! I didn't want to alter the source until after I've had a chance to test it a bit more.

[SEH] I fixed the problem in the call to '''VFileNameDecode''' in '''MatchInDirectory'''.  Thanks for the catch.
----

[Category VFS]