
proc runExe {args} {
    if {![llength $args]} {
	error "runExe 'run|stop|cleanup|running' ?'executable and parameters'? ?-mode 'r|r+|w|w+'? \
		?-blocking 'true|false'? ?-callback 'proc %m'? ?-timeout 'seconds'? \
		?-outputVar 'varname'?";	
    }
    
    set options {run stop cleanup running};
    set option  [lindex $args 0];
    set args    [lrange $args 1 end];
    
    if {[set idx [lsearch -glob $options ${option}*]] >= 0} {
	return [eval runExe::[lindex $options $idx] $args];
    }
    
    error "bad option \"$option\": must be [join [linsert [join [lsort -dictionary $options] {, }] end-1 {or}]]";
}

namespace eval ::runExe {
    variable executables;
    
    proc this {} "return [namespace current];";
    
    # proc run
    #
    # args
    #
    #  executable - name of the executable and all parameters
    #  -mode       - access mode to the pipe to be created (r, r+, w, or w+)
    #  -blocking   - flag to signal if this proc should wait until the executable
    #               is finished
    #  -callback   - script to be executed to prepare the execution, to return input
    #               for the executable, to get output of the executable, to be the
    #               execution finish callback. Must be given, if blocking is disabled!
    #  -timeout    - double value in seconds, 0 disables the timeout handler
    #  -outputVar  - (optional) name of the name of a variable to contain the
    #               output of the executable
    #
    #  proc run {executable mode blocking callback timeout {outputVar ""}} 
    proc run {executable args} {
	array set options {
	    -mode "r"
	    -blocking false
	    -callback ""
	    -timeout 0
	    -outputVar ""
	    -isfile 0
	}
	array set options $args
	foreach var {mode blocking callback timeout outputVar} {
	    set $var $options(-$var)
	}
	if {[lsearch -exact {r r+ w w+} $mode] < 0} {
	    error "bad mode \"$mode\": must be r, r+, w, or w+";
	}

	if {![string is boolean -strict $blocking]} {
	    error "expected valid boolean as blocking flag, but got \"$blocking\"";
	}

	if {![string is double -strict $timeout]} {
	    error "expected valid double as timeout in seconds, but got \"$timeout\"";
	}

	if {!$blocking && ($callback == "")} {
	    error "expected callback script, because blocking is disabled";
	}

	# (re)set the variable to store outputs of the executable in
	#
	if {$outputVar != ""} {
	    global $outputVar;

	    set $outputVar  "";
	}

	if {![string is boolean -strict $options(-isfile)]} {
	    error "expected valid boolean as isfile flag, but got \"$options(-isfile)\"";
	}

	# do preparations to be done before starting the executable
	#
	if {$callback != ""} {
	    execCallback $callback prepare $executable $blocking 0 0 $outputVar;
	}

	if { $options(-isfile) } {
	    if {[catch {set pid [open "$executable" $mode];} reason]} {
		error "couldn't open file with \"$executable\": $reason";
	    }
	} else {
	    if {[catch {set pid [open "|$executable" $mode];} reason]} {
		error "couldn't run executable with \"$executable\": $reason";
	    }
	}

	# set the process related variables
	#
	set [this]::executables($pid.executable) $executable;
	set [this]::executables($pid.success)    -1;
	set [this]::executables($pid.blocking)   $blocking;
	set [this]::executables($pid.callback)   $callback;
	set [this]::executables($pid.after)      "";
	set [this]::executables($pid.timeout)    $timeout;
	set [this]::executables($pid.outputVar)  $outputVar;

	# start if wanted the timeout handler
	#
	if {$timeout} {
	    set [this]::executables($pid.after) [after \
						     [expr {int($timeout * 1000)}] \
						     [list [this]::timeoutCB $pid] \
						    ];
	}

	# configure the process channel
	#
	fconfigure $pid -buffering none -blocking 0;

	if {[lsearch {r r+ w+} $mode] >= 0} {
	    fileevent $pid readable [list [this]::inCB $pid];
	}

	if {[lsearch {r+ w w+} $mode] >= 0} {
	    fileevent $pid writable [list [this]::outCB $pid];
	}

	# let this proc wait if blocking is wanted
	# and set the return value depending on the blocking flag
	#
	if {$blocking} {
	    if {[info commands tk] == ""} {
		vwait [this]::executables($pid.success);
	    } else {
		tkwait variable [this]::executables($pid.success);
	    }

	    set result  [set [this]::executables($pid.success)];

	    cleanup $pid;
	} elseif {!$blocking && ($callback != "")} {
	    set result $pid;
	}

	return $result;
    }

    proc stop {pid} {
	if {[running $pid]} {
	    finishCB $pid;
	}

	cleanup $pid;

	return;
    }

    proc cleanup {pid} {
	array unset [this]::executables $pid.*;

	return;
    }

    proc running {pid} {
	if {[array names [this]::executables $pid.*] == ""} {
	    return 0;
	}

	if {([file channels $pid] == "") || [eof $pid]} {
	    return 0;
	}

	return 1;
    }

    proc execCallback {callback mode executable blocking success timeout outputVar args} {
	# replace all substitutes for ...
	#    %m = execution mode of the blocking command (prepare, input, output or finished)
	#    %e = name of the executable (including all parameters)
	#    %s = success flag (boolean)
	#    %t = timeout flag (boolean)
	#    %o = output variable contents
	#    %O = name of the output variable
	#
	regsub -all -- {%m} $callback $mode callback;
	regsub -all -- {%e} $callback $executable callback;
	regsub -all -- {%b} $callback $blocking callback;
	regsub -all -- {%s} $callback $success callback;
	regsub -all -- {%t} $callback $timeout callback;
	regsub -all -- {%O} $callback $outputVar callback;

	if {$outputVar != ""} {
	    global $outputVar;

	    set output  [set $outputVar];
	} else {
	    set output  "";
	}

	regsub -all -- {%o} $callback $output callback;

	# execute the blocking command (or callback)
	#
	return [uplevel \#0 $callback $args];
    }
    
    proc finishCB {pid {timeout 0}} {
	if {[set [this]::executables($pid.after)] != ""} {
	    after cancel [set [this]::executables($pid.after)];
	}
	
	fileevent $pid readable {};
	fconfigure $pid -blocking 1;
	
	if {[catch {close $pid;}] || $timeout} {
	    set [this]::executables($pid.success)  0;
	} else {
	    set [this]::executables($pid.success)  1;
	}
	
	# set the output variable, if given
	#
	set outputVar  [set [this]::executables($pid.outputVar)];
	
	if {$outputVar != ""} {
	    global $outputVar;
	    
	    set $outputVar  [join [set $outputVar] "\n"];
	}
	
	# execute the callback, if set
	#
	set callback  [set [this]::executables($pid.callback)];
	
	if {$callback != ""} {
	    execCallback \
		$callback \
		finished \
		[set [this]::executables($pid.executable)] \
		[set [this]::executables($pid.blocking)] \
		[set [this]::executables($pid.success)] \
		$timeout \
		[set [this]::executables($pid.outputVar)];
	}
	
	return;
    }
    
    proc inCB {pid} {
	if {[string equal $::tcl_platform(platform) "unix"] ||
	    ![llength [info commands .central.s]]} {
	    if {[file channels $pid] == ""} {
		return;
	    }
	}
	
	if {[eof $pid]} {
	    finishCB $pid;
	} else {
	    set outputVar  [set [this]::executables($pid.outputVar)];
	    
	    if {$outputVar != ""} {
		upvar #0 $outputVar dummy;
	    }
	    
	    lappend dummy  [set output [read $pid]];
	    
	    if {$output != ""} {
		execCallback \
		    [set [this]::executables($pid.callback)] \
		    output \
		    [set [this]::executables($pid.executable)] \
		    [set [this]::executables($pid.blocking)] \
		    [set [this]::executables($pid.success)] \
		    [set [this]::executables($pid.timeout)] \
		    [set [this]::executables($pid.outputVar)] \
		    $output;
	    }
	}
	
	return;
    }
    
    proc outCB {pid} {
	if {[file channels $pid] == ""} {
	    return;
	}
	
	if {[eof $pid]} {
	    finishCB $pid;
	} else {
	    puts $pid [execCallback \
			   [set [this]::executables($pid.callback)] \
			   input \
			   [set [this]::executables($pid.executable)] \
			   [set [this]::executables($pid.blocking)] \
			   [set [this]::executables($pid.success)] \
			   [set [this]::executables($pid.timeout)] \
			   [set [this]::executables($pid.outputVar)] \
			  ];
	    
	    flush $pid;
	}
	
	return;
    }
    
    proc timeoutCB {pid} {
	if {[file channels $pid] != ""} {
	    finishCB $pid 1;
	}
	
	return;
    }
    
    namespace export [list run stop cleanup running];
}
