Attachment "zipfs-unwrap.diff" to
ticket [896e5767cc]
added by
chw
2020-06-29 04:48:19.
Index: doc/zipfs.n
==================================================================
--- doc/zipfs.n
+++ doc/zipfs.n
@@ -27,10 +27,11 @@
\fBzipfs mkkey\fR \fIpassword\fR
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs root\fR
\fBzipfs unmount\fR \fImountpoint\fR
+\fBzipfs unwrap\fR ?\fIfilename\fR?
.fi
'\" The following subcommand is *UNDOCUMENTED*
'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
.BE
.SH DESCRIPTION
@@ -112,13 +113,14 @@
.QW \fB//zipfs:/\fR .
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
-.SS "ZIP CREATION COMMANDS"
+.SS "ZIP CREATION AND EXTRACTION COMMANDS"
This package also provides several commands to aid the creation of ZIP
-archives as Tcl applications.
+archives as Tcl applications and to extract embedded ZIP archives to
+a directory.
.TP
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
@@ -174,10 +176,19 @@
.
This command is like \fBzipfs mkzip\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive, and the even elements are their respective
names within that archive.
+.TP
+\fBzipfs unwrap\fR ?\fIfilename\fR?
+.
+If \fIfilename\fR is the root of a mounted ZIP archive its content is
+unpacked to a local directory named \fIfilename.vfs\fR. This directory
+must not exists prior to the call. Otherwise, \fIfilename\fR is temporarily
+mounted before the unpack operation takes place and unmounted afterwards.
+If \fIfilename\fR is omitted the result of \fBinfo nameofexecutable\fR is
+used instead, i.e. the main ZIP archive of the running process is unpacked.
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
Index: generic/tclZipfs.c
==================================================================
--- generic/tclZipfs.c
+++ generic/tclZipfs.c
@@ -4740,10 +4740,45 @@
"}\n"
"proc ::tcl::zipfs::find {directoryName} {\n"
" return [lsort [Find $directoryName]]\n"
"}\n";
+ static const char unwrproc[] =
+ "namespace eval ::tcl::zipfs {}\n"
+ "proc ::tcl::zipfs::unwrap {{filename {}}} {\n"
+ " set noe [::info nameofexecutable]\n"
+ " if {$filename eq{}} {\n"
+ " set filename $noe\n"
+ " } else {\n"
+ " set filename [file normalize $filename]\n"
+ " }\n"
+ " set outdir [file rootname [file tail $filename]].vfs\n"
+ " if {[file isdirectory $outdir]} {\n"
+ " return -code error \"directory \\\"$outdir\\\" already exists\"\n"
+ " }\n"
+ " file mkdir $outdir\n"
+ " if {[info $filename] ne {}} {\n"
+ " file copy {*}[glob -directory $filename -- * .*] $outdir\n"
+ " } else {\n"
+ " set domnt 1\n"
+ " foreach {zip dir} [mount] {\n"
+ " if {$filename eq $dir} {\n"
+ " set domnt 0\n"
+ " file copy {*}[glob -directory $zip -- * .*] $outdir\n"
+ " break\n"
+ " }\n"
+ " }\n"
+ " if {$domnt} {\n"
+ " mount $filename $filename\n"
+ " set zip [string trimright [zipfs root] /]\n"
+ " append zip / [string trimleft $filename /]\n"
+ " file copy {*}[glob -directory $zip -- * .*] $outdir\n"
+ " unmount $filename\n"
+ " }\n"
+ " }\n"
+ "}\n";
+
/*
* One-time initialization.
*/
WriteLock();
@@ -4755,22 +4790,25 @@
if (interp) {
Tcl_Command ensemble;
Tcl_Obj *mapObj;
Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
+ Tcl_EvalEx(interp, unwrproc, -1, TCL_EVAL_GLOBAL);
Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
TCL_LINK_INT);
ensemble = TclMakeEnsemble(interp, "zipfs",
Tcl_IsSafe(interp) ? (initMap + 4) : initMap);
/*
- * Add the [zipfs find] subcommand.
+ * Add the [zipfs find/unwrap] subcommands.
*/
Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
Tcl_NewStringObj("::tcl::zipfs::find", -1));
+ Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("unwrap", -1),
+ Tcl_NewStringObj("::tcl::zipfs::unwrap", -1));
Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
ZipFSTclLibraryObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "zipfs", "2.0");
}
return TCL_OK;
