Tcl Library Source Code
Check-in [ea802e332b]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:log / log <EF> Ticket [19607f927b] Merged new `logsubst` command to prevent execution of expensive message construction until actually needed. Version bumped to 1.4. Thanks to Harald for idea and implementation.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:ea802e332be2a0ebec7189d665dd2569d072cf7b7ce1b20b32050da476411821
User & Date: aku 2018-05-18 04:15:38
References
2018-05-18
04:17 Closed ticket [19607f927b]: add log::logsubst to optimize logging of expensive to build messages plus 5 other changes artifact: aed38e84e2 user: aku
Context
2018-05-18
04:42
json / json <D> Ticket [868b8ebe79] json / json::write <D> Extended the documentation of both packages to refer to the other. No version changes. Regenerated the online documentation. check-in: e2d7b04944 user: aku tags: trunk
04:31
mime / smtp <B> Ticket [d9be31a488] Simplify how `smtp::initialize` iterates over -servers and -ports. Updated the documentation. Version bumped to 1.4.6. Thanks to boegge for the report of the problem with the old code. Leaf check-in: 9c0c77acf0 user: aku tags: smtp-init-tkt-d9be31a488
04:15
log / log <EF> Ticket [19607f927b] Merged new `logsubst` command to prevent execution of expensive message construction until actually needed. Version bumped to 1.4. Thanks to Harald for idea and implementation. check-in: ea802e332b user: aku tags: trunk
2018-05-07
17:06
Regenerated web docs. check-in: 2d4eba9c29 user: aku tags: trunk
2018-02-20
11:09
Fixed list error Closed-Leaf check-in: 259321213b user: oehhar tags: rfe-19607f927b-logeval
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/log/ChangeLog.







1
2
3
4
5
6
7






2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

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

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







1
2
3
4
5
6
7
8
9
10
11
12
13
2018-02-20 Harald Oehlmann <oehhar@sourceforge.net>

	* 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  <andreas_kupries@users.sourceforge.net>

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

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

Changes to modules/log/log.man.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
219
220
221
222
223
224
225












226
227
228
229
230
231
232
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin log n 1.3]
[keywords log]
[keywords {log level}]
[keywords message]
[keywords {message level}]
[copyright {2001-2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
[moddesc   {Logging facility}]
[titledesc {Procedures to log messages of libraries and applications.}]
[category  {Programming tools}]
[require Tcl 8]
[require log [opt 1.3]]
[description]

[para]

The [package log] package provides commands that allow libraries and
applications to selectively log information about their internal
operation and state.
................................................................................
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::logMsg] [arg text]]

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

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

|









|







 







>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
[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 <andreas_kupries@users.sourceforge.net>}]
[moddesc   {Logging facility}]
[titledesc {Procedures to log messages of libraries and applications.}]
[category  {Programming tools}]
[require Tcl 8]
[require log [opt 1.4]]
[description]

[para]

The [package log] package provides commands that allow libraries and
applications to selectively log information about their internal
operation and state.
................................................................................
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]]

Changes to modules/log/log.tcl.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
810
811
812
813
814
815
816










































817
818
819
820
821
822
823
#	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.3

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

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::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*.







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
#	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*.

Changes to modules/log/log.test.

360
361
362
363
364
365
366






















































367
368
369
370
371
372
373
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.}
























































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







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
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

Changes to modules/log/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
if {![package vsatisfies [package provide Tcl] 8]} {return}
package ifneeded log 1.3 [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]]

|







1
2
3
4
5
6
7
8
9
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]]