[Keith Vetter] 2007-01-04 : I was playing around with [VFS], specifically [vfs::zip], and for fun wrote a tcl-only version of unzip. This is very simple version that only does basic listing and extracting, but it illuminated how to use [vfs::zip]. Also, it could easily be extended to more complex options. It only handles options '''-l''' = list zip file, '''-q''' = quiet and '''-d directory''' options. Also, it doesn't handle directories within the zip file. Doing so isn't hard, but I got bored. I'll leave that as an exercise for the next person. ---- ##+########################################################################## # # tclUnzip.tsh -- a limited tcl only version of unzip for demo purposes # by Keith Vetter, Jan 4 2007 # package require vfs::zip array set OPT {dirList 0 quiet 0 toDir ""} ;# Options we handle array set stats {cnt 0 total 0} set usage "tclUnzip ?-l? ?-q? ?-d unzipDirectory? zipfile ?file list?" proc DoOneFile {fname} { global OPT stats incr stats(cnt) if {$OPT(dirList)} { if {[file isdirectory $fname]} { set size " " } else { set size [file size $fname] incr stats(total) $size } set mtime [file mtime $fname] set date [clock format $mtime -format "%D"] set ftime [clock format $mtime -format "%H:%M"] set tail [file tail $fname] INFO [format "%9s %9s %5s %s" $size $date $ftime $tail] return } # Make output directory if needed if {! [file isdirectory $OPT(toDir)]} { set n [catch {file mkdir $OPT(toDir)}] if {! [file isdirectory $OPT(toDir)]} { DIE "Error: cannot create extraction directory: $OPT(toDir)" } } if {[file isdirectory $fname]} { INFO [format "%12s: %-30s %s" skipping [file tail $fname] directory] return } set outFile [file join $OPT(toDir) [file tail $fname]] if {[file exists $outFile]} { INFO [format "%12s: %-30s %s" skipping $outFile "file exists"] return } INFO [format "%12s: %-30s" extracting $outFile] file copy $fname $outFile } proc ParseArgs {} { global argc argv OPT for {set i 0} {$i < $argc} {incr i} { set arg [lindex $argv $i] switch -regexp -- $arg { ^-l$ { set OPT(dirList) 1 } ^-d$ { set OPT(toDir) [lindex $argv [incr i]]} ^-d { set OPT(toDir) [string range $arg 2 end]} ^-q$ { set OPT(quiet) 1 } ^-h$ - ^-?$ - ^--help { DIE $::usage } ^--$ { incr i; break } ^- { DIE "unknown option: \"$arg\"" } default { break } } } if {$OPT(dirList)} { set OPT(quiet) 0 } set zipFile [lindex $argv $i] incr i set argc [expr {$argc - $i}] if {$argc < 0} { DIE $::usage } set argv [lrange $argv $i end] if {$argv eq {}} { set argv "*" } if {! [file exists $zipFile]} { if {! [file exists "$zipFile.zip"]} { DIE "Error: cannot find either $zipFile or $zipFile.zip." } set zipFile "$zipFile.zip" } return $zipFile } proc DIE {msg} {puts stderr "$msg" ; exit } proc INFO {msg} {if {! $::OPT(quiet)} { puts $msg }} ################################################################ set zipFile [ParseArgs] ::vfs::zip::Mount [file normalize $zipFile] /__zip if {$tcl_interactive} return INFO "Archive: [file nativename [file normalize $zipFile]]" if {$OPT(dirList)} { INFO [format "%9s %9s %5s %s" Length "Date " Time Name] INFO [format "%9s %9s %5s %s" ------ "---- " ---- ----] } foreach arg $argv { foreach fname [lsort [glob -nocomplain /__zip/$arg]] { DoOneFile $fname } } if {$OPT(dirList)} { INFO [format "%9s %9s %5s %s" ------ "" "" ----] INFO [format "%9s %9s %5s %s%s" $stats(total) "" "" "$stats(cnt) file" \ [expr {$stats(cnt) == 1 ? "" : "s"}]] } return ---- %|[Category VFS] | [Category Compression]|%