Tcl Library Source Code

Check-in [8f954a97c2]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:log - logger::utils - Tkt [e4d5ef01e7] T, B - bumped to version 1.3.1. More cleanup, plus test case for handling of %M in a TclOO context. Fixed handling of %M in TclOO context.
Timelines: family | ancestors | descendants | both | logger-e4d5ef01e7
Files: files | file ages | folders
SHA3-256: 8f954a97c26f60a7e3f9577f67a69dfa3a934e5fc0e433fc0d1d91127d28e532
User & Date: andreask 2019-06-24 18:23:30
Context
2019-06-24
18:31
log - logger::utils - Tkt [e4d5ef01e7] D regenerated Closed-Leaf check-in: c9d061ae7f user: andreask tags: logger-e4d5ef01e7
18:23
log - logger::utils - Tkt [e4d5ef01e7] T, B - bumped to version 1.3.1. More cleanup, plus test case for handling of %M in a TclOO context. Fixed handling of %M in TclOO context. check-in: 8f954a97c2 user: andreask tags: logger-e4d5ef01e7
17:59
log - Tkt [e4d5ef01e7] T General cleanup in testsuite for logger::utils. check-in: b1e5c4e0a8 user: andreask tags: logger-e4d5ef01e7
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/log/logger.man. 

1
2
3

4
5
6
7
8
9
10

[comment {-*- tcl -*- doctools manpage}]
[comment {$Id: logger.man,v 1.26 2012/07/10 03:34:47 andreas_kupries Exp $}]
[vset VERSION 0.9.4]

[manpage_begin logger n [vset VERSION]]
[keywords log]
[keywords {log level}]
[keywords logger]
[keywords service]
[moddesc {Object Oriented logging facility}]
[titledesc {System to control logging of events.}]

<
<

>









1
2
3
4
5
6
7
8
9


[vset VERSION 0.9.4]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin logger n [vset VERSION]]
[keywords log]
[keywords {log level}]
[keywords logger]
[keywords service]
[moddesc {Object Oriented logging facility}]
[titledesc {System to control logging of events.}]

Changes to modules/log/loggerAppender.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

[comment {-*- tcl -*- doctools manpage}]
[comment {$Id: loggerAppender.man,v 1.6 2009/01/29 06:16:19 andreas_kupries Exp $}]
[manpage_begin logger::appender n 1.2]
[keywords appender]
[keywords logger]
[copyright {2005 Aamer Akhter <[email protected]>}]
[moddesc {Object Oriented logging facility}]
[titledesc {Collection of predefined appenders for logger}]
[category  {Programming tools}]
[require Tcl 8.2]
[require logger::appender [opt 1.2]]
[description]

This package provides a predefined set of logger templates.

[list_begin definitions]

[call [cmd ::logger::appender::console] \

>

<
|







|








1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

[vset VERSION 1.2]
[comment {-*- tcl -*- doctools manpage}]

[manpage_begin logger::appender n [vset VERSION]]
[keywords appender]
[keywords logger]
[copyright {2005 Aamer Akhter <[email protected]>}]
[moddesc {Object Oriented logging facility}]
[titledesc {Collection of predefined appenders for logger}]
[category  {Programming tools}]
[require Tcl 8.2]
[require logger::appender [opt [vset VERSION]]]
[description]

This package provides a predefined set of logger templates.

[list_begin definitions]

[call [cmd ::logger::appender::console] \

Changes to modules/log/loggerAppender.tcl. 

1
2
3
4
5
6
7
8
9
10
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405

##Library Header
#
# $Id: loggerAppender.tcl,v 1.4 2007/02/08 22:09:54 mic42 Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender
#
# Purpose:
#	collection of appenders for tcllib logger
................................................................................
	emergency red-bold
    }
}



##Procedure Header
# $Id: loggerAppender.tcl,v 1.4 2007/02/08 22:09:54 mic42 Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender::console
#
# Purpose:
#	 
................................................................................
    set myProcNameVar $procName
    return $procText
}



##Procedure Header
# $Id: loggerAppender.tcl,v 1.4 2007/02/08 22:09:54 mic42 Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender::colorConsole
#
# Purpose:
#	 
................................................................................
	      -category $service \
	      -priority $level ]
    set myProcNameVar $procName
    return $procText
}

##Procedure Header
# $Id: loggerAppender.tcl,v 1.4 2007/02/08 22:09:54 mic42 Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#       ::logger::appender::fileAppend
#
# Purpose:
#
................................................................................
    return $procText
}
  	 



##Internal Procedure Header
# $Id: loggerAppender.tcl,v 1.4 2007/02/08 22:09:54 mic42 Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#       ::logger::appender::genProcName
#
# Purpose:
#        


<







 







<







 







<







 







<







 







<








1
2

3
4
5
6
7
8
9
..
68
69
70
71
72
73
74

75
76
77
78
79
80
81
...
170
171
172
173
174
175
176

177
178
179
180
181
182
183
...
276
277
278
279
280
281
282

283
284
285
286
287
288
289
...
387
388
389
390
391
392
393

394
395
396
397
398
399
400

##Library Header
#

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender
#
# Purpose:
#	collection of appenders for tcllib logger
................................................................................
	emergency red-bold
    }
}



##Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender::console
#
# Purpose:
#	 
................................................................................
    set myProcNameVar $procName
    return $procText
}



##Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::appender::colorConsole
#
# Purpose:
#	 
................................................................................
	      -category $service \
	      -priority $level ]
    set myProcNameVar $procName
    return $procText
}

##Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#       ::logger::appender::fileAppend
#
# Purpose:
#
................................................................................
    return $procText
}
  	 



##Internal Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#       ::logger::appender::genProcName
#
# Purpose:
#

Changes to modules/log/loggerUtils.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

[comment {-*- tcl -*- doctools manpage}]
[comment {$Id: loggerUtils.man,v 1.7 2009/01/29 06:16:19 andreas_kupries Exp $}]
[manpage_begin logger::utils n 1.3]
[keywords appender]
[keywords logger]
[copyright {2005 Aamer Akhter <[email protected]>}]
[moddesc {Object Oriented logging facility}]
[titledesc {Utilities for logger}]
[category  {Programming tools}]
[require Tcl 8.4]
[require logger::utils [opt 1.3]]
[description]

This package adds template based [term appenders].

[list_begin definitions]

[call [cmd ::logger::utils::createFormatCmd] [arg formatString]]

>

<
|







|








1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

[vset VERSION 1.3.1]
[comment {-*- tcl -*- doctools manpage}]

[manpage_begin logger::utils n [vset VERSION]]
[keywords appender]
[keywords logger]
[copyright {2005 Aamer Akhter <[email protected]>}]
[moddesc {Object Oriented logging facility}]
[titledesc {Utilities for logger}]
[category  {Programming tools}]
[require Tcl 8.4]
[require logger::utils [opt [vset VERSION]]]
[description]

This package adds template based [term appenders].

[list_begin definitions]

[call [cmd ::logger::utils::createFormatCmd] [arg formatString]]

Changes to modules/log/loggerUtils.tcl. 

1
2
3
4
5
6
7
8
9
10
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
...
266
267
268
269
270
271
272



273
274
275
276
277
278
279
280
281
282
283
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
...
530
531
532
533
534
535
536
537
538
539
540
541

##Library Header
#
# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::
#
# Purpose:
#	an extension to the tcllib logger module
................................................................................
    logger::import -force -namespace log logger::utils

    # @mdgen OWNER: msgs/*.msg
    ::msgcat::mcload [file join $packageDir msgs]
}

##Internal Procedure Header
# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::createFormatCmd
#
# Purpose:
#
................................................................................

    return $text
}



##Procedure Header
# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::createLogProc
#
# Purpose:
#
................................................................................
	}


	if {[regexp {%M} $text]} {
	    set methodText {
		if {[info level] < 2} {
		    set method "global"



		} else {
		    set method [lindex [info level -1] 0]
		}

	    }

	    regsub -all -- \
		{%M} \
		$text \
		{$method} \
		text
................................................................................

    set procText [subst $procText]
    return $procText
}


##Procedure Header
# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::applyAppender
#
# Purpose:
#
................................................................................
	    ${srvCmd}::logproc $lvl $procName
	}
    }
}


##Internal Procedure Header
# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $
# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::autoApplyAppender
#
# Purpose:
#
................................................................................
    }
    logger::utils::applyAppender -appender $appender -serviceCmd $log \
	-levels $levels -appenderArgs $appenderArgs
    return $log
}


package provide logger::utils 1.3

# ;;; Local Variables: ***
# ;;; mode: tcl ***
# ;;; End: ***


<







 







<







 







<







 







>
>
>



<







 







<







 







<







 







|





1
2

3
4
5
6
7
8
9
..
54
55
56
57
58
59
60

61
62
63
64
65
66
67
...
158
159
160
161
162
163
164

165
166
167
168
169
170
171
...
263
264
265
266
267
268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
...
314
315
316
317
318
319
320

321
322
323
324
325
326
327
...
448
449
450
451
452
453
454

455
456
457
458
459
460
461
...
527
528
529
530
531
532
533
534
535
536
537
538

##Library Header
#

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::
#
# Purpose:
#	an extension to the tcllib logger module
................................................................................
    logger::import -force -namespace log logger::utils

    # @mdgen OWNER: msgs/*.msg
    ::msgcat::mcload [file join $packageDir msgs]
}

##Internal Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::createFormatCmd
#
# Purpose:
#
................................................................................

    return $text
}



##Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::createLogProc
#
# Purpose:
#
................................................................................
	}


	if {[regexp {%M} $text]} {
	    set methodText {
		if {[info level] < 2} {
		    set method "global"
		} elseif {[uplevel 1 {namespace which self}] == "::oo::Helpers::self"} {
		    set    method    [uplevel 1 {self class}]
		    append method :: [uplevel 1 {self method}]
		} else {
		    set method [lindex [info level -1] 0]
		}

	    }

	    regsub -all -- \
		{%M} \
		$text \
		{$method} \
		text
................................................................................

    set procText [subst $procText]
    return $procText
}


##Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::applyAppender
#
# Purpose:
#
................................................................................
	    ${srvCmd}::logproc $lvl $procName
	}
    }
}


##Internal Procedure Header

# Copyright (c) 2005 Cisco Systems, Inc.
#
# Name:
#	::logger::utils::autoApplyAppender
#
# Purpose:
#
................................................................................
    }
    logger::utils::applyAppender -appender $appender -serviceCmd $log \
	-levels $levels -appenderArgs $appenderArgs
    return $log
}


package provide logger::utils 1.3.1

# ;;; Local Variables: ***
# ;;; mode: tcl ***
# ;;; End: ***

Changes to modules/log/loggerUtils.test. 

87
88
89
90
91
92
93



























94
95
96
97
98
99
100

	      -procName ::bobo \
	      -conversionPattern {\[%d\] \[%c\] \[%M\] \[%p\] %m}]
    namespace eval ::loggerExtension::test {
	::bobo test
    }
}  -match regexp -output {\[[\d:\/ ]+\] \[catTest\] \[namespace\] \[critical\] test}




























::tcltest::test applyAppender-1 {apply an appender} -cleanup {
    ${log}::delete
    unset log
    namespace delete ::loggerExtension::test
} -body {
    set log [logger::init testLog]
    logger::utils::applyAppender -appender console -serviceCmd $log







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








87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

	      -procName ::bobo \
	      -conversionPattern {\[%d\] \[%c\] \[%M\] \[%p\] %m}]
    namespace eval ::loggerExtension::test {
	::bobo test
    }
}  -match regexp -output {\[[\d:\/ ]+\] \[catTest\] \[namespace\] \[critical\] test}


::tcltest::test createLogProc-2 {tkt e4d5ef01e7, %M OO context} -constraints tcl8.5plus -setup {
    package require TclOO
    ::oo::class create Main {
	variable log
	constructor {} {
	    set this_inst [namespace current]
	    set this_klaz [info object class $this_inst]
	    set log [::logger::init $this_klaz]
	    ::logger::utils::applyAppender \
		-appender "console" \
		-appenderArgs {-conversionPattern {%d \[%p\] \[%M\] %m}} \
		-serviceCmd $log
	}
	method invoke {} {
	    ${log}::info "hello"
	}
    }
    set main [Main new]
} -cleanup {
    $main destroy
    unset main
    Main destroy
} -body {
    $main invoke
} -match regexp -output {[\d:\/ ]+ \[info\] \[::Main::invoke\] hello}

::tcltest::test applyAppender-1 {apply an appender} -cleanup {
    ${log}::delete
    unset log
    namespace delete ::loggerExtension::test
} -body {
    set log [logger::init testLog]
    logger::utils::applyAppender -appender console -serviceCmd $log

Changes to modules/log/loggerperformance. 

1
2
3
4
5
6
7
8
9
10
11
12

# -*- tcl -*-
# loggerperformance.tcl

# $Id: loggerperformance,v 1.2 2004/01/15 06:36:13 andreas_kupries Exp $

# This code is for benchmarking the performance of the log tools.

set auto_path "[file dirname [info script]] $auto_path"
package require logger
package require log

# Set up logger


|
<
<








1
2
3


4
5
6
7
8
9
10

# -*- tcl -*-
# loggerperformance.tcl
#


# This code is for benchmarking the performance of the log tools.

set auto_path "[file dirname [info script]] $auto_path"
package require logger
package require log

# Set up logger

Changes to modules/log/pkgIndex.tcl. 

2
3
4
5
6
7
8
9

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]]







|

2
3
4
5
6
7
8
9

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.1 [list source [file join $dir loggerUtils.tcl]]

This page was generated in about 0.027s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14