util::unzip (public)
util::unzip -source source -destination destination [ -overwrite ]
Defined in packages/acs-tcl/tcl/utilities-procs.tcl
- Switches:
- -source (required)
- must be the name of a valid zip file to be decompressed
- -destination (required)
- must be the name of a valid directory to contain decompressed files
- -overwrite (optional, boolean)
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- zip_and_unzip
Source code: # # This was an attempt to rewrite the utility without using # exec. Unfortunately, zipfile::decode suffers from limitations: # for instance, will not handle files > 2GB well. # # package require zipfile::decode # # # # Open the archive # # # ::zipfile::decode::open $source # try { # # # # Get the dict containing the archive information. # # # set adict [::zipfile::decode::archive] # if {$overwrite_p} { # # # # We are fine with overwriting: unzip the entire archive. # # # ::zipfile::decode::unzip $adict $destination # } else { # # # # We do not want to overwrite existing files: read the # # archive and only extract non-existing files. # # # foreach f [::zipfile::decode::files $adict] { # set dest_path [file join $destination $f] # if {![file exists $dest_path]} { # ::zipfile::decode::copyfile $adict $f $dest_path # } # } # } # } finally { # # # # Close the archive # # # ::zipfile::decode::close # } # set unzipCmd [util::which unzip] if {$unzipCmd eq ""} { error "unzip command not found on the system." } set extra_options "" # # Check, if the zip file contains filenames which are invalid # UTF-8 characters. # if {[info commands ::util::zip_file_contains_valid_filenames] ne "" && $::tcl_platform(os) eq "Linux" && ![::util::zip_file_contains_valid_filenames $source] } { # # The option "-O" works apparently only under Linux and might # depend on the version of "unzip". We assume here that the # broken characters are from Windows (code page 850) # lappend extra_options -O CP850 } # -n means we don't overwrite existing files exec $unzipCmd {*}$extra_options [expr {$overwrite_p ? "-o" : "-n"}] $source -d $destinationXQL Not present: PostgreSQL, Oracle Generic XQL file: packages/acs-tcl/tcl/utilities-procs.xql