[MHo] This "work-in-progress"! ====== ################################################################################ # Modul : execx2.tcl # Version : 0.1 # Date : 28.06.2009 # Author : M.Hoffmann # Wikipage : http://wiki.tcl.tk/23839 # History : 0.1 first version # 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. # 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. ################################################################################ package provide execx2 0.10 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 {} { 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] 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. # 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 $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. ----