memchan, zip, etc

diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 6a20495a3b514ac79fedb39bb30b9095862af8ef..89ac5d20c9b6a9c1937251e3a0ecf413baed3bb4 100644 (file)
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -115,9 +115,8 @@ proc vfs::ftp::open {fd name mode permissions} {
        "" -
        "r" {
            ftp::Get $fd $name -variable tmp
-           package require Memchan
 
-           set filed [memchan]
+           set filed [vfs::memchan]
            fconfigure $filed -translation binary
            puts -nonewline $filed $tmp
 
@@ -130,8 +129,8 @@ proc vfs::ftp::open {fd name mode permissions} {
            if {[catch [list ::ftp::Append $fd -data "" $name] err] || !$err} {
                error "Can't open $name for appending"
            }
-           package require Memchan
-           set filed [memchan]
+
+           set filed [vfs::memchan]
            return [list $filed [list ::vfs::ftp::_closing $fd $name $filed Append]]
        }
        "w*" {
@@ -139,8 +138,8 @@ proc vfs::ftp::open {fd name mode permissions} {
            if {[catch [list ::ftp::Put $fd -data "" $name] err] || !$err} {
                error "Can't open $name for writing"
            }
-           package require Memchan
-           set filed [memchan]
+
+           set filed [vfs::memchan]
            return [list $filed [list ::vfs::ftp::_closing $fd $name $filed Put]]
        }
        default {

diff --git a/library/httpvfs.tcl b/library/httpvfs.tcl
index dae654a3d93367b8e67e10d0397ed09f2412cc07..048e61d83d018d7f4f44bef56795c2a6aff43981 100644 (file)
--- a/library/httpvfs.tcl
+++ b/library/httpvfs.tcl
@@ -101,9 +101,8 @@ proc vfs::http::open {dirurl name mode permissions} {
        "" -
        "r" {
            set state [::http::geturl [file join $dirurl $name]]
-           package require Memchan
 
-           set filed [memchan]
+           set filed [vfs::memchan]
            fconfigure $filed -translation binary
            puts -nonewline $filed [::http::data $state]
 

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 86efe1107c3b96ba8d62a492309eef9c7f97f8c8..6ce39c873abe8cb72760499e02361983757b0885 100644 (file)
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -162,22 +162,18 @@ proc vfs::mk4::open {db file mode permissions} {
       ::mk4vfs::stat $db $file sb
     
       if { $sb(csize) != $sb(size) } {
-        package require Trf
-        package require Memchan
 
-        set fd [memchan]
+        set fd [vfs::memchan]
         fconfigure $fd -translation binary
         set s [mk::get $sb(ino) contents]
-        puts -nonewline $fd [zip -mode decompress $s]
+        puts -nonewline $fd [vfs::zip -mode decompress $s]
 
         fconfigure $fd -translation auto
         seek $fd 0
         return [list $fd [list _memchan_handler close $fd]]
       } elseif { $::mk4vfs::direct } {
-        package require Trf
-        package require Memchan
 
-        set fd [memchan]
+        set fd [vfs::memchan]
         fconfigure $fd -translation binary
         puts -nonewline $fd [mk::get $sb(ino) contents]
 
@@ -209,15 +205,13 @@ proc vfs::mk4::open {db file mode permissions} {
       }
 
       if { $sb(csize) != $sb(size) } {
-        package require Trf
-        package require Memchan
 
         append mode z
-        set fd [memchan]
+        set fd [vfs::memchan]
 
         fconfigure $fd -translation binary
         set s [mk::get $sb(ino) contents]
-        puts -nonewline $fd [zip -mode decompress $s]
+        puts -nonewline $fd [vfs::zip -mode decompress $s]
         fconfigure $fd -translation auto
       } else {
         set fd [mk::channel $sb(ino) contents a]
@@ -238,10 +232,8 @@ proc vfs::mk4::open {db file mode permissions} {
       }
 
       if { [string match *z* $mode] || $mk4vfs::compress } {
-        package require Trf
-        package require Memchan
         append mode z
-        set fd [memchan]
+        set fd [vfs::memchan]
       } else {
         set fd [mk::channel $sb(ino) contents w]
       }

diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index 2cade5066255e4b9f12818467e16c23c64252c39..cbb4e4d885c0e769e960c26226ddae7c91c8fa4c 100644 (file)
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -81,9 +81,7 @@ proc vfs::ns::open {ns name mode permissions} {
     switch -- $mode {
        "" -
        "r" {
-           package require Memchan
-
-           set nfd [memchan]
+           set nfd [vfs::memchan]
            fconfigure $nfd -translation binary
            puts -nonewline $nfd [_generate ::${ns}::${name}]
            fconfigure $nfd -translation auto

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 05af286a9ad0a3927ac9457db0c95f76db266acd..8f9802abd3c50b09b34488d0257aeb4baae12f1c 100644 (file)
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -9,6 +9,24 @@ namespace eval ::vfs {
     }
 }
 
+# This can be overridden to use a different memchan implementation
+proc ::vfs::memchan {args} {
+    ::package require Memchan
+    uplevel 1 ::memchan $args
+}
+
+# This can be overridden to use a different zlib implementation
+proc ::vfs::zlib {args} {
+    ::package require Trf
+    uplevel 1 ::zlib $args
+}
+
+# This can be overridden to use a different zlib implementation
+proc ::vfs::zip {args} {
+    ::package require Trf
+    uplevel 1 ::zip $args
+}
+
 proc ::vfs::autoMountExtension {ext cmd {pkg ""}} {
     variable extMounts
     set extMounts($ext) [list $cmd $pkg]

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index b648ad9888312ed001d02cd0e5f5de9b591ac1f9..49f103b4b9364e3e85fe64b86c0a903c863a8b51 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -1,6 +1,5 @@
 
 package require vfs
-package require pink
 package provide zipvfs 1.0
 
 # Using the vfs, memchan and Trf extensions, we ought to be able
@@ -100,9 +99,7 @@ proc vfs::zip::open {zipfd name mode permissions} {
            
            ::zip::stat $zipfd $name sb
 
-           package require Memchan
-
-           set nfd [memchan]
+           set nfd [vfs::memchan]
            fconfigure $nfd -translation binary
 
            seek $zipfd $sb(ino) start
@@ -293,7 +290,7 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
 
     if { $sb(method) != 0 } {
        if { [catch {
-           set data [zlib decompress $data]
+           set data [vfs::zlib decompress $data]
        } err] } {
            ::vfs::log "$sb(name): inflate error: $err"
            binary scan $data H* x
@@ -302,7 +299,7 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
     }
     return
     if { $verify } {
-       set ncrc [zlib crc32 $data]
+       set ncrc [vfs::zlib crc32 $data]
        if { $ncrc != $sb(crc) } {
            tclLog [format {%s: crc mismatch: expected 0x%x, got 0x%x} \
                    $sb(name) $sb(crc) $ncrc]

diff --git a/tests/vfsUrl.test b/tests/vfsUrl.test
index d64d63be4ff3b13233f3859c4a4132c54871a0b7..6e048682d04b0029810558dcd7df9e99982c7328 100644 (file)
--- a/tests/vfsUrl.test
+++ b/tests/vfsUrl.test
@@ -29,7 +29,8 @@ if {![file writable $vfsTestDir]} {
     if {[info exists env(TEMP)] && [file writable $env(TEMP)]} {
        set vfsTestDir $env(TEMP)
        tcltest::testConstraint vfsWritable 1
-       puts stdout "Using temporary directory for some files"
+       puts stdout "Using temporary directory for some files\
+         (since [pwd] is not writable)"
     } else {
        tcltest::testConstraint vfsWritable 0
     }