Question

我正在处理tcl中我无法控制的过程。它在输出窗口上输出了很多详细信息，如：

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>

有什么方法可以将这个标准输出重定向到一个变量？我是tcl的新手，我不知道怎么做到这一点。

Answer 1

如果您使用的是Tcl 8.6，则可以通过chan push添加合适的转换，将所有输出捕获到stdout：

# 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级别生成输出），这会使 bytes < / em>进入myBuffer，因为在转换为通道配置的编码后应用捕获。它需要8.6;相关的API没有暴露给早期版本的脚本（尽管某些扩展使用了C等价物来支持SSL支持）。

Answer 2

始终是同一个问题..

您有几个选择：

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

Answer 3

这是一个古怪的解决方法：通过使用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<"

}

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

Answer 4

取决于你的意思＆＃34;把...放在外面的窗口＆＃34;。

如果＆＃34;将...放在输出窗口＆＃34;上，即打印数据，则可以capture the output。

如果只是产生了这个价值，并且通过其他方式打印出来，那就去做@Edu所建议的。

Answer 5

set output "[procedure_that_creates_the_output]"

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

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

set result [addition 2 3]                                                       
puts $result

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

Answer 6

如果tcl过程使用puts写入stdout，则重新定义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

标准重定向

6 个答案: