|
|
|
|
|
#zip file with Tcl loader prepended. Requires either builtin zipfs, or vfs::zip to mount while zipped. |
|
|
#Alternatively unzip so that extracted #modpod-package-version folder is in same folder as .tm file. |
|
|
#generated using: modpod::lib::make_zip_modpod -offsettype archive <zipfile> <tmfile> |
|
|
if {[catch {file normalize [info script]} modfile]} { |
|
|
error "modpod zip stub error. Unable to determine module path. (possible safe interp restrictions?)" |
|
|
} |
|
|
if {$modfile eq "" || ![file exists $modfile]} { |
|
|
error "modpod zip stub error. Unable to determine module path" |
|
|
} |
|
|
set moddir [file dirname $modfile] |
|
|
set mod_and_ver [file rootname [file tail $modfile]] |
|
|
lassign [split $mod_and_ver -] moduletail version |
|
|
if {[file exists $moddir/#modpod-$mod_and_ver]} { |
|
|
source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm |
|
|
} else { |
|
|
#determine module namespace so we can mount appropriately |
|
|
proc intersect {A B} { |
|
|
if {[llength $A] == 0} {return {}} |
|
|
if {[llength $B] == 0} {return {}} |
|
|
if {[llength $B] > [llength $A]} { |
|
|
set res $A |
|
|
set A $B |
|
|
set B $res |
|
|
} |
|
|
set res {} |
|
|
foreach x $A {set ($x) {}} |
|
|
foreach x $B { |
|
|
if {[info exists ($x)]} { |
|
|
lappend res $x |
|
|
} |
|
|
} |
|
|
return $res |
|
|
} |
|
|
set lcase_tmfile_segments [string tolower [file split $moddir]] |
|
|
set lcase_modulepaths [string tolower [tcl::tm::list]] |
|
|
foreach lc_mpath $lcase_modulepaths { |
|
|
set mpath_segments [file split $lc_mpath] |
|
|
if {[llength [intersect $lcase_tmfile_segments $mpath_segments]] == [llength $mpath_segments]} { |
|
|
set tail_segments [lrange [file split $moddir] [llength $mpath_segments] end] ;#use properly cased tail |
|
|
break |
|
|
} |
|
|
} |
|
|
if {[llength $tail_segments]} { |
|
|
set fullpackage [join [concat $tail_segments $moduletail] ::] ;#full name of package as used in package require |
|
|
set mount_at #modpod/[file join {*}$tail_segments]/#mounted-modpod-$mod_and_ver |
|
|
} else { |
|
|
set fullpackage $moduletail |
|
|
set mount_at #modpod/#mounted-modpod-$mod_and_ver |
|
|
} |
|
|
|
|
|
if {[info commands tcl::zipfs::mount] ne ""} { |
|
|
#argument order changed to be consistent with vfs::zip::Mount etc |
|
|
#early versions: zipfs::Mount mountpoint zipname |
|
|
#since 2023-09: zipfs::Mount zipname mountpoint |
|
|
#don't use 'file exists' when testing mountpoints. (some versions at least give massive delays on windows platform for non-existance) |
|
|
#This is presumably related to // being interpreted as a network path |
|
|
set mountpoints [dict keys [tcl::zipfs::mount]] |
|
|
if {"//zipfs:/$mount_at" ni $mountpoints} { |
|
|
#despite API change tcl::zipfs package version was unfortunately not updated - so we don't know argument order without trying it |
|
|
if {[catch { |
|
|
#tcl::zipfs::mount $modfile //zipfs:/#mounted-modpod-$mod_and_ver ;#extremely slow if this is a wrong guess (artifact of aforementioned file exists issue ?) |
|
|
#puts "tcl::zipfs::mount $modfile $mount_at" |
|
|
tcl::zipfs::mount $modfile $mount_at |
|
|
} errM]} { |
|
|
#try old api |
|
|
if {![catch {tcl::zipfs::mount //zipfs:/$mount_at $modfile}]} { |
|
|
puts stderr "modpod stub>>> tcl::zipfs::mount <file> <mountpoint> failed.\nbut old api: tcl::zipfs::mount <mountpoint> <file> succeeded\n tcl::zipfs::mount //zipfs://$mount_at $modfile" |
|
|
puts stderr "Consider upgrading tcl runtime to one with fixed zipfs API" |
|
|
} |
|
|
} |
|
|
if {![file exists //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm]} { |
|
|
puts stderr "modpod stub>>> mount at //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm failed\n zipfs mounts: [zipfs mount]" |
|
|
#tcl::zipfs::unmount //zipfs:/$mount_at |
|
|
error "Unable to find $mod_and_ver.tm in $modfile for module $fullpackage" |
|
|
} |
|
|
} |
|
|
# #modpod-$mod_and_ver subdirectory always present in the archive so it can be conveniently extracted and run in that form |
|
|
source //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm |
|
|
} else { |
|
|
#fallback to slower vfs::zip |
|
|
#NB. We don't create the intermediate dirs - but the mount still works |
|
|
if {![file exists $moddir/$mount_at]} { |
|
|
if {[catch {package require vfs::zip} errM]} { |
|
|
set msg "Unable to load vfs::zip package to mount module $mod_and_ver (and zipfs not available either)" |
|
|
append msg \n "If neither zipfs or vfs::zip are available - the module can still be loaded by manually unzipping the file $modfile in place." |
|
|
append msg \n "The unzipped data will all be contained in a folder named #modpod-$mod_and_ver in the same parent folder as $modfile" |
|
|
error $msg |
|
|
} else { |
|
|
set fd [vfs::zip::Mount $modfile $moddir/$mount_at] |
|
|
if {![file exists $moddir/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm]} { |
|
|
vfs::zip::Unmount $fd $moddir/$mount_at |
|
|
error "Unable to find $mod_and_ver.tm in $modfile for module $fullpackage" |
|
|
} |
|
|
} |
|
|
} |
|
|
source $moddir/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm |
|
|
} |
|
|
} |
|
|
#zipped data follows |
|
|
PK |