Tcl 使puts记录输出的示例代码

我正在寻找一些Tcl代码，它可以将命令发送到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?)

日志低级别是否使用puts？那可能是你的无限循环

如果是，请尝试将其更改为使用puts。

日志低级别是否使用puts？那可能是你的无限循环

如果是的话，试着把它改为使用Po.P.< /P>

，因为选项很少，所以考虑ARG的数量可能比较容易。此外，您应该包含对新puts proc的原始puts的所有使用-这个新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
}

由于选项很少，所以考虑ARG的数量可能比较容易。此外，您应该包含对新puts proc的原始puts的所有使用-这个新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
}

---

谢谢你的意见。我只想发布最终的工作代码以供参考。它甚至可以正确地存储带有-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
    }
}

---

谢谢你的意见。我只想发布最终的工作代码以供参考。它甚至可以正确地存储带有-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
    }
}

---

就是这样，这就是问题所在。谢谢，就是这样，这就是问题所在。非常感谢。