vfs library organisation
authorVince Darley <vincentdarley@sourceforge.net>
Tue, 28 Jan 2003 12:38:57 +0000 (12:38 +0000)
committerVince Darley <vincentdarley@sourceforge.net>
Tue, 28 Jan 2003 12:38:57 +0000 (12:38 +0000)
14 files changed:
ChangeLog
DESCRIPTION.txt [new file with mode: 0644]
examples/simpleExamples.tcl
library/ftpvfs.tcl
library/httpvfs.tcl
library/mk4vfs.tcl
library/pkgIndex.tcl
library/tarvfs.tcl
library/tclprocvfs.tcl
library/testvfs.tcl
library/vfsUrl.tcl
library/webdavvfs.tcl
library/zipvfs.tcl
make55.tcl [new file with mode: 0644]

index 2d9d9ecc1aaa7507aa620644816c9bb5f6f373c8..c5223b77423cefafda1da7220b5ca7d5ea27b1dc 100644 (file)
--- 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 (file)
index 0000000..e2010af
--- /dev/null
@@ -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
index ed0336811acc24ef6b849c27fe84263374416b84..f75f755289ecd4b96d9691f16411dd582f84607f 100644 (file)
@@ -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').
index 80d55df1ba95567345ec98104de07ed57c92249c..825057357da1c883696a631aa3730d1d3573a53f 100644 (file)
@@ -1,4 +1,6 @@
 
+package provide vfs::ftp 1.0
+
 package require vfs 1.0
 package require ftp
 
index 972a0f9486ff1e2796fa211b223f7445f94de211..061f8c4da7cf223458a4964995ce8cba060814af 100644 (file)
@@ -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
        }
     }
index 65843b873a68fa83d4ce00c8c1e5970409808c72..873dcf857233b385637572cae9e1655ed10409dd 100644 (file)
@@ -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
            }
        }
index 0c81802bf12e9270758399805d398bd4e50b9a66..66a25c4d7edfdcbdb13483cb9e253a7adbdabc04 100644 (file)
@@ -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]]
index 2a027e6e92d1c664ad1946cfe5f7317840bd539f..cba6b202655b2233abd0559efc2e312262272650 100644 (file)
@@ -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.  
index cbb4e4d885c0e769e960c26226ddae7c91c8fa4c..9075212d9a8a758e5d5632397e17791b2293b1df 100644 (file)
@@ -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
index adf13c79ee2cfa25d6364b4cfc08739e9e010d8f..0758a8f65723adcc8dc4f1aadfc7556e1eb438eb 100644 (file)
@@ -1,4 +1,6 @@
 
+package provide vfs::test 1.0
+
 package require vfs 1.0
 
 namespace eval vfs::test {}
index 68f9c336a566f5d08b414beeee3c664589a7cf45..0e2cc085e984b9908bbd0d308486e38202fbd771 100644 (file)
@@ -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]
index 0106def727d3e915eb9e9f4f87e60f4fa8233644..cce1f93b155b27d9b8d413fb273bbc3cfff7e055 100644 (file)
@@ -1,4 +1,6 @@
 
+package provide vfs::webdav 0.1
+
 package require vfs 1.0
 package require http 2.6
 # part of tcllib
index abbf878263435000379f48fbafae131c9189b7c3..56da6c1e318607fadd3e2680bd05327930ecdb3c 100644 (file)
@@ -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 (file)
index 0000000..bddf075
--- /dev/null
@@ -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