Attachment "execCmd.txt" to
ticket [429388ffff]
added by
nobody
2001-06-02 00:59:33.
proc execCmd {commandstring {args ""}} {
# The execCmd procedure replaces Tcl "exec" and "catch {exec}" commands
# in order to allow external command to be executed with the flexibility
# of obtaining the return code of the command and processing the
# standard error and output messages of the command independently.
#
# Standard output and error messages may be reported to stdout/stderr
# as the command runs, may be sent to same or different channel pointers,
# or may be saved in the same or different variables.
#
# Standard error/output messages do not imply success or failure of
# the command. The procedure may wait for the command to complete or
# may return immediately and inform the calling proc later when the
# command completes.
#
# Syntax:
# execCmd "commandstring" [-arg1 value1] [-arg2 value2] ...
# (note that commandstring may include ksh symbols |, >, <, >&, etc)
#
# Optional arguments:
# -outvar var variable to receive stdout of command
# -errvar var variable to receive stderr of command
# -outerr var variable to receive stdout or stderr (success/fail)
# -outfp fp channel to receive stdout of command
# -errfp fp channel to receive stderr of command
# -waitvar var variable to receive return code upon completion
# (must be globabl variable)
# -pidlistvar var variable to receive list of process ids from the
# command string (used with -waitvar)
#
# Return code:
# Return code of the execCmd procedure is that of the command executed.
# If the procedure does not wait for the command to complete (using the
# (-waitvar argument), this procedure will always return 0.
#
# Examples:
# 1. Run command and send output to stdout/stderr channels:
# set rc [execCmd "mycommand"]
#
# 2. If command return code is 0, saves stdout in result. Else, saves
# stderr to result:
# set rc [execCmd "mycommand" -outerr result]
#
# 3. Output of command sent to channel fp and stderr is captured
# in variable result:
# set rc [execCmd "mycommand" -outfp fp -errvar result]
#
# 4. Execute command in background and capture return code when complete:
# global rc
# execCmd "mycommand" -outfp result -errfp result -waitvar rc
# (do other stuff here)
# vwait rc
# or:
# global rc
# set rc ""
# execCmd "mycommand" -outfp result -errfp result -waitvar rc
# while 1 {
# if {$rc != ""} break
# (keep doing other stuff here)
# }
global runcmdrc runcmdout runcmderr
# Parse arguments
set outfp ""
set errfp ""
set outerr 0
set errvar 0
set outvar 0
set waitvar ""
set runcmdrcvar runcmdrc
set outvarname ""
set errvarname ""
set runcmderrvar runcmderr
set runcmdoutvar runcmdout
set pidlistvar ""
array set var $args
foreach ix [array names var] {
switch -- $ix {
-waitvar {
set waitvar $var(-waitvar)
global $waitvar
set runcmdrcvar $waitvar
}
-pidlist {
set pidlistvar $var(-pidlist)
upvar $pidlistvar pidlist
}
-outerr {
set outvarname $var(-outerr)
set outerr 1
set outvar 1
set errvar 1
}
-errout {
# Same as outerr
set outvarname $var(-errout)
set outerr 1
set outvar 1
set errvar 1
}
-errvar {
set errvarname $var(-errvar)
set errvar 1
}
-outvar {
set outvarname $var(-outvar)
set outvar 1
}
-outfp {set outfp $var(-outfp)}
-errfp {set errfp $var(-errfp)}
}
}
if {$waitvar != ""} {
# If waitvar is set and user provided variables to store the
# output in, must define them as globals
if {$outvar} {
global $outvarname
set runcmdoutvar $outvarname
}
if {$errvar && !$outerr} {
global $errvarname
set runcmderrvar $errvarname
}
if {$outerr} {
set runcmderrvar $outvarname
}
}
unset args var
set $runcmdrcvar ""
set $outvarname ""
set $errvarname ""
set runcmderr ""
set runcmdout ""
# If no options provided, output to stdout and stderr
if {$outfp == "" && $outvar == 0} {set outfp stdout}
if {$errfp == "" && $errvar == 0} {set errfp stderr}
pipe runcmdrpipe runcmdwpipe
fconfigure $runcmdrpipe -blocking 0 -buffering line
fconfigure $runcmdwpipe -blocking 0 -buffering line
fileevent $runcmdrpipe readable [list readExecCmd $runcmdrpipe $errfp\
$runcmdrcvar $runcmdrpipe $runcmdwpipe $runcmderrvar]
if [catch {open "|$commandstring 2>@$runcmdwpipe"} runcmdfp] {
if {$errfp != ""} {puts $errfp $runcmdfp}
{set $errvarname $runcmdfp}
return 1
} else {
# Set callers variable to list of process ids of this command
if {$pidlistvar != ""} {
set $pidlistvar [pid $runcmdfp]
}
# Call readExecCmd proc to capture command output.
fconfigure $runcmdfp -blocking 0 -buffering none
fileevent $runcmdfp readable [list readExecCmd $runcmdfp $outfp\
$runcmdrcvar $runcmdrpipe $runcmdwpipe $runcmdoutvar]
if {$waitvar != ""} {
# Calling proc doesnt want to wait until the command completes.
# Caller will watch for the return code to be set in the
# waitvar variable.
return 0
}
# Wait for command to complete
vwait $runcmdrcvar
}
if {$outerr} {
# Set output to either stdout or stderr depending on the return
# code of the command
catch {unset cmdresult}
upvar $outvarname cmdresult
if {$runcmdrc} {
set cmdresult $runcmderr
} else {
set cmdresult $runcmdout
}
} else {
# If user provided variables for stdout and stderr of command,
# set those variables to the output
catch {unset cmdresult}
if {$outvar} {
upvar $outvarname cmdresult
set cmdresult $runcmdout
}
if {$errvar} {
upvar $errvarname cmdresult
set cmdresult $runcmderr
}
}
# Return with return code of the command
return $runcmdrc
}
proc readExecCmd {fp outfp rcvar rpipe wpipe {outvar ""}} {
# Read output from command and save in variables or send to
# channels. Capture exit code of command upon completion.
global errorCode $rcvar
if {$outvar != ""} {
global $outvar
}
if [eof $fp] {
# Process no more fileevents for stdout
catch {fileevent $fp readable {}}
# Process remaining fileevents in case there is stderr pending,
# then close stderr channel
update
catch {fileevent $rpipe readable {}}
catch {close $rpipe}
catch {close $wpipe}
# Close stdout channel and get command return code
set errorCode ""
fconfigure $fp -blocking 1
catch {close $fp}
set rc [lindex $errorCode 2]
if [string match SIG* $rc] {
set rc 99
}
if {$rc == ""} {set rc 0}
set $rcvar $rc
return
}
if {[gets $fp line] < 0} return
if {$outfp != ""} {
# Send output to channel
puts $outfp $line
}
if {$outvar != ""} {
# Append output to output variable
if {[returnVar $outvar] == ""} {
set $outvar $line
} else {
append $outvar "\n$line"
}
}
}
