From: Vince Darley <vincentdarley@sourceforge.net>
Date: Tue, 28 Jan 2003 12:38:57 +0000 (+0000)
Subject: vfs library organisation
X-Git-Tag: vfs-1-2~13
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=4174223e2680d307ca9825fd006a4ea696fdd3da;p=tclvfs

vfs library organisation
---

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