"
(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 .
"
Object extend [
logManager [
^ Osmo.LogManager default
]
logDataContext: aData area: anArea [
(self logManager)
context: 'data' value: aData.
]
logDebug: aMessage area: anArea [
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel debug area: anArea context: self)
]
logInfo: aMessage area: anArea [
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel info area: anArea context: self)
]
logNotice: aMessage area: anArea [
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel notice area: anArea context: self)
]
logError: aMessage area: anArea [
(self logManager)
log: (LogEntry withMsg: aMessage level: LogLevel error area: anArea context: self)
]
logException: aMessage area: anArea [
(self logManager)
exception: (LogEntry withMsg: aMessage
level: LogLevel error
area: anArea context: thisContext parentContext)
]
]
Object subclass: LogEntry [
| level ctx area msg |
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 [
LogLevel class >> debug [
^ 1
]
LogLevel class >> info [
^ 3
]
LogLevel class >> notice [
^ 5
]
LogLevel class >> error [
^ 7
]
]
Object subclass: LogArea [
| name enabled level |
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 [
^ self subclassResponsibility
]
LogArea class >> areaName [
^ self subclassResponsibility
]
LogArea class >> areaDescription [
^ self subclassResponsibility
]
LogArea class >> availableAreas [
^ self allSubclasses collect: [ :each |
Array with: each areaName with: each areaDescription
].
]
enabled [
^ enabled
]
enabled: anEnabled [
enabled := anEnabled.
]
minLevel [
^ level
]
minLevel: aLevel [
level := aLevel
]
]
Object subclass: LogTarget [
print: anEntry [
self subclassResponsibility.
]
exception: anEntry [
self subclassResponsibility.
]
]
LogTarget subclass: LogTranscriptTarget [
print: anEntry [
Transcript show: anEntry msg; nl.
]
exception: anEntry [
Transcript show: anEntry msg; nl.
anEntry context backtraceOn: Transcript.
]
]
Object subclass: LogFilter [
filter: anEntry [
"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 |
Log := nil.
LogManager class >> default [
Log ifNil: [
Log := LogManager new.
Log target: LogTranscriptTarget new.
].
^ Log
]
target: aTarget [
target := aTarget.
]
areas [
areas ifNil: [
areas := Dictionary new.
].
^ areas
]
findArea: anArea [
"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 [
| area |
area := self findArea: anEntry area.
(area enabled and: [anEntry level >= area minLevel]) ifTrue: aBlock
]
log: anEntry [
self handle: anEntry ifTrue: [
target print: anEntry
]
]
exception: anEntry [
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.
]
]