Attachment "logger.diff" to
ticket [879812ffff]
added by
mic42
2004-01-19 19:46:04.
Index: logger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.tcl,v
retrieving revision 1.5
diff -w -u -r1.5 logger.tcl
--- logger.tcl 16 Dec 2003 15:46:16 -0000 1.5
+++ logger.tcl 19 Jan 2004 12:44:32 -0000
@@ -176,18 +176,38 @@
logger::walk [namespace current] [list disable $lv]
}
+ # currentloglevel --
+ #
+ # Get the currently enabled log level for this service.
+ #
+ # Arguments:
+ # none
+ #
+ # Side Effects:
+ # none
+ #
+ # Results:
+ # current log level
+ #
+
+ proc currentloglevel {} {
+ variable enabled
+ return $enabled
+ }
# logproc --
#
# 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.
+ # If two arguments are given, use an existing command.
+ # If three arguments are given create a proc.
#
# Arguments:
# lv - the level to log, which must be one of $levels.
- # arg - the arg the procedure takes, usually something
- # like 'txt'.
- # body - the body of the procedure.
+ # args - either one or two arguments.
+ # if one this is a cmd name that is called for this level
+ # if two these are an argument and proc body
#
# Side Effects:
# Creates a logging command to take care of the details
@@ -196,15 +216,29 @@
# Results:
# None.
- proc logproc {lv arg body} {
+ proc logproc {lv args} {
variable levels
set lvnum [lsearch -exact $levels $lv]
if { $lvnum == -1 } {
::error "Invalid level '$lv' - levels are $levels"
}
+ switch -exact -- [llength $args] {
+ 1 {
+ set cmd [lindex $args 0]
+ if {[llength [::info commands $cmd]]} {
+ interp alias {} ${lv}cmd {} $cmd
+ } else {
+ ::error "Invalid cmd '$cmd' - does not exist"
+ }
+ 2 {
+ foreach {arg body} $args {break}
proc ${lv}cmd $arg $body
}
-
+ default {
+ ::error "Usage: \${log} logproc level cmd\nor \${log} logproc level argname body"
+ }
+ }
+ }
# delproc --
#
@@ -344,3 +378,23 @@
::logger::tree::${sv}::disable $lv
}
}
+
+# ::logger::levels --
+#
+# Introspect the available log levels.
+# Provided so a caller does not need to know
+# implementation details or code the list himself.
+#
+# Arguments:
+# none
+#
+# Side Effects:
+# none
+#
+# Results:
+# levels - The list of valid log levels accepted by enable and disable
+
+proc ::logger::levels {} {
+ variable levels
+ return $levels
+}
\ No newline at end of file
