################################################################################
#
# Modul    : execx2.tcl
# Version  : 0.3
# Date     : 11.02.2011
# Author   : M.Hoffmann
# Wikipage : https://wiki.tcl-lang.org/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 https://wiki.tcl-lang.org/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
    }
}

#-------------------------------------------------------------------------------