Version 12 of execx2

Updated 2009-06-29 15:01:59 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 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 {} {
        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]
                                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.


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.