[MHo] 2011-02-11: No longer "work-in-progress", as this is productive for a relative long period. Nevertheless, today I found and fixed a bug, so I put the new version 0.3 here. ====== ################################################################################ # # Modul : execx2.tcl # Version : 0.3 # Date : 11.02.2011 # Author : M.Hoffmann # Wikipage : http://wiki.tcl.tk/23839 # History : 28.06.2009 - 0.1 first version # 20.11.2010 - 0.2 - Bugfix: Only replace 1st word in each exec's # pipe element with temporary program name # (still not perfect). # - Modified search behaviour in VFS: use name # without extension for matching. # 11.02.2011 - 0.3 - Bugfix/Change in regsub in defaultProvider # (exec -- prog didn't work). # # Purpose : Extended exec: a trap will be called for each 'couldn't...'-error, # so a mechanism can be implemented to PROVIDE THE MISSING FILES, # e.g. by copying them out of the VFS. # # This is the (somewhat incompatible) successor of execx # (see http://wiki.tcl.tk/14944), which doesn't support command # pipes. The original version couldn't be improved any further, # because it's nearly impossible to follow the whole exec syntax. # # A STANDARD CALLBACK gets installed by default, so that in normal # cases this code can be used just the same way as execx, with one # important difference: it's not possible anymore to force the use # of VFS files, because this code relies on errors from exec, and # those errors won't get fired if files where already present in FS. # The search within the VFS only looks in subdirs bin and tools, # and only in the first level. Should/could be extend for recursive # searches. # # Copyright: You can use this code under the following terms: # - Don't blame me for any (direct or indirect) error; # - Mention me as the original author of this code. # # Possible Problems: the RE to match the erranous element names in exec probably # isn't perfect, neither the second (in regsub). # ################################################################################ package provide execx2 0.30 namespace eval execx2 { variable cleanup [list]; # holds the names of temp files for later cleanup # Notice: the following is subject to changes with each tcl version! variable re {^couldn't (execute|read file|write file) "([^"]*)": no such file or directory$} variable cb "defaultProvider" # Register a callback proc which is responsible to handle missing files. # The callback will be called from exec with two args: filename operation. # defaultProvider is automatically registered as the default callback. # proc callback {args} { variable cb if {[llength $args]} { set cb $args; # set oder clear callback } else { set cb; # get current callback } } # For convenience: delete temporary files (main programs should wait # until all processes have finished!) # proc cleanup {} { variable cleanup catch {eval file delete -force -- $cleanup} } # The main routine, serves as an replacement for the original exec. # proc exec {args} { variable re variable cb while 1 { set code [catch {uplevel exec $args} rc] # Attention: for each error, the callback is triggered again... if {![string equal $cb ""]} { if {$code == 1} { if {[regexp $re $rc m o p]} { set pn $p if {![catch {set pn [$cb $p $o]}]} { if {![string equal $p $pn]} { # set args [string map [list $p $pn] $args]; # v0.1 # pipe symbol | or |&, eventually followed by blank, # followd by cmdword; or cmdword at the very beginning # v0.3: handle -- progname # cmdword ends at word boundary set re2 [format {(\|{1}&?[[:blank:]]?|^|--[[:blank:]]+)(%s)\M} $p] regsub -- $re2 $args "\\1$pn" args; # -all continue } } } } } return -code $code $rc; # Notice: no more autocleanup as with execx } } # Built in callback for some compatibility with execx: # Checking $::starkit::topdir/bin and /tools for the missing file. Within, # looking for files or directories which match the given rootname (1st match wins). # The file extensions is ignored for the search. # proc defaultProvider {f o} { variable cleanup if {[string equal $o "write file"]} { return $f; # not usefull here } set rootDir .. catch {set rootDir $::starkit::topdir} set progName [file tail $f] foreach dir {bin tools} { set toolDir [file join $rootDir $dir] # extension is unknown, first match counts! # Notice: glob works case sensitive within VFS!? set match [lindex [glob -nocomplain -dir $toolDir [file rootname $progName]*] 0] # Notice: [file normalize] doesn't work within VFS!? if {[string length $match]} { break } elseif {[string equal $dir "tools"]} { # undocumented chained hook for another fetch method catch {set f [httpProvider $f $o]} return $f; # no equivalent found in VFS } } set temp . catch {set temp $::env(tmp)}; # formerly only used $::env(temp) set dest [file join $temp [file tail $match]] # copy file or folder... if {![file exists $dest]} { # ...if not alreay present in destination if {[catch {eval [list file copy -force -- $match $temp]}]} { return $f; # do not yet propagate errors from here } elseif {[lsearch $cleanup $dest] < 0} { lappend cleanup $dest; # eventually better use an array } } if {[file isdirectory $match]} { set dest [file join $dest [file tail $match]] } return $dest } } #------------------------------------------------------------------------------- ====== ---- See [execx] for the predecessor and some more comments. ---- [JOB] Seems to be that we both had the same problem at the same time. See as well [Executing programs which are shipped within starpacks] for another approach. I also took a look to [execx] but it was not that clear for me, so I coded something similar. Thank's anyway for your contribution, which helped me a lot. Maybe the "recursive scan" to find files in the vfs (see above link) could be integrated here as well? [MHo]: Yes, perhaps, I'll look at it. The relevant files are always at the same positions within my VFSs, so I only scan in the subfolders ''bin'' and ''tools'', but not recursively yet. <> Starkit | Tclkit | Deployment