TclVFS

Check-in [5cb781db78]
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:2010-01-30 Steve Huntley <[email protected]> * templatevfs.tcl: workaround for bug in how virtual volumes are mounted. Version bumped to 1.5.4. See: http://sf.net/tracker/?func=detail&aid=2886914&group_id=10894&atid=110894
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5cb781db78c8f69477d25b30fc02f937138efdbd
User & Date: blacksqr 2010-01-30 08:22:24
Context
2010-02-01
07:32
2010-02-01 Steve Huntley <[email protected]> * Makefile.in (PKG_TCL_SOURCES): Added 'template/tclIndex' to the list of installed files. Required for vfs's based on template vfs to load. check-in: 82ff64e534 user: blacksqr tags: trunk
2010-01-30
08:22
2010-01-30 Steve Huntley <[email protected]> * templatevfs.tcl: workaround for bug in how virtual volumes are mounted. Version bumped to 1.5.4. See: http://sf.net/tracker/?func=detail&aid=2886914&group_id=10894&atid=110894 check-in: 5cb781db78 user: blacksqr tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 







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






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.

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.

>
>
>
>
>
>
|





|








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

2010-01-30  Steve Huntley  <[email protected]>

	* templatevfs.tcl: workaround for bug in how virtual volumes
	are mounted. Version bumped to 1.5.4.  See:
http://sf.net/tracker/?func=detail&aid=2886914&group_id=10894&atid=110894

2009-10-20  Steve Huntley  <[email protected]>

	* tclIndex: Corrected version number.
	* pkgIndex.tcl.in: Edited to replace function of deleted 
	pkgIndex.tcl in template subdir.

2009-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.

Changes to library/template/templatevfs.tcl. 

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
...
181
182
183
184
185
186
187






188
189
190
191
192
193
194
195
196
197
198
199
200
201

202

203
204
205
206
207
208
209
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

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

templatevfs.tcl --

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

The template virtual filesystem is designed as a prototype on which to build new virtual 
filesystems.  Only a few simple, abstract procedures have to be overridden to produce a new
vfs, requiring no knowledge of the Tclvfs API. 

In addition, several behind-the-scenes functions are provided to make new vfs's more stable and
scalable, including file information caching and management of close callback errors. 
................................................................................
package require vfs 1.0

# force sourcing of vfsUtils.tcl: 
set vfs::posix(load) x
vfs::posixError load
unset vfs::posix(load)

package provide vfs::template 1.5.3

namespace eval ::vfs::template {

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

In order to create a new virtual filesystem:
................................................................................
	if {[lsearch [::vfs::filesystem info] $to] != -1} {::vfs::filesystem unmount $to}
	array unset ::vfs::_unmountCmd $to

# set file info cache dwell time value:
	set [namespace current]::cache($to) $cache

# register location with Tclvfs package:






	eval ::vfs::filesystem mount $volume \$to \[list [namespace current]::handler \$path\]
	::vfs::RegisterMount $to [list [namespace current]::unmount]

# ensure close callback background error appears at script execution level:
	trace remove execution ::close leave ::vfs::template::CloseTrace
	trace remove execution ::file leave ::vfs::template::FileTrace
	trace add execution ::close leave vfs::template::CloseTrace
	trace add execution ::file leave vfs::template::FileTrace

	return $to
}

# undo Tclvfs API hooks:
proc unmount {to} {

	set to [::file normalize $to]

	set path [lindex [::vfs::filesystem info $to] end]

# call custom unmount procedure:
	set ::vfs::template::vfs_retrieve 1
	UnmountProcedure $path $to
	unset -nocomplain ::vfs::template::vfs_retrieve

................................................................................
# end namespace eval ::vfs::template

# overload exit command so that all vfs's are explicitly 
# unmounted before program termination:
 
catch {rename ::exit ::vfs::template::exit}

proc ::exit {} {
	foreach vfs [::vfs::filesystem info] {
		if [catch {$::vfs::_unmountCmd($vfs) $vfs} result] {
			puts "$vfs: $result"
		}		
	}
	::vfs::template::exit
}








|







 







|







 







>
>
>
>
>
>
|













>
|
>







 







|

|



|



3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581

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

templatevfs.tcl --

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

The template virtual filesystem is designed as a prototype on which to build new virtual 
filesystems.  Only a few simple, abstract procedures have to be overridden to produce a new
vfs, requiring no knowledge of the Tclvfs API. 

In addition, several behind-the-scenes functions are provided to make new vfs's more stable and
scalable, including file information caching and management of close callback errors. 
................................................................................
package require vfs 1.0

# force sourcing of vfsUtils.tcl: 
set vfs::posix(load) x
vfs::posixError load
unset vfs::posix(load)

package provide vfs::template 1.5.4

namespace eval ::vfs::template {

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

In order to create a new virtual filesystem:
................................................................................
	if {[lsearch [::vfs::filesystem info] $to] != -1} {::vfs::filesystem unmount $to}
	array unset ::vfs::_unmountCmd $to

# set file info cache dwell time value:
	set [namespace current]::cache($to) $cache

# register location with Tclvfs package:
	set div {}
	if {$volume ne {}} {
		if {[string index $to end] ne "/"} {
			set div /
		}
	}
	eval ::vfs::filesystem mount $volume \$to$div \[list [namespace current]::handler \$path\]
	::vfs::RegisterMount $to [list [namespace current]::unmount]

# ensure close callback background error appears at script execution level:
	trace remove execution ::close leave ::vfs::template::CloseTrace
	trace remove execution ::file leave ::vfs::template::FileTrace
	trace add execution ::close leave vfs::template::CloseTrace
	trace add execution ::file leave vfs::template::FileTrace

	return $to
}

# undo Tclvfs API hooks:
proc unmount {to} {
	if {[lsearch [::vfs::filesystem info] $to] < 0} {
		set to [::file normalize $to]
	}
	set path [lindex [::vfs::filesystem info $to] end]

# call custom unmount procedure:
	set ::vfs::template::vfs_retrieve 1
	UnmountProcedure $path $to
	unset -nocomplain ::vfs::template::vfs_retrieve

................................................................................
# end namespace eval ::vfs::template

# overload exit command so that all vfs's are explicitly 
# unmounted before program termination:
 
catch {rename ::exit ::vfs::template::exit}

proc ::exit {args} {
	foreach vfs [::vfs::filesystem info] {
		if [catch {$::vfs::_unmountCmd([file normalize $vfs]) $vfs} result] {
			puts "$vfs: $result"
		}		
	}
	::vfs::template::exit [lindex $args 0]
}

Changes to pkgIndex.tcl.in. 

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

package ifneeded vfs::tk      0.5 [list source [file join $dir tkvfs.tcl]]
#
# Virtual filesystems based on the template vfs:
#
if {[lsearch -exact $::auto_path [file join $dir template]] == -1} {
    lappend ::auto_path [file join $dir template]
}
package ifneeded vfs::template 1.5.3 \
    [list source [file join $dir template templatevfs.tcl]]
#
# Helpers
#
package ifneeded fileutil::globfind 1.5 \
    [list source [file join $dir template globfind.tcl]]
package ifneeded trsync 1.0 [list source [file join $dir template tdelta.tcl]]







|








31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

package ifneeded vfs::tk      0.5 [list source [file join $dir tkvfs.tcl]]
#
# Virtual filesystems based on the template vfs:
#
if {[lsearch -exact $::auto_path [file join $dir template]] == -1} {
    lappend ::auto_path [file join $dir template]
}
package ifneeded vfs::template 1.5.4 \
    [list source [file join $dir template templatevfs.tcl]]
#
# Helpers
#
package ifneeded fileutil::globfind 1.5 \
    [list source [file join $dir template globfind.tcl]]
package ifneeded trsync 1.0 [list source [file join $dir template tdelta.tcl]]

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