[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 be for any (direct or indirect) error; # - Mention me as the original author of this code. # Ideas : Support a chain of callbacks (if really neccessary). ################################################################################ package provide execx2 0.10; # where to put these best? namespace eval execx2 { variable cb "" variable re {^couldn't (execute|read file|write file) "([^"]*)": no such file or directory$} # Register a callback proc which is later responsible to handle missing files. # The callback will be called with two arguments: filename operation. proc callback {args} { variable cb if {[llength $args]} { set cb $args ; # set oder clear callback } else { set cb ; # get current callback } } proc exec {args} { variable re while 1 { set code [catch {uplevel exec $args} rc] # Attention: for each error, the callback is triggered again... if {$code == 1} { if {[regexp $re $rc m o p]} { set pn $p if {![catch {set pn [[callback] $p $o]}]} { if {![string equal $p $pn]} { set args [string map [list $p $pn] $args] continue } } } } return -code $code $rc } } proc defaultProvider {f o} { # to be done } callback defaultProvider } #------------------------------------------------------------------------------- # testcode, to be removed later proc p0 {orgp op} { puts "orgp: $orgp" puts "op : $op" if {$orgp == "ipconfig3"} { return "ipconfig" } elseif {$orgp == "hugo"} { return "sayv hallo" } else { return -code error "";# stop callback } } puts [execx2::callback] puts [execx2::callback p0] puts [eval execx2::exec $argv] ====== ---- See [execx] for the predecessor and some more comments. ----