execx - EXECuting transparently out of the VFS of a starkit/starpack
The following simplifies the execution of .EXEs which are inside of a Starkits/Starpacks VFS by transparently copying them ot of the VFS to a temporary location and EXECing them from there (just as it already works from the tcl core with LOADing DLLs). I pack various external tools needed by my scripts in the VFS because it's not always clear, if the machine the script is later running on has such tools installed in the path or if the tool-versions are correct. So it's safer to deliver the tools right within the script and to make a temp copy out of the VFS and call them from there. However, the default is to use an external available tool (to save the copy step).
Todo/Notes:
################################################################################
# Modul : execx.tcl
# Stand : 19.01.2006
# Zweck : Erweiterter Exec-Befehl, um .EXE-Programme direkt aus Starkits/-
# packs heraus ausf�hren zu k�nnen. Dazu wird das Programm an eine
# tempor�re Position kopiert, bevor EXEC gerufen wird.
# Autor : M.Hoffmann
# Historie : 1.0 21.10.2003: Urversion
# : 1.0 05.08.2004: Review Urversion (list $progCallNew)
# : 1.1 09.08.2004: execx::setforce execx::settrace
# : 1.2 21.10.2005: Handling f�r &-Prozesse ge�ndert; running ge�ndert;
# Uplevel statt eval.
# : 1.3 28.10.2005: BugFix.
# : 1.4 15.11.2005, Neben Tools auch Bin als Quellverz. im VFS (sp�ter
# 16.11.2005: per Kommando beeinflu�bar machen);
# (f�r neue Tcl-Standardumgebung). Neu: fehlt eine
# Endung, wird erste �bereinstimmende Datei im VFS
# verwendet (er�brigt explizite .Ext-Angabe). Bugfix.
# : 1.5 13.01.2006, Unterst�tzung von QuellVERZ im VFS, Name := EXEName
# : 1.6 19.01.2006, Bugfix.
#
# Weiteres :
# --> Abfangung 'nicht im VFS' fehlt noch!
################################################################################
package provide execx 1.6
namespace eval execx {
variable running
variable exectrace 0
variable force 0
}
proc execx::setforce {setting} {
# sp�ter Abfrage mit -1, altes Setting zur�ckliefern
set execx::force $setting
}
#----------------------------------------------------------------------------------
proc execx::settrace {setting} {
# sp�ter Abfrage mit -1, altes Setting zur�ckliefern
set execx::exectrace $setting
}
#----------------------------------------------------------------------------------
# args - Parameter genau wie f�r Originalexec-Befehl
# R�ckgabe: wie Originalbefehl
# Sofern ein Programm nicht im Hintergrund gestartet wird, wird eine evtl.
# tempor�re Kopie wieder gel�scht; ansonsten wird ein Namespacearray mit dem
# Programmnamen gef�llt.
#
proc execx::execx1 {args} {
variable running
set progIdx -1
foreach a $args {
incr progIdx
if {$a != "-keepnewline" && $a != "--"} {
break;
}
}
set progCallOrg [lindex $args $progIdx]
set progCallTst {}
set progCallNew {}
set toDelete {}; # v1.6
if {!$execx::force} {
# nach Originalprogramm suchen
set progCallTst [auto_execok $progCallOrg]
}
if {[string equal $progCallTst ""]} {
# auf�hrbare Datei nicht auffindbar oder -force; also aus Starpack-Dir
# vfs/TOOLS in Tempverzeichnis kopieren (sofern Src/Dest vorhanden...)
set progName [file tail $progCallOrg]
set progCallNew [file join $::env(temp) $progName]; # Problem m�glich, wenn %temp% fehlt!
set toDelete $progCallNew; # v1.5
# neu ab v1.4: auch bin als Quelle unterst�tzen, aufw�rtskompatibel
foreach dir {tools bin} {
set toolDir [file join $::starkit::topdir $dir]
# neu ab v1.4: Extension ist unbekannt, erster Match gilt
# ACHTUNG: glob im VFS arbeitet CASE-sensitiv!
# file normalize scheint nicht zu funktionieren mit VFS
set progFound [glob -nocomplain -dir $toolDir $progName*]
if {[string length $progFound]} {
# eval erforderlich wg. 'Source not found...', wenn Blanks in Quellspec!
# (Quoting-H�lle...)
if {![catch {eval file copy -force -- $progFound $progCallNew} rc]} {
# Erweiterung v1.5: Call aus Dirs mit mehreren Dateien unterst�tzen
if {[file isdirectory $progCallNew]} {
# Problem: es werden rekursive Strukturen erzeugt, wenn ZielDir
# noch da! checken! Ausserdem: stdlib.zip, wiki-Updates
set progCallNew [file join $progCallNew [file tail $progFound]]
}
# Erweiterung v1.5, Ende
break;
} else {
return $rc
# hier einen Abbruch triggern?!
}
}
}
lset args $progIdx [list $progCallNew]; # 5.8.2004: list
}
if {$execx::exectrace} {
puts -nonewline {>>> }
puts $args
}
catch {uplevel exec $args} rc
# TempProgramm l�schen, sofern es nicht im Hintergrund l�uft
# Ansonsten den Namen f�r sp�teres L�schen in execx::running(PID) sichern
# f�r sp�teres L�schen
if {[lindex $args end] != "&"} {
# Programm lief im Vordergrund
if {$toDelete != ""} {
# und war aus VFS einkopiert -> Beseitigen
# v1.5: gesamtes Verzeichnis l�schen
catch {file delete -force -- $toDelete}
}
} else {
# Programm l�uft noch im Hintergrund ->
# als Hilfe f�r sp�teres L�schen durch MainProg Aufruf sicherstellen
set running($rc) $args
}
return $rc; # PID oder Ergebnis zur�ckgeben
}
#==================================================================================Testroutine
###################################################################################
# Modul : execxtest.tcl #
# Stand : 09.08.2004, 28.10.2005 #
# Zweck : Tests des Pakets execx (nur syntaktisch, da kein VFS vorhanden) #
###################################################################################
lappend auto_path ./
package require execx 1.3
execx::settrace 1
# Achtung: ^& angeben, um Interpretation durch CMD.EXE zu vermeiden!
puts Start
# Achtung: mit '&' CONSOL-Programme bleiben h�ngen, weil Vordergrundprogramm
# schon geendet hat. Solche lieber mittels BgExec starten!
puts [eval execx::execx1 $argv]; # bei Aufruf von CMD `eval` erforderlich!?
puts Ende
if {[lindex $argv end] == "&"} {
parray ::execx::running
puts "Wenn Programm beendet, Strg+C dr�cken...."
vwait forever
}
#==================================================================================Examples
tclsh execxtest.tcl msgbox test tclsh execxtest.tcl msgbox test ^&
Yes, you need a standard pkgIndex.tcl file, which is not included here.
There are some diffuculties starting Console-mode-programs in the background with this method, because when execx has finished launching such kind of progs and finishes itself immediately, the exec'd program loses its console-connection, it seems. Not sure yet what happens in detail - but one have to press a key then to terminate the whole thing. That's why I included a vwait forever in the test routine. For such programs, it is better to launch them in the background with this tool: Matthias Hoffmann - Tcl-Code-Snippets - Misc - Bgexec. One important difference between the standard exec and execx::execx1-command is that only the first program in the process pipeline is handled, that is, copied out of the VFS, if neccessary. So, constructs like exec::execx1 -- test1 |& test2 won't work, if test2 only resides within the VFS! Conclusion: to me it seems to be nearly impossible to reimplement the whole exec-command with all of its complicated aspects.... exec should really better be supported native from starpacks!