From 4174223e2680d307ca9825fd006a4ea696fdd3da Mon Sep 17 00:00:00 2001
From: Vince Darley <vincentdarley@sourceforge.net>
Date: Tue, 28 Jan 2003 12:38:57 +0000
Subject: [PATCH] vfs library organisation
---
ChangeLog | 25 ++++++++++++++
DESCRIPTION.txt | 19 ++++++++++
examples/simpleExamples.tcl | 9 +++++
library/ftpvfs.tcl | 2 ++
library/httpvfs.tcl | 4 ++-
library/mk4vfs.tcl | 6 ++--
library/pkgIndex.tcl | 16 +++++++--
library/tarvfs.tcl | 2 +-
library/tclprocvfs.tcl | 2 ++
library/testvfs.tcl | 2 ++
library/vfsUrl.tcl | 7 +++-
library/webdavvfs.tcl | 2 ++
library/zipvfs.tcl | 2 ++
make55.tcl | 69 +++++++++++++++++++++++++++++++++++++
14 files changed, 159 insertions(+), 8 deletions(-)
create mode 100644 DESCRIPTION.txt
create mode 100644 make55.tcl
diff --git a/ChangeLog b/ChangeLog
index 2d9d9ec..c5223b7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,28 @@
+2003-01-28 Vince Darley <vincentdarley@sourceforge.net>
+ * library/*.tcl: add 'package provide vfs::<name>' to the
+ virtual filesystems. These are the current versions:
+
+ package ifneeded vfs::ftp 1.0
+ package ifneeded vfs::http 0.5
+ package ifneeded vfs::mk4 1.6
+ package ifneeded vfs::ns 0.5
+ package ifneeded vfs::tar 0.9
+ package ifneeded vfs::test 1.0
+ package ifneeded vfs::urltype 1.0
+ package ifneeded vfs::webdav 0.1
+ package ifneeded vfs::zip 1.0
+
+ I've used '0.1' to indicate a very preliminary version, 0.5 for
+ something which has had some work, 0.9 for nearly complete and
+ 1.0 or newer for something which is well used.
+
+ There is no need to do 'package require vfs', simply do a package
+ require of the particular vfs implementation you want from the
+ above list.
+
+ * DESCRIPTION.txt:
+ * make55.tcl: new files for TIP55 compliance. (Steve Cassidy)
+
2003-01-16 Vince Darley <vincentdarley@sourceforge.net>
* library/tarvfs.tcl:
* library/zipvfs.tcl: ::close .zip or .tar file when unmounting
diff --git a/DESCRIPTION.txt b/DESCRIPTION.txt
new file mode 100644
index 0000000..e2010af
--- /dev/null
+++ b/DESCRIPTION.txt
@@ -0,0 +1,19 @@
+Identifier: vfs
+Version: 1.0
+Title: Interface to Virtual File Systems for Tcl 8.4
+Creator: Vince Darley
+Description: The goal of this extension is to expose Tcl 8.4's new
+ filesystem C API to the Tcl level.
+Rights: BSD
+URL: http://sourceforge.net/projects/tclvfs
+Date: 2002-05-25
+Architecture: tcl
+Architecture: Linux-x86
+Require: tcl 8.4
+Recommend: Trf
+Recommend: http 2.6
+Recommend: base64
+Recommend: Memchan
+Recommend: Mk4tcl
+Recommend: ftp
+Subject: filesystem
diff --git a/examples/simpleExamples.tcl b/examples/simpleExamples.tcl
index ed03368..f75f755 100644
--- a/examples/simpleExamples.tcl
+++ b/examples/simpleExamples.tcl
@@ -9,6 +9,11 @@ puts "(pwd is '[pwd]', file volumes is '[file volumes]')"
package require vfs
+package require vfs::zip
+package require vfs::urltype
+package require vfs::ftp
+package require vfs::http
+
puts "Adding ftp:// volume..."
vfs::urltype::Mount ftp
set listing [glob -dir ftp://ftp.scriptics.com/pub *]
@@ -32,6 +37,10 @@ vfs::ftp::Mount ftp://ftp.ucsd.edu/pub/alpha/ localmount
cd localmount ; cd tcl
puts "(pwd is now '[pwd]' which is effectively a transparent link\
to a remote ftp site)"
+puts "Contents of remote directory is:"
+foreach file [glob -nocomplain *] {
+ puts "\t$file"
+}
puts "sourcing remote file 'vfsTest.tcl', using 'source vfsTest.tcl'"
# This will actually source the contents of a file on the
# remote ftp site (which is now the 'pwd').
diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 80d55df..8250573 100644
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::ftp 1.0
+
package require vfs 1.0
package require ftp
diff --git a/library/httpvfs.tcl b/library/httpvfs.tcl
index 972a0f9..061f8c4 100644
--- a/library/httpvfs.tcl
+++ b/library/httpvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::http 0.5
+
package require vfs 1.0
package require http
@@ -129,7 +131,7 @@ proc vfs::http::matchindirectory {dirurl path actualpath pattern type} {
} else {
# single file
- if {![catch {access $dirurl $path}]} {
+ if {![catch {access $dirurl $path 0}]} {
lappend res $path
}
}
diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 65843b8..873dcf8 100644
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -12,6 +12,7 @@
# 16oct02 jcw 1.6 fixed periodic commit once a change is made
package provide mk4vfs 1.6
+package provide vfs::mk4 1.6
package require Mk4tcl
package require vfs
@@ -45,7 +46,8 @@ namespace eval vfs::mk4 {
}
proc handler {db cmd root relative actualpath args} {
- #puts stderr "handler: $db - $cmd - $root - $relative - $actualpath - $args"
+ #puts stderr "handler: $db - $cmd - $root - $relative\
+ #- $actualpath - $args"
if {$cmd == "matchindirectory"} {
eval [list $cmd $db $relative $actualpath] $args
} elseif {$cmd == "fileattributes"} {
@@ -288,7 +290,7 @@ namespace eval mk4vfs {
proc umount {local} {
foreach {db path} [mk::file open] {
if {[string equal $local $path]} {
- uplevel ::vfs::mk4::Unmount $db $local
+ uplevel 1 [list ::vfs::mk4::Unmount $db $local]
return
}
}
diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl
index 0c81802..66a25c4 100644
--- a/library/pkgIndex.tcl
+++ b/library/pkgIndex.tcl
@@ -37,10 +37,20 @@ proc loadvfs {dll} {
}
package ifneeded vfs 1.0 [list loadvfs $dll]
-
-package ifneeded mk4vfs 1.6 [list source [file join $dir mk4vfs.tcl]]
package ifneeded starkit 1.0 [list source [file join $dir starkit.tcl]]
package ifneeded vfslib 1.3 [list source [file join $dir vfslib.tcl]]
-package ifneeded tarvfs 0.1 [list source [file join $dir tarvfs.tcl]]
+# Old
+package ifneeded mk4vfs 1.6 [list source [file join $dir mk4vfs.tcl]]
package ifneeded zipvfs 1.0 [list source [file join $dir zipvfs.tcl]]
+
+# New
+package ifneeded vfs::ftp 1.0 [list source [file join $dir ftpvfs.tcl]]
+package ifneeded vfs::http 0.5 [list source [file join $dir httpvfs.tcl]]
+package ifneeded vfs::mk4 1.6 [list source [file join $dir mk4vfs.tcl]]
+package ifneeded vfs::ns 0.5 [list source [file join $dir tclprocvfs.tcl]]
+package ifneeded vfs::tar 0.9 [list source [file join $dir tarvfs.tcl]]
+package ifneeded vfs::test 1.0 [list source [file join $dir testvfs.tcl]]
+package ifneeded vfs::urltype 1.0 [list source [file join $dir vfsUrl.tcl]]
+package ifneeded vfs::webdav 0.1 [list source [file join $dir webdavvfs.tcl]]
+package ifneeded vfs::zip 1.0 [list source [file join $dir zipvfs.tcl]]
diff --git a/library/tarvfs.tcl b/library/tarvfs.tcl
index 2a027e6..cba6b20 100644
--- a/library/tarvfs.tcl
+++ b/library/tarvfs.tcl
@@ -15,7 +15,7 @@
################################################################################
package require vfs
-package provide tarvfs 0.1
+package provide vfs::tar 0.9
# Using the vfs, memchan and Trf extensions, we're able
# to write a Tcl-only tar filesystem.
diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index cbb4e4d..9075212 100644
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::ns 0.5
+
package require vfs 1.0
# Thanks to jcw for the idea here. This is a 'file system' which
diff --git a/library/testvfs.tcl b/library/testvfs.tcl
index adf13c7..0758a8f 100644
--- a/library/testvfs.tcl
+++ b/library/testvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::test 1.0
+
package require vfs 1.0
namespace eval vfs::test {}
diff --git a/library/vfsUrl.tcl b/library/vfsUrl.tcl
index 68f9c33..0e2cc08 100644
--- a/library/vfsUrl.tcl
+++ b/library/vfsUrl.tcl
@@ -14,6 +14,9 @@
#
# % file copy ftp://ftp.ucsd.edu/pub/alpha/Readme .
+package provide vfs::urltype 1.0
+package require vfs
+
namespace eval ::vfs::urltype {}
proc vfs::urltype::Mount {type} {
@@ -41,8 +44,10 @@ proc vfs::urltype::handler {type cmd root relative actualpath args} {
# Find the highest level path so we can mount it:
set pathSplit [file split [file join $root $relative]]
set newRoot [eval [list file join] [lrange $pathSplit 0 1]]
- # Mount it.
::vfs::log [list $newRoot $pathSplit]
+ # Get the package we will need
+ ::package require vfs::${type}
+ # Mount it.
::vfs::${type}::Mount $newRoot $newRoot
# Now we want to find out the right handler
set typeHandler [::vfs::filesystem info $newRoot]
diff --git a/library/webdavvfs.tcl b/library/webdavvfs.tcl
index 0106def..cce1f93 100644
--- a/library/webdavvfs.tcl
+++ b/library/webdavvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::webdav 0.1
+
package require vfs 1.0
package require http 2.6
# part of tcllib
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index abbf878..56da6c1 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -1,4 +1,6 @@
+package provide vfs::zip 1.0
+
package require vfs
package provide zipvfs 1.0
diff --git a/make55.tcl b/make55.tcl
new file mode 100644
index 0000000..bddf075
--- /dev/null
+++ b/make55.tcl
@@ -0,0 +1,69 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec /usr/local/bin/tclsh8.4 $0 ${1+"$@"}
+
+
+proc platform {} {
+ global tcl_platform
+ set plat [lindex $tcl_platform(os) 0]
+ set mach $tcl_platform(machine)
+ switch -glob -- $mach {
+ sun4* { set mach sparc }
+ intel -
+ i*86* { set mach x86 }
+ "Power Macintosh" { set mach ppc }
+ }
+ return "$plat-$mach"
+}
+
+proc makepackagedirs {pkgname} {
+ file delete -force $pkgname
+ file mkdir $pkgname
+ file mkdir [file join $pkgname tcl]
+ file mkdir [file join $pkgname doc]
+ file mkdir [file join $pkgname examples]
+ file mkdir [file join $pkgname [platform]]
+ file mkdir [file join $pkgname tcl]
+}
+
+proc makepackage {pkgname} {
+ global files
+ makepackagedirs $pkgname
+
+ foreach type [array names files] {
+ foreach pat $files($type) {
+ foreach f [glob -nocomplain $pat] {
+ file copy $f [file join $pkgname $type]
+ }
+ }
+ }
+ file copy DESCRIPTION.txt $pkgname
+
+ if {![catch {package require installer}]} {
+ installer::mkIndex $pkgname
+ }
+}
+
+
+array set files {
+ tcl library/*.tcl
+ examples examples/*.tcl
+ doc {doc/*.n Readme.txt}
+}
+## how should files([platform]) be set?
+## the version number ought to be a param, needs to come fro
+## the config file: vfs_LIB_FILE
+
+if [catch {open config.status} config] {
+ error $config
+}
+
+while {[gets $config line] != -1} {
+ regexp -expanded {s(.)@vfs_LIB_FILE@\1(.*)\1} $line => sep files([platform])
+}
+close $config
+
+parray files
+
+
+makepackage vfs1.0
--
2.23.0