1

我正在寻找一些 Tcl 代码，它们会将puts命令发送到 stdout 的内容复制到某个日志文件中。是的，有可能将所有对 puts 的调用更改为某个自定义函数。但我想让它尽可能透明。我有这个试用代码，但它并不能很好地工作：

set pass_log_output "0"

rename puts _puts
proc puts { args } {
    global pass_log_output

    if {[info exists pass_log_output]} {
        # There can be several cases:
        # -nonewline parameter, stdout specified or not
        set stdout_dest [ lsearch $args stdout ]
        set nonewline [ lsearch $args -nonewline ]
        if { $stdout_dest != -1 } {
            log_low_level "" [lindex $args [expr $stdout_dest + 1]] ""
        } elseif { $nonewline != -1 && [ llength $args ] > 1} {
            log_low_level "" [lindex $args [expr $nonewline + 1]] ""
        } else {
            log_low_level "" [lindex $args 0] ""
        }
    }

    if { [ catch { eval _puts $args } err ] } {
        return -code error $err
    }
}

log_low_level 函数只是将传递的字符串存储在文件中。到目前为止，我收到此错误：

Tcl Interpreter Error: too many nested evaluations (infinite loop?)
4

3 回答 3

3

log_low_level用吗puts？那可能是你的无限循环。

如果是这样，请尝试将其更改为使用_puts.

于 2012-07-25T07:09:20.603 回答
2

感谢您的积分。我只想发布最终的工作代码以供参考。它甚至可以正确处理带有 -nonewline 标志的存储行。

set pass_log_output "0"
set last_call_nonewline 0

rename puts _orig_puts
proc puts { args } {
    global pass_log_output
    global g_log_file
    global last_call_nonewline

    if {[info exists pass_log_output]} {
        # Check if the logging was initialized
        if {![info exists g_log_file]} {
            _orig_puts "Log file wasn't initialized!"
            return
        }

        # There can be several cases:
        # -nonewline parameter, stdout specified or not
        set stdout_dest [ lsearch $args stdout ]
        set nonewline [ lsearch $args -nonewline ]
        if {[ llength $args ] > 3} {
            return -code error "wrong # args: should be puts ?-nonewline? ?channelId? string"
        } elseif { $stdout_dest != -1 } {
            set message [lindex $args end]
        } elseif { $nonewline != -1 && [ llength $args ] == 2} {
            set message [lindex $args [expr $nonewline + 1]]
        } elseif {[ llength $args ] == 1} {
            set message [lindex $args 0]
        }

        # Store the message in the file, if needed.
        # Take into account if the last call was with -nonewline
        if {[info exists message]} {
            if {$last_call_nonewline == 0} {
                _orig_puts -nonewline $g_log_file [clock format [clock seconds] -format "%T - "]
            }
            if {$nonewline != -1} {
                set last_call_nonewline 1
                _orig_puts -nonewline $g_log_file "$message"
            } else {
                set last_call_nonewline 0
                _orig_puts $g_log_file "$message"
            }
            flush $g_log_file
        }
    }

    if { [ catch { eval _orig_puts $args } err ] } {
        return -code error $err
    }
}
于 2012-07-25T18:36:02.703 回答
1

由于puts选项很少，因此可能更容易考虑给定的参数数量。此外，您应该在新的 puts proc 中包含原始的所有用途_puts——这个新的 puts 甚至对您的代码也应该是透明的。

我假设您只想将正在写入的内容记录到标准输出

rename puts _orig_puts
proc puts {args} {
    switch -exact [llength $args] {
        3 {
            # both -newline and a channelId are given
            set do_log [expr {[lindex $args 1] eq "stdout"}]
        }
        2 {
            # only log if not writing to stdout
            set chan [lindex $args 0]
            set do_log [expr {$chan eq "-nonewline" || $chan eq "stdout"}]
        }
        1 {
            set do_log true
        }
        default {
            error {wrong # args: should be "puts ?-nonewline? ?channelId? string"}
        }
    }
    if {$do_log} {
        set chan [open $::mylogfile a]
        _orig_puts $chan [lindex $args end]
        close $chan
    } 
    _orig_puts {*}$args
}
于 2012-07-25T14:30:24.153 回答