Version 2 of execx2

Updated 2009-06-28 11:07:27 by MHo

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 error from exec, and
#            those error won't get fired if the files where already present.
# 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.