Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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
#
# Tcl implementation of ErrLogger
#
# Dave Brown, LBNL 4/7/2003
# Copyright Information:
# Copyright (C) 2003 Lawrence Berkeley National Lab
#
#
#
# Error-logging related variables
#
global ErrLogSeverityLevels
global ErrLogCurrentSeverity
global ErrLogNames
#
# only define the error levels once
#
if { ! [info exists ErrLogCurrentSeverity] } {
#
# Set the default error level as 'Routine'
#
set ErrLogCurrentSeverity 2
#
# setup the names
#
lappend ErrLogSeverityLevels debugging trace routine warning error fatal
lappend ErrLogNames Debugging Trace Routine Warning Error Fatal
}
#
# Define the procs if not already done
#
if { [expr [llength [info procs "ErrMsg"]] == 0] } {
#
# test whether errors of the given severity would be reported, given the current
# configuration
#
proc ErrLogging { severity } {
global ErrLogSeverityLevels
global ErrLogCurrentSeverity
#
# First, translate the severity name to a level
#
set iseverity [lsearch -exact $ErrLogSeverityLevels $severity]
#
# Only produce output if the severity is equal to or greater than that requested
#
return "[expr [expr $iseverity == -1] || [expr $iseverity >= $ErrLogCurrentSeverity]]"
}
#
# standard messaging proc
#
proc ErrMsg { severity message } {
global ErrLogSeverityLevels
global ErrLogCurrentSeverity
global ErrLogNames
set iseverity [lsearch -exact $ErrLogSeverityLevels $severity]
if { [expr $iseverity == -1] ||
[expr $iseverity >= $ErrLogCurrentSeverity] } {
#
if { [expr $iseverity == -1] } {
puts "Invalid severity level $severity: printing message"
set iseverity 4
}
#
# Find the calling proc's name. Skip it if it's 'ErrMsg'
#
set procname [lindex [info level [expr [info level] -1] ] 0]
if { $procname == "ErrMsg" } { set procname ""}
#
# If the caller is just ErrMsg, set the caller to the script name
#
set fullscript [info script]
set script [string range $fullscript [expr [string last "/" $fullscript ] +1] end]
puts "${script}\:${procname}\:[lindex $ErrLogNames $iseverity]\: $message"
#
# Abort if the level is fatal
#
if { $severity == "fatal" } {
puts "${script}\:${procname}\:Fatal\: tcl interpreter will now exit"
exitTcl
}
}
return
}
#
# change (or report) the error logging severity
#
proc ErrLoggingLevel { { severity ""} } {
global ErrLogSeverityLevels
global ErrLogCurrentSeverity
#
# Make sure this level exists
#
if { $severity != "" } {
set iseverity [lsearch -exact $ErrLogSeverityLevels $severity]
if { [expr $iseverity != -1] } {
set ErrLogCurrentSeverity $iseverity
} else {
ErrMsg error "Unknown severity level $severity"
}
}
return "[lindex $ErrLogSeverityLevels $ErrLogCurrentSeverity]"
}
}