1
0
Fork 0
Smalltalk implementation of logging framework ideas
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
 
 

316 lines
7.1 KiB

"
(C) 2010-2011 by Holger Hans Peter Freyther
All Rights Reserved
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
"
Object extend [
logManager [
<category: '*OsmoLogging-Core'>
^ Osmo.LogManager default
]
logDataContext: aData area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
context: 'data' value: aData.
]
logDebug: aMessage area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel debug area: anArea context: self)
]
logInfo: aMessage area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel info area: anArea context: self)
]
logNotice: aMessage area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel notice area: anArea context: self)
]
logError: aMessage area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel error area: anArea context: self)
]
logException: aMessage area: anArea [
<category: '*OsmoLogging-Core'>
(self logManager)
exception: (LogEntry withMsg: aMessage
level: LogLevel error
area: anArea context: thisContext parentContext)
]
]
Object subclass: LogEntry [
| level ctx area msg |
<category: 'OsmoLogging-Core'>
<comment: 'I represent a log entry and hold the text, level, area'>
LogEntry class >> withMsg: aMsg level: anLevel area: anArea context: aContext [
^ self new
msg: aMsg;
level: anLevel;
area: anArea;
context: aContext;
yourself.
]
msg [
^ msg
]
msg: aMsg [
msg := aMsg.
]
level [
^ level
]
level: anLevel [
level := anLevel
]
area [
^ area
]
area: anArea [
area := anArea.
]
context [
^ ctx
]
context: aContext [
ctx := aContext.
]
]
Object subclass: LogLevel [
<category: 'OsmoLogging-Core'>
<comment: 'I represent the available levels for log messages'>
LogLevel class >> debug [
^ 1
]
LogLevel class >> info [
^ 3
]
LogLevel class >> notice [
^ 5
]
LogLevel class >> error [
^ 7
]
]
Object subclass: LogArea [
| name enabled level |
<category: 'OsmoLogging-Core'>
<comment: 'I represent a LogArea'>
LogArea class >> defaultForArea: aSymbol [
"Find an Area and place the default into our dictionary"
LogArea allSubclassesDo: [ :each |
(each areaName) = aSymbol
ifTrue: [
^ each default.
].
].
^ nil
]
LogArea class >> default [
<category: 'accessing'>
^ self subclassResponsibility
]
LogArea class >> areaName [
<category: 'accessing'>
^ self subclassResponsibility
]
LogArea class >> areaDescription [
<category: 'accessing'>
^ self subclassResponsibility
]
LogArea class >> availableAreas [
<category: 'accessing'>
^ self allSubclasses collect: [ :each |
Array with: each areaName with: each areaDescription
].
]
enabled [
<category: 'accessing'>
^ enabled
]
enabled: anEnabled [
<category: 'accessing'>
enabled := anEnabled.
]
minLevel [
<category: 'accessing'>
^ level
]
minLevel: aLevel [
<category: 'accessing'>
level := aLevel
]
]
Object subclass: LogTarget [
<category: 'OsmoLogging-Target'>
<comment: 'I will filter and then output the log message'>
print: anEntry [
<category: 'log'>
self subclassResponsibility.
]
exception: anEntry [
<category: 'log'>
self subclassResponsibility.
]
]
LogTarget subclass: LogTranscriptTarget [
<category: 'OsmoLogging-Target'>
<comment: 'I log to the Transcript buffer'>
print: anEntry [
<category: 'log'>
Transcript show: anEntry msg; nl.
]
exception: anEntry [
<category: 'log'>
Transcript show: anEntry msg; nl.
anEntry context backtraceOn: Transcript.
]
]
Object subclass: LogFilter [
<category: 'OsmoLogging-Core'>
<comment: 'I filter based on mood, context and Bangkok Law'>
filter: anEntry [
<category: 'filter'>
"I have to decide if anEntry can pass or should be filtered out, I can
access the logManager of anEntry to access the per process context"
^ self subclassResponsibility
]
]
Object subclass: LogManager [
| target filter areas |
<category: 'OsmoLogging-Core'>
<comment: 'I handle the actual log invocation'>
Log := nil.
LogManager class >> default [
<category: 'instance'>
Log ifNil: [
Log := LogManager new.
Log target: LogTranscriptTarget new.
].
^ Log
]
target: aTarget [
<category: 'private'>
target := aTarget.
]
areas [
<category: 'accessing'>
areas ifNil: [
areas := Dictionary new.
].
^ areas
]
findArea: anArea [
<category: 'private'>
"Find anArea, or ask for a default"
^ (self areas) at: anArea ifAbsent: [
| area |
area := LogArea defaultForArea: anArea.
area ifNotNil: [
(self areas) at: anArea put: area.
].
area.
].
]
handle: anEntry ifTrue: aBlock [
<category: 'private'>
| area |
area := self findArea: anEntry area.
(area enabled and: [anEntry level >= area minLevel]) ifTrue: aBlock
]
log: anEntry [
<category: 'log'>
self handle: anEntry ifTrue: [
target print: anEntry
]
]
exception: anEntry [
<category: 'log'>
self handle: anEntry ifTrue: [
target exception: anEntry.
]
]
context: aString value: aValue [
| key |
key := Array with: 'LogArea' with: aString.
(ProcessVariable key: key) value: aValue.
]
contextValue: aString [
| key |
key := Array with: 'LogArea' with: aString.
^ (ProcessVariable key: key) value.
]
]