stdout redirection

问题:

I am working with a procedure in tcl over which I have no control. It puts out a lot of verbose on the output window like:

Response:<?xml version='1.0' encoding='UTF-8'?><soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"><soapenv:Body><soapenv:Fault><faultcode>soapenv:Server</faultcode><faultstring>Item not valid: The specified Standard SIP1 Profile was not found</faultstring><detail><axlError><axlcode>5007</axlcode><axlmessage>Item not valid: The specified Standard SIP1 Profile was not found</axlmessage><request>updatePhone</request></axlError></detail></soapenv:Fault></soapenv:Body></soapenv:Envelope>

Is there any way i can redirect this stdout to a variable? I am new to tcl and am not aware how i can do this.

回答1:

If you are using Tcl 8.6, you can trap all the output to stdout by adding a suitable transform via chan push:

# Use a class to simplify the capture code
oo::class create CapturingTransform {
    variable var
    constructor {varName} {
        # Make an alias from the instance variable to the global variable
        my eval [list upvar \#0 $varName var]
    }
    method initialize {handle mode} {
        if {$mode ne "write"} {error "can't handle reading"}
        return {finalize initialize write}
    }
    method finalize {handle} {
        # Do nothing, but mandatory that it exists
    }

    method write {handle bytes} {
        append var $bytes
        # Return the empty string, as we are swallowing the bytes
        return ""
    }
}

# Attach an instance of the capturing transform
set myBuffer ""
chan push stdout [CapturingTransform new myBuffer]

# ... call the problem code as normal ...

# Detach to return things to normal
chan pop stdout

Things to note: this captures all output on the channel, however produced (it even works across threads or where the output is generated at the C level), and this puts bytes into myBuffer as the capturing is applied after the conversion to the channel's configured encoding. And it requires 8.6; the API concerned wasn't exposed to scripts in earlier versions (though it's C-equivalent was used by some extensions for things such as SSL support).

回答2:

Always the same question..

You have a few options:

• Write a Tcl Extension in C that exposes Tcl_SetStdChannel to script level. Probably one of the better solutions, but not that easy.

• Rename and replace puts. For most output that comes from libs that write to stdout without being asked for this should be good enough. But there are a lot of other ways how someone could write something to stdout, e.g. chan puts, fcopy, exec echo foo >@stdout. I think that it is hard to rewrite all possible places where a channel can be used.

• Remove stdout from the interp. Downside is that you don't get the output. You can get stdout back after the procedure has run. For example:

  set tint [interp create]
  interp transfer {} stdout $tint
  ... call your stuff here...
  interp share $tint stdout {}
  interp delete $int
  

  Note that you should probably not create the interp each time you need that. Create one once, and reuse it.

回答3:

Here is a quirky work-around: by using exec to call the script the second time and capture the output. Here is a simplified example:

#!/usr/bin/env tclsh

# How can I call a procedure, which produces stdout output, and capture
# stdout?

proc produce_output {} {
    puts "Goodbye Friday"
    puts "Hello, weekend"    
}

if {[lindex $::argv 0] == "-run"} {

    # If command line contains a special flag, run the procedure in
    # question
    produce_output

} else {

    # By default, we will run this script again, with a special flag
    # and capture the output

    set output [exec tclsh [info script] -run]
    puts "Output: >$output<"

}

This method is quirky because it might not be a a good idea to run the script twice. For example, if part of the script update some database tables...

回答4:

Depends on what you mean by "puts ... on the outpt window".

If it "puts ... on the output window", that is, prints the data, it's possible to capture the output.

If it merely produces that value, and it's printed by some other means, do what @Edu suggested.

回答5:

set output "[procedure_that_creates_the_output]"

Anything between the square brackets is a nested command that is evaluated and it's result is used in the outer command. So, in above the output of the procedure is inserted between the quotation marks and thus made a string which is then saved to the output variable.

proc addition {x y} {                                                           
    return [expr $x+$y]                                                         
}                                                                               

set result [addition 2 3]                                                       
puts $result                                                                   

Here we first resolve the value of [addition 2 3]which runs proc addition with x as 2 and y as 3. It returns their sum which is calculated in another nested expression and that result 5 then replaces [addition 2 3] in the outer script which becomes set result 5.

回答6:

if the tcl procedure is writing to stdout using puts then it is a simple matter of redefining puts. After coding this it would be even simpler if you required the input variable to be global; however as it is it will change the correct variable by the stack frame it is in.

proc stdout2var { var } { 
    set level [ info level ]
    # we may have called stdout2var before so this allows only one variable at a time
    # and preserves tcls original puts in putsorig 
    if { [ string length [info commands "putsorig" ] ]  == 0 } { 
        rename ::puts ::putsorig
    } 
    eval [subst -nocommands {proc ::puts { args } { 
    set fd stdout 
    # args check 
    switch -exact -- [llength \$args ] {
        1 { 
        set fd stdout
        } 
        2 { 
        if { ![string equal \"-nonewline\" [lindex \$args 0 ] ] } {
            set fd [lindex \$args 0 ]
        }
        }
        3 {
        set fd [lindex \$args 1 ]
        }
        default { 
        error \"to many or too few args to puts must be at most 3 ( -nonewline fd message )\" 
        }
    }
    # only put stdout to the var 
    if { [string equal \"stdout\" \$fd ] } {
           # just level and var are subst 
        set message [lindex \$args end ]
        uplevel [expr { [info level ] - $level + 1 } ] set $var \\\"\$message\\\"
    } else {
        # otherwise evaluate with tcls puts 
        eval ::putsorig \$args 
    }
    } } ]
} 

proc restorestdout { } {
    # only do rename if putsorig exists incase restorestdout is call before stdout2var or 
    # if its called multiple times
    if {  [ string length [ info commands "putsorig"] ] != 0  } { 
    rename ::puts ""
    rename ::putsorig ::puts 
    } 
}

# so for some test code . because we cannot write to stdout we need to write to stderr. 
# puts on level 1 
proc myproc { a b } { 
    puts "$a $b " 
} 
# example with some deeper levels now puts is on level 2 
proc myUberProc { c } {
    myproc "a" $c
}
# this prints Ya Hoo to stdout
myproc "Ya" "Hoo"
set x ""
stdout2var x 
#puts "====\n[ info body putter ]\n===="
puts stdout " Hello" 
puts stderr "x = $x"; # x = Hello\n
puts -nonewline stdout " Hello" 
puts stderr "x = $x"; # x = Hello
myproc "Ya" "Hoo" 
puts stderr "x = $x" ; # x = Ya Hoo\n
set y "" 
stdout2var y
myUberProc "Zip"
puts stderr "y = $y , x = $x" ; # y = a Zip , x = Ya Hoo\n
restorestdout 
# now writes to stdout 
puts "y = $y , x = $x" ; # y = a Zip , x = Ya Hoo\n

output should be :

Ya Hoo 
x =  Hello
x =  Hello
x = Ya Hoo 
y = a Zip  , x = Ya Hoo 
y = a Zip  , x = Ya Hoo