Tk Library Source Code

Attachment Details
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Line Numbers Raw
Overview

Artifact ID: a8d3cbf9e71c6d6281e6d05480a8e2a55d87cca9
Ticket: 429388ffffffffffffffffffffffffffffffffff
Date: 2001-06-02 00:59:33
User: nobody
Artifact Attached: 5280a33ab193256cb680c1efb2804f3cbbd0362a
Filename:execCmd.txt
Description:Text file contining procedures
Content:
     1
     2
     3
     4
     5
     6
     7
     8
     9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
   100
   101
   102
   103
   104
   105
   106
   107
   108
   109
   110
   111
   112
   113
   114
   115
   116
   117
   118
   119
   120
   121
   122
   123
   124
   125
   126
   127
   128
   129
   130
   131
   132
   133
   134
   135
   136
   137
   138
   139
   140
   141
   142
   143
   144
   145
   146
   147
   148
   149
   150
   151
   152
   153
   154
   155
   156
   157
   158
   159
   160
   161
   162
   163
   164
   165
   166
   167
   168
   169
   170
   171
   172
   173
   174
   175
   176
   177
   178
   179
   180
   181
   182
   183
   184
   185
   186
   187
   188
   189
   190
   191
   192
   193
   194
   195
   196
   197
   198
   199
   200
   201
   202
   203
   204
   205
   206
   207
   208
   209
   210
   211
   212
   213
   214
   215
   216
   217
   218
   219
   220
   221
   222
   223
   224
   225
   226
   227
   228
   229
   230
   231
   232
   233
   234
   235
   236
   237
   238
   239
   240
   241
   242
   243
   244
   245
   246
   247

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"
        }
    }
}
This page was generated in about 0.002s by Fossil 2.29 [912711f044] 2026-10-17 13:14:07