TclVFS

Check-in [ff8d467939]
Login
Core Home Timeline Branches Tags Tickets Wiki
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: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.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ff8d467939292856649449665a88ec97ea5e24d3
User & Date: blacksqr 2009-10-16 05:40:13
Context
2009-10-20
08:16
2008-10-20 Steve Huntley <[email protected]> * tclIndex: Corrected version number. * pkgIndex.tcl.in: Edited to replace function of deleted pkgIndex.tcl in template subdir. check-in: b1ee541d05 user: blacksqr tags: trunk
2009-10-16
05:40
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. check-in: ff8d467939 user: blacksqr tags: trunk
2009-07-06
17:00
* 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. check-in: 3654e5e1d0 user: andreas_kupries tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 










1
2
3
4
5
6
7









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.


>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

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.

Changes to library/template/collatevfs.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
..
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
..
89
90
91
92
93
94
95


96

97
98
99
100
101
102
103
104
105
106

107
108
109
110
111

112
113
114
115
116
117
118
119
120
121
122







123
124
125
126
127
128
129
...
348
349
350
351
352
353
354




355
356
357

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

collatevfs.tcl --

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

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
package provide vfs::template::collate 1.5.2

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] {


		set f [open $file w]

		seek $channel 0
		fcopy $channel $f
		close $f
	}
	return
}
proc file_atime {file time} {
	upvar root root relative relative
	set file [AcquireFile $root $relative]
	file atime $file $time

}
proc file_mtime {file time} {
	upvar root root relative relative
	set file [AcquireFile $root $relative]
	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)}
		set ::vfs::template::collate::${attribute}($root) [lindex $args 0]
		set ::vfs::template::collate::catchup [file isdirectory [lindex $::vfs::template::collate::catchupstore 0]]
		return
	}







	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
}





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







|







 







<







 







>
>

>








|
|
>



|
|
>



<







>
>
>
>
>
>
>







 







>
>
>
>




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
..
74
75
76
77
78
79
80

81
82
83
84
85
86
87
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
...
358
359
360
361
362
363
364
365
366
367
368
369
370
371

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

Changes to library/template/templatevfs.tcl. 

546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

# 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 







|








546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

# 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

This page was generated in about 0.012s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14