From cb046faf03fff85cd80df5d901901dfb2bfe47cf Mon Sep 17 00:00:00 2001
From: Jean-Claude Wippler <jcw@equi4.com>
Date: Thu, 25 Apr 2002 16:35:09 +0000
Subject: [PATCH] switch to vfs::{crc,memchan,zip}
---
ChangeLog | 6 ++--
library/mk4vfs.tcl | 86 +-------------------------------------------
library/vfsUtils.tcl | 6 ++--
library/zipvfs.tcl | 2 +-
4 files changed, 8 insertions(+), 92 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 79d6b12..c40c468 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,8 @@
2002-04-25 Jean-Claude Wippler <jcw@equi4.com>
- * library/zipvfs.tcl: removed dependencies on pink, switched
- to "zlib" command (now available in critlib and in tclkit)
+ * library/*vfs.tcl: switching to vfs::{crc,memchan,zip}
* library/vfsUtils.tcl: fixed env to be global, added unset
- so unmounting cleans up its list of mounted file systems
+ so unmounting cleans up its list of mounted file systems,
+ define Trf/memchan-based versions of vfs::{crc,memchan,zip}
* library/{scripdoc.tcl,vfs.tcl}: removed, tclkit specific
* library/pkgIndex.tcl: drop packages "scripdoc" and "vfslib"
diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 6ce39c8..080015a 100644
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -5,90 +5,6 @@
# $Id$
#
-# uses Pink for zip and md5 replacements, this avoids the dependency on Trf
-
- package ifneeded Trf 1.3 {
- package require pink
- package provide Trf 1.3
-
- proc zip {flag value data} {
- switch -glob -- "$flag $value" {
- {-mode d*} { set mode decompress }
- {-mode c*} { set mode compress }
- default { error "usage: zip -mode {compress|decompress} data" }
- }
- return [pink zlib $mode $data]
- }
-
- proc crc {data} {
- return [pink zlib crc32 $data]
- }
-
- proc md5 {data} {
- set cmd [pink md5]
- $cmd update $data
- set result [$cmd digest]
- rename $cmd ""
- return $result
- }
- }
-
-# this replacement is for memchan, used for simple (de)compression
-
- package ifneeded Memchan 0.1 {
- package require rechan
- package provide Memchan 0.1
-
- proc _memchan_handler {cmd fd args} {
- upvar #0 ::_memchan_buf($fd) _buf
- upvar #0 ::_memchan_pos($fd) _pos
- set arg1 [lindex $args 0]
-
- switch -- $cmd {
- seek {
- switch [lindex $args 1] {
- 1 - current { incr arg1 $_pos }
- 2 - end { incr arg1 [string length $_buf]}
- }
- return [set _pos $arg1]
- }
- read {
- set r [string range $_buf $_pos [expr { $_pos + $arg1 - 1 }]]
- incr _pos [string length $r]
- return $r
- }
- write {
- set n [string length $arg1]
- if { $_pos >= [string length $_buf] } {
- append _buf $arg1
- } else { # the following doesn't work yet :(
- set last [expr { $_pos + $n - 1 }]
- set _buf [string replace $_buf $_pos $last $arg1]
- error "mk4vfs: sorry no inline write yet"
- }
- incr _pos $n
- return $n
- }
- close {
- unset _buf _pos
- }
- default {
- error "Bad call to memchan replacement handler: $cmd"
- }
- }
- }
-
- proc memchan {} {
- set fd [rechan _memchan_handler 6]
- #fconfigure $fd -translation binary -encoding binary
-
- set ::_memchan_buf($fd) ""
- set ::_memchan_pos($fd) 0
-
- return $fd
- }
- }
-
namespace eval vfs::mk4 {}
proc vfs::mk4::Mount {what local args} {
@@ -465,7 +381,7 @@ proc mk4vfs::do_close {fd mode cur} {
# this was a duplicate close!!! 12-10-2001
#close $fd
_memchan_handler close $fd
- set cdata [zip -mode compress $data]
+ set cdata [vfs::zip -mode compress $data]
set len [string length $data]
set clen [string length $cdata]
if { $clen < $len } {
diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index ee4a1ed..8b9af31 100644
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -15,10 +15,10 @@ proc ::vfs::memchan {args} {
uplevel 1 ::memchan $args
}
-# This can be overridden to use a different zlib implementation
-proc ::vfs::zlib {args} {
+# This can be overridden to use a different crc implementation
+proc ::vfs::crc {args} {
::package require Trf
- uplevel 1 ::zlib $args
+ uplevel 1 ::crc $args
}
# This can be overridden to use a different zip implementation
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 830a592..9533705 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -299,7 +299,7 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
}
return
if { $verify } {
- set ncrc [vfs::zlib crc32 $data]
+ set ncrc [vfs::crc $data]
if { $ncrc != $sb(crc) } {
tclLog [format {%s: crc mismatch: expected 0x%x, got 0x%x} \
$sb(name) $sb(crc) $ncrc]
--
2.23.0