пример кода для того, чтобы поставить журнал вывода

Я ищу код Tcl, который дублировал бы то, что помещает команда отправляет на стандартный вывод в какой-либо файл журнала. Да, есть возможность изменить все вызовы 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?)

tcl
person user1476056    schedule 25.07.2012    source источник


Ответы (3)


log_low_level использует puts? Это может быть ваш бесконечный цикл.

Если это так, попробуйте изменить его, чтобы использовать _puts.

person Ergwun    schedule 25.07.2012
comment
Вот именно, в этом была проблема. Спасибо. - person user1476056; 25.07.2012

Спасибо за баллы. Я просто хочу опубликовать окончательный рабочий код для справки. Он даже правильно хранит строки с флагом -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
    }
}
person user1476056    schedule 25.07.2012

Поскольку puts имеет очень мало вариантов, может быть проще рассмотреть число заданных аргументов. Кроме того, вы должны включить все случаи использования оригинального _puts в вашу новую процедуру 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
}
person glenn jackman    schedule 25.07.2012