[Martin Lemburg] - 02.10.2002: To execute and control a FORTRAN executable I've chosen to use open this executable using a pipe. The only things to be done is to configure the resulting channel and to setup the event handlers for the events readable and/or writable. But ... it's true, it depends not on a FORTRAN executable, any executable could be handled like that. ---- Here the pkgIndex.tcl code: package ifneeded runExe 1.0 [list source [file join $dir runExe.tcl]]; ---- Here the package runExe code: uplevel #0 { global auto_path env; if {[lsearch -exact $auto_path [file dirname [info script]]] < 0} { lappend auto_path [file dirname [info script]]; } package provide runExe 1.0; proc runExe {args} { if {![llength $args]} { error "runExe option ?arg arg ...?"; } 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 ""}} { 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 ""; } # do preparations to be done before starting the executable # if {$callback != ""} { execCallback $callback prepare $executable $blocking 0 0 $outputVar; } if {[catch {set pid [open "|$executable" r];} 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 readable [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 {[eof $pid]} { finishCB $pid; } else { set outputVar [set [this]::executables($pid.outputVar)]; if {$outputVar != ""} { upvar #0 $outputVar dummy; } lappend dummy [set output [read $pid]]; 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 {[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]; } ----