Tcl Source Code

Artifact 7671b30ba682ad08fa7967130d4842c08a999ec4:

Attachment "t.tcl" to ticket [439114ffff] added by chris_nelson 2001-07-06 23:52:52.

---

proc PtiExecReadResults { fid outCmd } {
    global PtiExec

    # Grab the next line of output from the open pipe.
    set line [read $fid]

    # Store the output for [ptiExec].
    append PtiExec(FioOut) $line

    # Write the results (to stdout, stderr, or noop)
    $outCmd $line

    # Check for EOF.
    if { [eof $fid] } {
        puts stderr "Got EOF on $fid"
        set PtiExec(FioStatus) [catch { close $fid } status]
        puts stderr "\tSet FioStatus to $PtiExec(FioStatus)\
                from catch of close"
        puts stderr "\terrorCode:$::errorCode"
        set PtiExec(FioDone) 1
    }
}
#

proc ptiToStdout { line } {
    puts -nonewline "<<$line>>"
    flush stdout
}

# Works
proc works { } {
    set fid [open "|child 2>@stderr" r]

    fileevent $fid readable [list PtiExecReadResults $fid ptiToStdout]
    vwait ::PtiExec(FioDone)

    puts stderr "PtiExec(FioStatus):$::PtiExec(FioStatus)"
}

proc fails { } {
    set fid [open "|child 2>@stderr" r]

    fconfigure $fid -buffering none -blocking 0 -translation binary
    fconfigure stdout -buffering none -blocking 0 -translation binary

    fileevent $fid readable [list PtiExecReadResults $fid ptiToStdout]
    vwait ::PtiExec(FioDone)

    puts stderr "PtiExec(FioStatus):$::PtiExec(FioStatus)"
}