Attachment "latest.diff" to
ticket [856280ffff]
added by
davidw
2003-12-16 06:23:03.
? dwlog.tcl
? dwlog.test
? foo.n
? goober
? latest.diff
? logger.n
? prova.tcl
Index: logger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.tcl,v
retrieving revision 1.4
diff -u -r1.4 logger.tcl
--- logger.tcl 20 May 2003 09:35:05 -0000 1.4
+++ logger.tcl 15 Dec 2003 23:21:50 -0000
@@ -9,7 +9,7 @@
# lets you have trees of services, that inherit from one another.
# This is accomplished through the use of Tcl namespaces.
-package provide logger 0.1
+package provide logger 0.2
package require Tcl 8.2
namespace eval ::logger {
@@ -41,8 +41,8 @@
proc ::logger::walk { start code } {
set children [namespace children $start]
foreach c $children {
- namespace eval $c $code
logger::walk $c $code
+ namespace eval $c $code
}
}
@@ -65,12 +65,16 @@
# going. They can turn it off themselves.
variable enabled "debug"
+ # Callback to use when the service in question is shut down.
+ set delcallback {}
+
# We use this to disable a service completely. In Tcl 8.4
# or greater, by using this, disabled log calls are a
# no-op!
proc no-op args {}
+
proc stdoutcmd {level text} {
variable service
puts "\[[clock format [clock seconds]]\] \[$service\] \[$level\] \'$text\'"
@@ -172,11 +176,12 @@
logger::walk [namespace current] [list disable $lv]
}
+
# logproc --
#
- # Command used to create a procedure that is what is
- # executed to perform the logging. This could write to
- # disk, out to the network, or something else.
+ # Command used to create a procedure that is executed to
+ # perform the logging. This could write to disk, out to
+ # the network, or something else.
#
# Arguments:
# lv - the level to log, which must be one of $levels.
@@ -191,7 +196,6 @@
# Results:
# None.
-
proc logproc {lv arg body} {
variable levels
set lvnum [lsearch -exact $levels $lv]
@@ -201,11 +205,36 @@
proc ${lv}cmd $arg $body
}
+
+ # delproc --
+ #
+ # Set a callback for when the logger instance is
+ # deleted.
+ #
+ # Arguments:
+ # cmd - the Tcl command to call.
+ #
+ # Side Effects:
+ # None.
+ #
+ # Results:
+ # None.
+
+ proc delproc {cmd} {
+ variable delcallback
+ set delcallback $cmd
+ }
+
+
# delete --
#
# Delete the namespace and its children.
proc delete {} {
+ variable delcallback
+
+ logger::walk [namespace current] delete
+ catch { $delcallback [namespace current] }
namespace delete [namespace current]
}
Index: logger.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.test,v
retrieving revision 1.2
diff -u -r1.2 logger.test
--- logger.test 20 May 2003 09:35:05 -0000 1.2
+++ logger.test 15 Dec 2003 23:21:50 -0000
@@ -14,7 +14,7 @@
}
set auto_path "[file dirname [info script]] $auto_path"
-package require logger
+package require logger 0.2
test logger-1.0 {init basic} {
set log [logger::init global]
@@ -43,6 +43,21 @@
set err
} {can't read "::logger::tree::global::enabled": no such variable}
+test logger-2.1 {delete + callback} {
+ set ::results {}
+ proc dellog {ns} {
+ lappend ::results "$ns"
+ }
+ set log1 [logger::init global]
+ set log2 [logger::init global::subsystem]
+ ${log1}::delproc dellog
+ ${log2}::delproc dellog
+ ${log1}::delete
+ # catch {set ${log}::enabled} err
+ #set err
+ set ::results
+} {::logger::tree::global::subsystem ::logger::tree::global}
+
test logger-3.0 {log} {
set log [logger::init global]
${log}::error "Danger Will Robinson!"
@@ -152,7 +167,9 @@
test logger-5.0 {setlevel command} {
set ::INFO ""
set log1 [logger::init global]
+ catch {
${log1}::setlevel warn
+ } err
${log1}::logproc error txt {
lappend ::INFO "Error Message"
}
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/pkgIndex.tcl,v
retrieving revision 1.6
diff -u -r1.6 pkgIndex.tcl
--- pkgIndex.tcl 11 Apr 2003 19:55:26 -0000 1.6
+++ pkgIndex.tcl 15 Dec 2003 23:21:50 -0000
@@ -11,4 +11,4 @@
if {![package vsatisfies [package provide Tcl] 8]} {return}
package ifneeded log 1.0.2 [list source [file join $dir log.tcl]]
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded logger 0.1 [list source [file join $dir logger.tcl]]
+package ifneeded logger 0.2 [list source [file join $dir logger.tcl]]
