tcl - stdout redirection

Question

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.

score 7 · Accepted Answer

如果您使用的是 Tcl 8.6，则可以stdout通过添加合适的转换来捕获所有输出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

需要注意的事项：这会捕获通道上的所有输出，无论是如何产生的（它甚至可以跨线程工作或在 C 级别生成输出的位置），并且这会将字节放入myBuffer，因为在转换为通道的配置编码后应用捕获. 它需要8.6；相关的 API 在早期版本中没有暴露给脚本（尽管它的 C 等效项被某些扩展用于诸如 SSL 支持之类的东西）。

score 2 · Accepted Answer

总是同一个问题。。

你有几个选择：

用 C 语言编写一个暴露Tcl_SetStdChannel于脚本级别的 Tcl 扩展。可能是更好的解决方案之一，但并不那么容易。
重命名和替换puts. 对于大多数来自写入标准输出的库而不被要求这样做的输出应该足够好。但是还有很多其他方法可以让某人将某些内容写入标准输出，例如chan puts, . 我认为很难重写所有可能使用通道的地方。fcopyexec echo foo >@stdout
从 interp 中删除 stdout。缺点是你没有得到输出。程序运行后，您可以取回标准输出。例如：
```
set tint [interp create]
interp transfer {} stdout $tint
... call your stuff here...
interp share $tint stdout {}
interp delete $int
```
请注意，您可能不应该在每次需要时都创建 interp。创建一次，然后重复使用。

score 2 · Accepted Answer

这是一个古怪的解决方法：通过exec第二次调用脚本并捕获输出。这是一个简化的示例：

#!/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<"

}

这种方法很古怪，因为两次运行脚本可能不是一个好主意。例如，如果部分脚本更新了一些数据库表......

score 0 · Accepted Answer

如果 tcl 过程使用 puts 写入标准输出，那么重新定义 puts 就很简单了。在编码之后，如果您要求输入变量是全局的，那就更简单了；然而，它会通过它所在的堆栈帧更改正确的变量。

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

输出应该是：

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

score 0 · Accepted Answer

取决于您所说的“将...放在输出窗口上”的意思。

如果它“将...放在输出窗口上”，即打印数据，则可以捕获输出。

如果它仅产生该值，并且通过其他方式打印，请执行@Edu 的建议。

score 0 · Accepted Answer

set output "[procedure_that_creates_the_output]"

方括号之间的任何内容都是一个被评估的嵌套命令，其结果用于外部命令。因此，在上面，过程的输出被插入在引号之间，从而形成了一个字符串，然后将其保存到输出变量中。

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

set result [addition 2 3]                                                       
puts $result

在这里，我们首先使用 x 为 2 和 y 为 3 来解析[addition 2 3]运行 proc 加法的值。它返回它们的总和，该总和在另一个嵌套表达式中计算，然后结果 5[addition 2 3]在外部脚本中替换为set result 5.

tcl - stdout redirection

6 回答 6

Related

Reference