From: Jean-Claude Wippler Date: Thu, 25 Apr 2002 16:35:09 +0000 (+0000) Subject: switch to vfs::{crc,memchan,zip} X-Git-Tag: vfs-1-2~53 X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=cb046faf03fff85cd80df5d901901dfb2bfe47cf;p=tclvfs switch to vfs::{crc,memchan,zip} --- diff --git a/ChangeLog b/ChangeLog index 79d6b12..c40c468 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,8 @@ 2002-04-25 Jean-Claude Wippler - * 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]