**File format** *****Compress/Decompress strings*** [HaO] 2020-11-24: TCL 8.6 has the [zlib] command to compress or decompress strings using the zip methods. *****Read/Write zip files***** To read or write zip-files, one may use the [TCLLIB] modules [zipfile::mkzip] and [zipfile::decode] as follows: <> ====== # zip files in folder "config" to file test.zip package require zipfile::mkzip zipfile::mkzip::mkzip test.zip -directory config # unzip file test.zip to folder config package require zipfile::decode ::zipfile::decode::open test.zip set archiveDict [::zipfile::decode::archive] ::zipfile::decode::unzip $archiveDict config ::zipfile::decode::close ====== <> *****Tools for zip handling***** [Steve Cassidy]: "[Trf] lets you zip up a bit of data but doesn't provide the machinery to zip directories or files. mkZipLib [http://mkextensions.sourceforge.net/] provides such an interface as does zvfs [http://www.hwaci.com/sw/tobe/zvfs.html]. More up to date is the zipvfs package which is part of [tclvfs] but that doesn't seem to be working cleanly yet and requires tcl8.4 features." http://www.equi4.com/critlib/zipper.README http://www.equi4.com/critlib/zlib.README See also [Using a zip file as a Tcl Module]. See also [Using zipper to create zip files]. Also, explain pkware vs. winzip vs. zLibDll. ***ZIP reader class*** [DKF]: Here's a little [TclOO] class to read from ZIP files (it only handles very basic cases, but that's good enough for what I wanted it for): <> ====== package require Tcl 8.6 oo::class create Zip { variable comment directory fd constructor {filename} { set fd [open $filename rb] my ReadDirectory } destructor { close $fd } method ReadDirectory {} { set off -22 while 1 { seek $fd $off end binary scan [read $fd 4] i sig if {$sig == 0x06054b50} { seek $fd $off end break } incr off -1 } binary scan [read $fd 22] issssiis sig disk cddisk nrecd nrec \ dirsize diroff clen if {$clen > 0} { set comment [read $fd $clen] } else { set comment "" } if {$disk != 0} { error "multi-file zip not supported" } seek $fd $diroff for {set i 0} {$i < $nrec} {incr i} { binary scan [read $fd 46] issssssiiisssssii \ sig ver mver flag method time date crc csz usz n m k d ia ea \ off if {$sig != 0x02014b50} { error "bad directory entry" } set name [read $fd $n] set extra [read $fd $m] if {$k == 0} { set c "" } else { set c [read $fd $k] } set directory($name) [dict create timestamp [list $date $time] \ size $csz disksize $usz offset $off method $method \ extra $extra comment $c] } } method names {} { lsort [array names directory] } method comment {{name {}}} { if {$name eq ""} { return $comment } return [dict get $directory($name) comment] } method info {name {field ""}} { if {$field ne ""} { return [dict get $directory($name) $field] } return $directory($name) } method contents {name} { dict with directory($name) {} seek $fd $offset binary scan [read $fd 30] isssssiiiss sig - - - - - - - - nlen xlen if {$sig != 0x04034b50} { error "not a file record" } seek $fd [expr {$nlen + $xlen}] current set data [read $fd $size] if {[string length $data] != $size} { error "read length mismatch: $size expected" } if {$method == 0} { return $data } elseif {$method == 8} { return [zlib inflate $data] } else { error "unsupported method: $method" } } } ====== An example of use: ====== set z [Zip new [lindex $argv 0]] if {$argc > 1} { puts Comment:[$z comment [lindex $argv 1]] puts Contents:\n[$z contents [lindex $argv 1]] } else { puts Comment:[$z comment] foreach n [$z names] { puts "$n ([$z info $n disksize] bytes)" } } $z destroy ====== <> ---- **Functional operation** [NEM] zip is also the name of another [functional programming] classic. You can think of it as a function that takes a bunch of "columns" (think relational) and returns a list of "rows": ====== proc zip {cola colb} { set ret [list] foreach a $cola b $colb { lappend ret [list $a $b] } return $ret } zip {1 2 3} {a b c} ;# returns {{1 a} {2 b} {3 c}} ====== You can generalise zip to zipWith which applies an arbitrary function on each pair of values from the columns: ====== proc apply {func args} { uplevel #0 $func $args } proc zipWith {f cola colb} { set ret [list] foreach a $cola b $colb { lappend ret [apply $f $a $b] } return $ret } interp alias {} zip {} zipWith list ====== You could further generalise the function to take an arbitrary number of columns. I'll leave that, and the reverse unzip operation as exercises. See also [fold], [filter], [iterators] and [map]. ''[Lars H]: Isn't that more commonly known as "transposing"? See [Transposing a matrix].'' [NEM]: Depends who you ask. `zipWith` is more general, though. [AMG]: "list" isn't a valid lambda, so it's not directly usable with the Tcl 8.5 [[[apply]]] command. Here's an 8.5-compatible version. It uses single-argument [[[lindex]]] instead of [[[list]]] to avoid adding an extra level of list nesting. (Single-argument [[lindex]] simply returns its argument, even if its argument isn't a valid list.) ====== interp alias "" zip "" zipWith {{args} {lindex $args}} ====== ---- [AMG]: Implementation using [lcomp]: ====== proc zip {cola colb} { lcomp {[list $a $b]} for a in $cola and b in $colb } ====== Here's a version that handles an arbitrary number of columns: ====== proc zip {args} { if {[llength $args]} { for {set i 0} {$i < [llength $args]} {incr i} { append expression " \$$i" lappend operations and $i in [lindex $args $i] } lset operations 0 for lcomp \[list$expression\] {*}$operations } } ====== Also, I'll take your unzip challenge. ;^) ====== interp alias "" unzip "" zip ====== As [Lars H] pointed out, zip is transpose, so using it twice gives back the original input. Examples: ====== % zip {a 1} {b 2} {c 3} {a b c} {1 2 3} % unzip {a b c} {1 2 3} {a 1} {b 2} {c 3} ====== <> Compression | Functional Programming