Question

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

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?)

Answer 1

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

如果有，请尝试将其更改为使用_puts。

Answer 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
    }
}

Answer 3

由于puts的选项很少，因此考虑给定的args数量可能更容易。此外，您应该将原始_puts的所有用途包含在新的放置过程中 - 即使对您的代码，这个新的放置应该是透明的。

我假设你只想记录你写给stdout的东西

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
}

要生成的示例代码将log作为输出

3 个答案: