Tcl Library Source Code

2018-02-20 Harald Oehlmann <[email protected]>

	* log.tcl: [RFE 19607f927b]: Add command log::logeval
	* log.man: to optimize expensive log message construction.
	* log.test: Bumped package version to 1.4

2013-02-01  Andreas Kupries  <[email protected]>

	*
	* Released and tagged Tcllib 1.15 ========================
	* 

2012-07-09  Andreas Kupries  <aku@hephaistos>

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin log n 1.4]
[keywords log]
[keywords {log level}]
[keywords message]
[keywords {message level}]
[copyright {2001-2009 Andreas Kupries <[email protected]>}]
[moddesc   {Logging facility}]
[titledesc {Procedures to log messages of libraries and applications.}]

none was specified.

[call [cmd ::log::loghex] [arg level] [arg text] [arg data]]

Like [cmd ::log::log], but assumes that [arg data] contains binary
data. It converts this into a mixed hex/ascii representation before
writing them to the log.

[call [cmd ::log::logsubst] [arg level] [arg msg]]

Like [cmd ::log::log], but [arg msg] may contain substitutions and variable references, which are evaluated in the caller scope first.
The purpose of this command is to avoid overhead in the non-logging case, if the log message building is expensive.
Any substitution errors raise an error in the command execution.

The following example shows an xml text representation, which is only generated in debug mode:

[example {
    log::logsubst debug {XML of node $node is '[$node toXml]'}
}]

[call [cmd ::log::logMsg] [arg text]]

Convenience wrapper around [cmd ::log::log].
Equivalent to [cmd "::log::log info text"].

[call [cmd ::log::logError] [arg text]]

# log.tcl --
#
#	Tcl implementation of a general logging facility
#	(Reaped from Pool_Base and modified to fit into tcllib)
#
# Copyright (c) 2001 by ActiveState Tool Corp.
# See the file license.terms.

package require Tcl 8
package provide log 1.4

# ### ### ### ######### ######### #########

namespace eval ::log {
    namespace export levels lv2longform lv2color lv2priority 
    namespace export lv2cmd lv2channel lvCompare
    namespace export lvSuppress lvSuppressLE lvIsSuppressed

# Results:
#	None.

proc ::log::logError {text} {
    log error $text
}

# log::logsubst --
#
#	Log a message with command and variable substitution in the caller
#	scope. The substitutions are only executed in the log case for
#	performance reasons. Any substitution errors rise a command error.
#
# Arguments:
#	level	The level of the message.
#	text	The message to log.
#
# Side Effects:
#	See above.
#
# Results:
#	None.

proc ::log::logsubst {level text} {
    variable cmdMap

    if {[lvIsSuppressed $level]} {
	# Ignore messages for suppressed levels.
	return
    }

    set level [lv2longform $level]

    set cmd $cmdMap($level)
    if {$cmd == {}} {
	# Ignore messages for levels without a command
	return
    }
    
    set text [uplevel 1 [list subst $text]]

    # Delegate actual logging to the command.
    # Handle multi-line messages correctly.

    foreach line [split $text \n] {
	eval [linsert $cmd end $level $line]
    }
    return
}

# log::Puts --
#
#	Standard log command, writing messages and levels to
#	user-specified channels. Assumes that the supression checks
#	were done by the caller. Expects full level names,
#	abbreviations are *not allowed*.

test log-13.3 {log error} {
    if {![catch {::log::log e foobar} msg]} {
	error "e is an unique abbreviation of a level name"
    }
    set msg
} {bad level "e": must be alert, critical, debug, emergency, error, info, notice, or warning.}

test log-13.4 {logsubst variable} {
    set _log_ [list]
    set logdata buz
    ::log::logsubst er {logging<$logdata>}
    set _log_
} {error logging<buz>}

test log-13.5 {logsubst command} {
    set _log_ [list]
    set logdata buz
    ::log::logsubst er {logging<[set logdata]>}
    set _log_
} {error logging<buz>}

test log-13.6 {logsubst escape} {
    set _log_ [list]
    set logdata buz
    ::log::logsubst er {1\n2}
    set _log_
} {error 1 error 2}

test log-13.7 {logsubst list} {
    set _log_ [list]
    ::log::logsubst er {1 \{2}
    set _log_
} {error 1\ \{2}

test log-13.8 {logeval evaluation error} {
    set level [catch {::log::logsubst er {[error q]} } msg]
    list $level $msg
} {1 q}

test log-13.9 {logeval no var subst on no log} {
    set _log_ [list]
    set testvar 1
    trace add variable testvar read {lappend _log_}
    # This fires
    ::log::logsubst er {$testvar}
    # This does not fire
    lappend _log_ T1
    ::log::logsubst crit {$testvar}
    trace remove variable testvar read {lappend _log_}
    unset testvar
    set _log_
} {testvar {} read error 1 T1}

test log-13.10 {logeval no command subst on no log} {
    set mylog [list]
    # This fires
    ::log::logsubst er {<[lappend mylog Test1]>}
    # This does not fire
    ::log::logsubst crit {<[lappend mylog Test2]>}
    set mylog
} {Test1}

set lastlevel warning
foreach level {alert critical debug error emergency info notice warning} {
    test log-14.0.$level {log::Puts} {
	makeFile {} test.log
	::log::lvCmdForall ::log::Puts
	::log::lvSuppressLE emergency 0

if {![package vsatisfies [package provide Tcl] 8]} {return}
package ifneeded log 1.4 [list source [file join $dir log.tcl]]

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded logger           0.9.4 [list source [file join $dir logger.tcl]]
package ifneeded logger::appender 1.3   [list source [file join $dir loggerAppender.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded logger::utils    1.3   [list source [file join $dir loggerUtils.tcl]]