##+##########################################################################
 #
 # 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 "<DIR> "
        } 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