Hi!
On 02/22/2014 05:26 PM, Pharo4Stef wrote:
Hi goran
There are only two questions:
'Why when I load code do I have to open the transcript before to see
the shadow and undeclared.
and why I cannot click on an object and jump to the broken code?"
Now with SimpleLogger I imagine that I cannot log compiler shadow, don’t you :).
I am not quite sure what you are saying... Ah, you mean logging objects
instead of strings? Sure, I didn't say SimpleLog was BETTER, I just said
you didn't look at it and thus may be missing out on nice stuff that you
can steal :)
- Using syslog levels, it is very standard and logging these days of
clouds do NOT stay on the local machine.
- Stealing the syslog emitter, it is just 20 lines of code.
- Stealing log file rotation perhaps? I think its in there.
- Stealing whatever else seems good.
Having log objects in the image is great.
100 timesRepeat: [Goran repeatAfter: me what: ‘String sucks, string are dead
objects’]
Well, do remember that logs in a "system world" end up getting routed
through syslog (and tons of variations on that theme) and eventually end
up in event collecting systems etc - just look at fluentd.org to
understand what I mean.
So actually, I would make sure that SimpleLogger could also easily log
in JSON, let me quote from fluentd:
"Fluentd treats logs as JSON, a popular machine-readable format. It is
written primarily in C with a thin-Ruby wrapper that gives users
flexibility.
Fluentd’s performance has been proven in the field: its largest user
currently collects logs from 5000+ servers, 5 TB of daily data, handling
50,000 msgs/sec at peak time."
I’m coding in Smalltalk and not in perl!
In fact, now that I am looking at SimpleLog I realize we could have had
an emitter that collected objects and just let "message" be whatever -
and send asString or asJSON to it when it reaches the emitter instead.
Now if you want to have syslog output this is probably one method definition in
a new formatter in our nice frameworks.
Do you have an output that shows what is needed for sysLog? because I can add a
package for sysLog outputter.
Its very short code. Just steal it. I attached all the code as an .st
fileout so that you can get it trivially. Its the SLSyslogSender class.
The SLLogWatchDog is a trivial "send an email if a certain level is
reached" with some bundling etc.
SLLogFile has log file rotation.
SLLogMorph is the simple search and filter UI.
regards, Göran
Object subclass: #SLLog
instanceVariableNames: 'emitters guard transcriptMaxLevel
globalMaxLevel notifierMaxLevel'
classVariableNames: 'Default UseTranscript'
poolDictionaries: ''
category: 'SimpleLog'!
!SLLog commentStamp: 'gk 11/21/2007 09:18' prior: 0!
Nice and simple logging. There are eight messages for logging based on
severity. These correspond to the eight levels defined in syslog:
7 - debug (Debug-level messages)
6 - info (Informational)
5 - notice (Normal but significant Condition)
4 - warning (Warning Condition)
3 - err (Error Condition)
2 - crit (Critical Conditions)
1 - alert (must be handled immediately)
0 - emerg (System is unusable)
The absolutely easiest way to log is like this:
SLLog warn: 'Oopsidaisy'
...this utilizes the class SLLog as a facade onto a singleton that you reach
with "SLLog instance". You can also register an instance in global #Log like:
SLLog useGlobalLog: true
...and then you can use:
Log warn: 'Hey, nicer to typ!!'
We only need to include the actual message in the string, timestamp etc is
added automatically.
You can also explicitly supply a "sender" object which can be anything you
like, a symbol or a specific domain object even:
SLLog warn: 'Yowsa' sender: #email
SLLog uses printString on the sender when producing the log entry, so if you
use domain objects - make sure they have a unique printOn: method defined so
that you can distinguish them. See class side category "logging" and "logging
shorthand" for the available log messages.
By default there is a single emitter registered that logs on Transcript, you
can turn this default initialization off (for new SLLog instances) with:
SLLog useTranscript: false
You can also use addTranscript/removeTranscript, addMorphic/removeMorphic etc
to add and remove known emitters:
SLLog removeTranscript; addMorphic; addSyslog
The above removes default transcript emitter and adds an SLLogMorph as an
emitter (and opens it), and also a SLSyslogSender emitter that will log onto
localhost using UDP on port 514, see its class comment for details.
You can set a threshold for the syslog levels that should be logged onto
Transcript (levels <= threshold are logged) using:
SLLog transcript transcriptMaxLevel: 4
...and you can set a threshold for raising a notifier (debugger) using:
SLLog instance notifierMaxLevel: 3
...or set a global threshold for all emitters:
SLLog instance globalMaxLevel: 4
Global flushing of all emitters can be done using "SLLog flush" and should
ideally be called regularly by some background process.
Finally take a look at SLLogFile for details on how to add it as an emitter to
get logging onto file instead of Transcript.!
!SLLog methodsFor: 'emitters' stamp: 'gk 11/21/2007 01:02'!
addEmitter: anObject
"Add an object as a backend emitter to this log instance."
(emitters includes: anObject) ifFalse: [emitters add: anObject]! !
!SLLog methodsFor: 'emitters' stamp: 'gk 8/3/2006 09:45'!
emitters
^emitters! !
!SLLog methodsFor: 'emitters' stamp: 'gk 2/16/2007 11:37'!
removeEmitter: anObject
(emitters includes: anObject) ifTrue: [
emitters remove: anObject.
SLLog debug: 'Emitter removed: ', anObject asString.
]! !
!SLLog methodsFor: 'emitters' stamp: 'gk 11/21/2007 08:40'!
removeEmittersOfClass: aClass
"Remove all registered emitters of a given class."
(emitters select: [:each | each class = aClass])
copy do: [:e | self removeEmitter: e]! !
!SLLog methodsFor: 'emitters-morphic' stamp: 'gk 11/21/2007 08:38'!
addMorphic
"Create and register a UI for watching logging."
"self addMorphic"
self addEmitter: SLLogMorph open! !
!SLLog methodsFor: 'emitters-morphic' stamp: 'gk 11/21/2007 08:59'!
morphic
"Return first found SLLogMorph."
^emitters detect: [:each | each class = SLLogMorph] ifNone: [nil] ! !
!SLLog methodsFor: 'emitters-morphic' stamp: 'gk 11/21/2007 08:39'!
removeMorphic
"Remove all SLLogMorphs."
self removeEmittersOfClass: SLLogMorph! !
!SLLog methodsFor: 'emitters-syslog' stamp: 'gk 11/21/2007 01:14'!
addSyslog
"Just add an SLSyslogSender. Default will be to localhost."
self addEmitter: SLSyslogSender new! !
!SLLog methodsFor: 'emitters-syslog' stamp: 'gk 11/21/2007 08:40'!
removeSyslog
"Remove all SLSyslogSenders."
self removeEmittersOfClass: SLSyslogSender! !
!SLLog methodsFor: 'emitters-syslog' stamp: 'gk 11/21/2007 08:36'!
syslog
"Return first found registered SLSyslogSender."
^emitters detect: [:each | each class = SLSyslogSender] ifNone: [nil]! !
!SLLog methodsFor: 'emitters-transcript' stamp: 'gk 11/21/2007 01:02'!
addTranscript
"We use ourself as a Transcript emitter."
self addEmitter: self! !
!SLLog methodsFor: 'emitters-transcript' stamp: 'gk 11/20/2007 22:46'!
level: level name: symbol sender: sender message: msg
"Default emitter is to just output in Transcript, so this instance
doubles
as a Transcript emitter. We respect the transcriptThreshold."
level <= transcriptMaxLevel ifTrue: [
Transcript show: DateAndTime now printString,' - ',
symbol, '(', level asString, '): ', msg, ' (', sender
class name, ')'; cr]! !
!SLLog methodsFor: 'emitters-transcript' stamp: 'gk 11/21/2007 01:02'!
removeTranscript
"We use ourself as a Transcript emitter."
self removeEmitter: self! !
!SLLog methodsFor: 'emitters-transcript' stamp: 'gk 11/21/2007 08:36'!
transcript
"We use ourself as a Transcript emitter."
^self! !
!SLLog methodsFor: 'emitters-watchdog' stamp: 'gk 11/21/2007 08:42'!
addWatchdog
self addEmitter: SLLogWatchdog! !
!SLLog methodsFor: 'emitters-watchdog' stamp: 'gk 11/21/2007 08:42'!
removeWatchdog
self removeEmitter: SLLogWatchdog! !
!SLLog methodsFor: 'emitters-watchdog' stamp: 'gk 11/21/2007 08:59'!
watchdog
^SLLogWatchdog! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
alert: msg
self emit: msg level: 1 name: #alert sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
alert: msg sender: sender
self emit: msg level: 1 name: #alert sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 3/7/2006 08:23'!
critical ! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
critical: msg
self emit: msg level: 2 name: #critical sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
critical: msg sender: sender
self emit: msg level: 2 name: #critical sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
debug: msg
self emit: msg level: 7 name: #debug sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
debug: msg sender: sender
self emit: msg level: 7 name: #debug sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
emergency: msg
self emit: msg level: 0 name: #emergency sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
emergency: msg sender: sender
self emit: msg level: 0 name: #emergency sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
error: msg
self emit: msg level: 3 name: #error sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
error: msg sender: sender
self emit: msg level: 3 name: #error sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/17/2006 11:48'!
flushEmitters
emitters do: [:e | e isBlock ifFalse: [(e respondsTo: #flush) ifTrue:
[e flush]]]! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
info: msg
self emit: msg level: 6 name: #info sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
info: msg sender: sender
self emit: msg level: 6 name: #info sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
notice: msg
self emit: msg level: 5 name: #notice sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
notice: msg sender: sender
self emit: msg level: 5 name: #notice sender: sender! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:04'!
warn: msg
self emit: msg level: 4 name: #warn sender: nil! !
!SLLog methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
warn: msg sender: sender
self emit: msg level: 4 name: #warn sender: sender! !
!SLLog methodsFor: 'private' stamp: 'gk 11/20/2007 22:47'!
emit: msg level: level name: symbol sender: anObject
"This is the heart of SLLog. Pick out the sender object unless supplied
and let
all emitters emit something if it is below the globalMaxLevel. Note the
guard."
| sender |
level <= notifierMaxLevel ifTrue: [super error: symbol].
level <= globalMaxLevel ifTrue: [
sender := anObject ifNil: [thisContext sender sender sender
receiver].
guard critical: [
emitters do: [:blockOrObject |
blockOrObject isBlock ifTrue: [
blockOrObject value: level value:
symbol value: sender value: msg]
ifFalse: [
blockOrObject level: level name: symbol
sender: sender message: msg]]]]! !
!SLLog methodsFor: 'accessing' stamp: 'gk 8/30/2006 09:12'!
globalMaxLevel
^globalMaxLevel! !
!SLLog methodsFor: 'accessing' stamp: 'gk 8/30/2006 09:12'!
globalMaxLevel: level
globalMaxLevel := level! !
!SLLog methodsFor: 'accessing' stamp: 'gk 6/1/2007 11:14'!
notifierMaxLevel
^notifierMaxLevel! !
!SLLog methodsFor: 'accessing' stamp: 'gk 6/1/2007 11:14'!
notifierMaxLevel: level
notifierMaxLevel := level! !
!SLLog methodsFor: 'accessing' stamp: 'gk 8/10/2006 09:05'!
transcriptMaxLevel
^transcriptMaxLevel! !
!SLLog methodsFor: 'accessing' stamp: 'gk 8/10/2006 09:05'!
transcriptMaxLevel: level
transcriptMaxLevel := level! !
!SLLog methodsFor: 'initialize-release' stamp: 'gk 11/21/2007 08:41'!
initialize
| oldEmitters |
oldEmitters := emitters.
emitters := Set new.
transcriptMaxLevel := 7. "We emit everything to Transcript by default"
globalMaxLevel := 7. "All messages are emitted"
notifierMaxLevel := -1. "No messages trigger notifier"
guard := Monitor new.
UseTranscript ifTrue: [self addTranscript]. "simple Transcript".
oldEmitters ifNotNil: [oldEmitters do: [:e | e reInitialize]].
! !
!SLLog methodsFor: 'log protocol' stamp: 'makl 8/11/2006 10:00'!
reInitialize
"Do nothing"! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SLLog class
instanceVariableNames: ''!
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 08:58'!
addMorphic
self instance addMorphic! !
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 01:13'!
addSyslog
self instance addSyslog! !
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 01:01'!
addTranscript
self instance addTranscript! !
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 08:58'!
removeMorphic
self instance removeMorphic! !
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 01:13'!
removeSyslog
self instance removeSyslog! !
!SLLog class methodsFor: 'emitters' stamp: 'gk 11/21/2007 01:01'!
removeTranscript
self instance removeTranscript! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:34'!
alert: aString
self instance alert: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
alert: aString sender: aSender
self instance alert: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:34'!
critical: aString
self instance critical: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:05'!
critical: aString sender: aSender
self instance critical: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:34'!
debug: aString
self instance debug: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
debug: aString sender: aSender
self instance debug: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/7/2006 08:25'!
emergency: aString
self instance emergency: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
emergency: aString sender: aSender
self instance emergency: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:34'!
error: aString
self instance error: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
error: aString sender: aSender
self instance error: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
info: aString
self instance info: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
info: aString sender: aSender
self instance info: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:35'!
notice: aString
self instance notice: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
notice: aString sender: aSender
self instance notice: aString sender: aSender! !
!SLLog class methodsFor: 'logging' stamp: 'gk 11/6/2006 09:58'!
time: aBlock debug: aString
"Shorthand for logging a timed block."
| ms |
ms := aBlock timeToRun.
self instance debug: aString, ': ', ms printString, ' ms'! !
!SLLog class methodsFor: 'logging' stamp: 'gk 3/6/2006 00:33'!
warn: aString
self instance warn: aString! !
!SLLog class methodsFor: 'logging' stamp: 'gk 8/30/2006 09:06'!
warn: aString sender: aSender
self instance warn: aString sender: aSender! !
!SLLog class methodsFor: 'logging shorthand' stamp: 'gk 8/30/2006 09:02'!
crap: aString
"Short hand for typical printf littering.
All these log entries will end up under a sender called #crap."
self instance debug: aString sender: #crap! !
!SLLog class methodsFor: 'logging shorthand' stamp: 'gk 8/30/2006 09:00'!
gokr: aString
"An example of simple personal logging.
All these log entries will end up under a sender called #gokr
which makes it easy for other developers to filter it out."
self instance debug: aString sender: #gokr! !
!SLLog class methodsFor: 'control' stamp: 'gk 8/17/2006 11:46'!
flush
self instance flushEmitters! !
!SLLog class methodsFor: 'control' stamp: 'gk 8/17/2006 11:50'!
useTranscript: aBoolean
UseTranscript := aBoolean! !
!SLLog class methodsFor: 'class initialization' stamp: 'gk 6/1/2007 13:19'!
initialize
"self initialize"
UseTranscript ifNil: [self useTranscript: true].
Default := nil.
self instance initialize! !
!SLLog class methodsFor: 'class initialization' stamp: 'gk 11/20/2007 17:20'!
useGlobalLog: aBoolean
"Install/deinstall an SLLog in a global called Log."
"self useGlobalLog: true"
aBoolean
ifTrue: [Smalltalk at: #Log ifAbsentPut: [self new]]
ifFalse: [Smalltalk removeKey: #Log]! !
!SLLog class methodsFor: 'instance creation' stamp: 'makl 6/7/2006 10:38'!
instance
^Default ifNil: [Default := self new]! !
Object subclass: #SLLogFile
instanceVariableNames: 'file block uuid'
classVariableNames: ''
poolDictionaries: ''
category: 'SimpleLog'!
!SLLogFile commentStamp: 'gk 11/20/2007 22:39' prior: 0!
This is a simple emitter to a log file on disk to be used with SLLog. See
#start to see how it is added to the SLLog singleton as an emitter. It handles
log rotation with a max filesize and number of old logfiles kept around.
SLLogFile open!
!SLLogFile methodsFor: 'private' stamp: 'makl 6/2/2006 14:16'!
block: aBlock
block := aBlock! !
!SLLogFile methodsFor: 'private' stamp: 'gk 11/13/2006 15:02'!
deleteOldLogFilesFromNumber: toDelete
| num dir fn |
toDelete < 1 ifTrue: [^self].
num := toDelete.
dir := file directory.
[fn := self class baseName, '.',num printString,'.', self class
extension.
dir fileExists: fn] whileTrue: [
dir deleteFileNamed: fn.
num := num - 1]! !
!SLLogFile methodsFor: 'private' stamp: 'gk 8/17/2006 17:13'!
flush
file ensureOpen; flush! !
!SLLogFile methodsFor: 'private' stamp: 'gk 8/30/2006 14:11'!
open: fileName
file := StandardFileStream forceNewFileNamed: fileName.
file setToEnd.
self writeLine: '---------------------------'! !
!SLLogFile methodsFor: 'private' stamp: 'gk 8/7/2006 11:13'!
reset
file reset! !
!SLLogFile methodsFor: 'private' stamp: 'gk 2/16/2007 11:37'!
start
"Register myself as an emitter."
SLLog instance addEmitter: self! !
!SLLogFile methodsFor: 'private' stamp: 'gk 2/16/2007 11:37'!
stop
SLLog instance removeEmitter: self.
file close.! !
!SLLogFile methodsFor: 'private' stamp: 'gk 8/17/2006 11:44'!
writeLine: aString
((aString notNil) and: [file notNil]) ifTrue: [
file ensureOpen; nextPutAll: aString, String crlf.
"file flush"]! !
!SLLogFile methodsFor: 'log protocol' stamp: 'gk 6/1/2007 12:49'!
level: level name: symbol sender: sender message: msg
"We log everything regardless of level.
Rotate log file if max size is reached."
self writeLine: (block value: level value: symbol value: sender value:
msg).
file position > self class maxSize ifTrue: [self rotate]! !
!SLLogFile methodsFor: 'log protocol' stamp: 'makl 8/11/2006 10:01'!
reInitialize
"Do nothing"! !
!SLLogFile methodsFor: 'log protocol' stamp: 'gk 6/1/2007 12:48'!
rotate
"Close the current one. Maybe delete old log files, keeping last n.
Rename the current with highest number + 1. Open a new file."
| dir nextName number |
file close.
dir := file directory.
nextName := dir nextNameFor: self class baseName extension: self class
extension.
number := (dir splitNameVersionExtensionFor: nextName) at: 2.
self deleteOldLogFilesFromNumber: number - self class filesKept.
dir rename: file name toBe: nextName.
self open: self class filename
! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SLLogFile class
instanceVariableNames: ''!
!SLLogFile class methodsFor: 'settings' stamp: 'gk 2/16/2007 11:19'!
baseName
^'squeak'! !
!SLLogFile class methodsFor: 'settings' stamp: 'gk 11/13/2006 14:38'!
extension
^'log'! !
!SLLogFile class methodsFor: 'settings' stamp: 'gk 6/1/2007 12:47'!
filesKept
^5! !
!SLLogFile class methodsFor: 'settings' stamp: 'gk 11/13/2006 15:03'!
maxSize
^10000000 "10 MB"! !
!SLLogFile class methodsFor: 'private' stamp: 'gk 11/13/2006 14:47'!
filename
^self baseName, '.', self extension ! !
!SLLogFile class methodsFor: 'instance creation' stamp: 'gk 8/2/2006 09:39'!
named: fileName with: aBlock
"Create a new log file and start logging with the code in aBlock."
^self new open: fileName; block: aBlock; start! !
!SLLogFile class methodsFor: 'instance creation' stamp: 'gk 11/21/2007 01:16'!
open
"self open"
self named: FileDirectory default pathName, FileDirectory slash, self
filename
with: [:level :symbol :sender :msg |
String streamContents: [:stream |
DateAndTime now printOn: stream.
stream nextPutAll: ' - ', symbol, '(', level
asString;
nextPutAll: '): ', msg, ' (', sender
class name, ')']]! !
SystemWindow subclass: #SLLogMorph
instanceVariableNames: 'classes selectedClass selectedClasses
selectedSeverity messages selectedMessage removedClasses searchString
pauseResumeState bufferedMessages'
classVariableNames: ''
poolDictionaries: ''
category: 'SimpleLog'!
!SLLogMorph commentStamp: 'gk 11/21/2007 09:11' prior: 0!
This is a simple but neat log emitter that shows log messages in a Morphic tool
and offers filtering on level, sender and free text.
Open one up by:
SLLogMorph openAndRegister!
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/29/2006 17:23'!
bufferedMessages
^bufferedMessages ifNil: [bufferedMessages := OrderedCollection new]! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/29/2006 17:20'!
bufferedMessages: anObject
bufferedMessages := anObject! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/11/2006 07:51'!
classes
^classes ifNil: [classes := SortedCollection new]! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/10/2006 19:17'!
messages
^messages ifNil:[messages := OrderedCollection new]! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/29/2006 17:08'!
pauseResumeState
^pauseResumeState ifNil: [pauseResumeState := false].! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/29/2006 17:02'!
pauseResumeState: anObject
pauseResumeState := anObject! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/11/2006 12:37'!
removedClasses
^removedClasses ifNil:[removedClasses := Set new]! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/21/2006 14:20'!
searchString
^searchString ifNil: [searchString := '']! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/21/2006 14:40'!
searchString: aString
searchString := aString.
self changed: #searchString.
self changed: #filteredMessages! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/30/2006 09:34'!
selectedClasses
^selectedClasses ifNil: [selectedClasses := IdentitySet new]! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/30/2006 09:16'!
selectedClasses: anObject
selectedClasses := anObject! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 8/30/2006 09:18'!
selectedClassesAt: index
^ selectedClasses includes: index! !
!SLLogMorph methodsFor: 'accessing' stamp: 'makl 9/5/2006 10:50'!
selectedClassesAt:index put: value
value
ifTrue: [selectedClasses add: index]
ifFalse: [selectedClasses
remove: index
ifAbsent: []].
self changed: #filteredMessages! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/11/2006 13:06'!
classMenu: aMenu
"^ aMenu
labels: 'Do not log this class
Only log this class'
lines: #()
selections: #(removeClass onlyThisClass)"
^ aMenu
labels: 'Do not log this class'
lines: #()
selections: #(removeClass)! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/30/2006 13:20'!
clearMessages
messages := OrderedCollection new.
classes := OrderedCollection new.
selectedClasses := nil.
self changed: #selectedClass.
self changed: #classes.
self changed: #selectedClasses.
self changed: #filteredMessages
! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/29/2006 16:58'!
clearToThisMessage
(selectedMessage > 0) ifTrue: [
messages := self messages copyFrom: selectedMessage to:
messages size.
"classes := messages inject: OrderedCollection new into: [:coll
:msg |
(coll includes: msg key) ifFalse: [coll
add: msg key]. coll.]."
self changed: #selectedClass.
self changed: #classes.
self changed: #filteredMessages
].! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/29/2006 17:10'!
messagesMenu: aMenu
"^ aMenu
labels: 'Do not log this class
Only log this class'
lines: #()
selections: #(removeClass onlyThisClass)"
^ aMenu
labels: 'Clear all messages
Clear all messages before this one
', (self pauseResumeState ifTrue: ['Resume'] ifFalse: ['Pause'])
lines: #(2)
selections: #(clearMessages clearToThisMessage pauseResume)! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/11/2006 13:06'!
onlyThisClass
""! !
!SLLogMorph methodsFor: 'menus' stamp: 'gk 6/1/2007 12:55'!
pauseResume
(self pauseResumeState) ifFalse: [
self setLabel: 'Paused'.
pauseResumeState := true
] ifTrue: [
self setLabel: 'LogMorph'.
pauseResumeState := false.
messages addAll: self bufferedMessages.
self bufferedMessages: OrderedCollection new.
self changed: #classes.
self changed: #filteredMessages
]! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/11/2006 12:33'!
perform: selector orSendTo: otherTarget
"Selector was just chosen from a menu by a user. If can respond, then
perform it on myself. If not, send it to otherTarget, presumably the
editPane from which the menu was invoked."
(self respondsTo: selector)
ifTrue: [^ self perform: selector]
ifFalse: [^ super perform: selector orSendTo: otherTarget]! !
!SLLogMorph methodsFor: 'menus' stamp: 'makl 8/30/2006 13:19'!
removeClass
selectedClass ifNotNil: [
self removedClasses add: (selectedClass).
messages := messages reject: [:e |
e key = selectedClass].
classes remove: selectedClass.
self selectedClass: 0.
self changed: #selectedClass.
self changed: #classes.
self changed: #selectedClasses.
self changed: #filteredMessages
] ! !
!SLLogMorph methodsFor: 'private' stamp: 'gk 6/1/2007 12:55'!
closeBoxHit
SLLog instance removeEmitter: self.
super closeBoxHit! !
!SLLogMorph methodsFor: 'private' stamp: 'makl 9/5/2006 10:40'!
filteredMessages
^ self messages inject: OrderedCollection new into: [:coll :each |
((self testClass: each) and:
[self testSeverity: each] and:
[self testFilter: each])
ifTrue: [coll add: each value value].
coll
]! !
!SLLogMorph methodsFor: 'private' stamp: 'gk 11/15/2006 10:45'!
getSeverity
^#('0-emergency' '1-alert' '2-critical' '3-error' '4-warn' '5-notice'
'6-info' '7-debug')! !
!SLLogMorph methodsFor: 'log protocol' stamp: 'gk 6/1/2007 12:58'!
level: level name: symbol sender: sender message: msg
| str |
(self removedClasses includes: sender name) ifFalse: [
str := DateAndTime now printString, ' - ', symbol, ' - ', msg.
self pauseResumeState ifFalse: [
self messages add: (sender name)->(level->str).
(self classes anySatisfy: [:any | any = sender name])
ifFalse: [
classes add: (sender name ifNil: [sender
printString]).
self changed: #classes].
self changed: #filteredMessages
] ifTrue: [
self bufferedMessages add: (sender name)->(level->str)
]
]! !
!SLLogMorph methodsFor: 'log protocol' stamp: 'gk 2/16/2007 11:37'!
reInitialize
SLLog instance addEmitter: self! !
!SLLogMorph methodsFor: 'morphic' stamp: 'gk 11/21/2007 08:37'!
open
"Open an instance in the World, but you need to register it
as an emitter too."
| horizontalSplit verticalSplit verticalSplit2 |
horizontalSplit := 0.5.
verticalSplit := 0.3.
verticalSplit2 := 0.9.
selectedClasses := IdentitySet new.
self addMorph: (
(PluggableListMorphOfMany
on: self
list: #classes
primarySelection: #selectedClass
changePrimarySelection: #selectedClass:
listSelection: #selectedClassesAt:
changeListSelection: #selectedClassesAt:put:
menu: #classMenu:)
) frame: (0@0 corner: horizontalSplit@verticalSplit).
self addMorph: (
(PluggableListMorph
on: self
list: #getSeverity
selected: #selectedSeverity
changeSelected: #selectedSeverity:
menu: nil)
autoDeselect: false) frame: (horizontalSplit@0 corner:
1@verticalSplit).
self addMorph: (
(PluggableListMorph
on: self
list: #filteredMessages
selected: #selectedMessage
changeSelected: #selectedMessage:
menu: #messagesMenu:)
autoDeselect: false) frame: (0@verticalSplit corner:
1@verticalSplit2).
self addMorph: (
(PluggableTextMorph on: self
text: #searchString accept: #searchString:
readSelection: nil menu: nil)
acceptOnCR: true;
setProperty: #alwaysAccept toValue: true;
hideScrollBarsIndefinitely )
frame: (0@verticalSplit2 corner: 1@1).
self setWindowColor: (Color r: 0.75 g: 0.75 b: 0.05).
self openInWorld.
^self! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/11/2006 08:02'!
selectedClass
^classes ifNotNil:[classes indexOf: selectedClass] ifNil:[0]! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/11/2006 12:56'!
selectedClass: s
selectedClass := ((s=0) or: [(classes at: s) = selectedClass])ifTrue:
[nil] ifFalse: [classes at: s].
self changed: #selectedClass.
self changed: #filteredMessages! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/11/2006 08:13'!
selectedMessage
^selectedMessage ifNil:[selectedMessage := 0]! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/10/2006 19:00'!
selectedMessage: s
selectedMessage := (s = selectedMessage) ifTrue: [nil] ifFalse: [s].
self changed: #selectedMessage! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/14/2006 08:39'!
selectedSeverity
^selectedSeverity ifNil:[selectedSeverity := 8]! !
!SLLogMorph methodsFor: 'selected' stamp: 'makl 8/10/2006 19:21'!
selectedSeverity: s
selectedSeverity := (s = selectedSeverity) ifTrue: [nil] ifFalse: [s].
self changed: #selectedSeverity.
self changed: #filteredMessages! !
!SLLogMorph methodsFor: 'testing' stamp: 'makl 9/5/2006 07:38'!
testClass: aMessage
^(self selectedClasses anySatisfy: [:c | (classes at: c) = aMessage
key]) or:
[self selectedClasses isEmpty]! !
!SLLogMorph methodsFor: 'testing' stamp: 'makl 9/5/2006 10:42'!
testFilter: aMessage
| lowerString |
lowerString := aMessage value value asLowercase.
^(self searchString asString substrings allSatisfy: [:sub |
sub := (sub asLowercase) replaceAll: $_ with: (Character space).
((sub first = $-) and: [(lowerString includesSubString: sub
allButFirst) not]) or:
[(sub first = $+) and: [lowerString includesSubString: sub
allButFirst]] or:
[lowerString includesSubString: sub]])! !
!SLLogMorph methodsFor: 'testing' stamp: 'makl 8/29/2006 12:20'!
testSeverity: aMessage
^(aMessage value key < self selectedSeverity)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SLLogMorph class
instanceVariableNames: 'selected'!
!SLLogMorph class methodsFor: 'as yet unclassified' stamp: 'gk 11/21/2007
08:56'!
open
"Open in Morphic. Note that this does not register it
as an emitter in any SLLog instance."
"self open"
^(self labelled: 'LogMorph') open; yourself! !
!SLLogMorph class methodsFor: 'as yet unclassified' stamp: 'gk 11/21/2007
08:55'!
openAndRegister
"Open and register in SLLog standard singleton."
"self openAndRegister"
SLLog instance addMorphic! !
TestCase subclass: #SLLogTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SimpleLog'!
!SLLogTests commentStamp: 'gk 6/1/2007 13:20' prior: 0!
A few simple tests.!
!SLLogTests methodsFor: 'as yet unclassified' stamp: 'gk 6/1/2007 13:30'!
testLogFile
| levels all some crlf |
crlf := String with: Character cr with: Character lf.
levels := {#emergency. #alert. #critical. #error". #warning. #notice.
#info. #debug"}.
FileDirectory default deleteFileNamed: 'testall.log'; deleteFileNamed:
'testsome.log'.
all := SLLogFile named: 'testall.log' with: [:level :symbol :sender
:msg |
symbol, ': ', msg, ' (', sender class name, ')'].
some := SLLogFile named: 'testsome.log' with: [:level :symbol :sender
:msg |
((levels includes: symbol) and:
[msg beginsWith: 'makl'] and:
[sender notNil]) ifTrue: [
symbol, ': ', msg, ' (', sender class
name, ')'
]
].
"Do some stuff"
SLLog info: 'Testing info'.
SLLog warn: 'Testing warning'.
SLLog error: 'makl cannot code!!'.
all stop.
some stop.
all := (FileDirectory default) oldFileNamed: 'testall.log'.
some := (FileDirectory default) oldFileNamed: 'testsome.log'.
self assert: (all contents = ('---------------------------', crlf,
'info: Testing
info (SLLogTests)', crlf,
'warn: Testing
warning (SLLogTests)', crlf,
'error: makl
cannot code!! (SLLogTests)', crlf)).
self assert: (some contents = ('---------------------------', crlf,
'error: makl
cannot code!! (SLLogTests)', crlf)).
all close.
some close.
FileDirectory default deleteFileNamed: 'testall.log'; deleteFileNamed:
'testsome.log'.! !
Object subclass: #SLLogWatchdog
instanceVariableNames: ''
classVariableNames: 'Buffer CollectMinutes FromEmail SMTPAccount
SMTPPassword SMTPServer Threshold Timer ToEmail'
poolDictionaries: ''
category: 'SimpleLog'!
!SLLogWatchdog commentStamp: 'gk 6/1/2007 13:10' prior: 0!
This log emitter has a threshold. If log messages comes in that are higher than
the threshold we send an email to an address with the log message. We then set
a timer and any messages coming in over the threshold until the timer has run
out we bundle together in another email, send it and set the timer again.
If the timer runs out and there are no buffered messages we are done. This
approach prevents drowning in emails.
Use like this:
SLLogWatchDog
fromEmail: '[email protected]';
toEmail: '[email protected]';
start
Stop:
SLLogWatchDog stop!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SLLogWatchdog class
instanceVariableNames: ''!
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 2/16/2007 11:34'!
SMTPServer: aServerName
SMTPServer := aServerName ! !
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 6/1/2007 13:13'!
account: anEmail
SMTPAccount := anEmail ! !
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 2/16/2007 11:46'!
collectMinutes: minutes
CollectMinutes := minutes ! !
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 6/1/2007 13:05'!
fromEmail: anEmailAddress
FromEmail := anEmailAddress! !
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 6/1/2007 13:14'!
password: aString
SMTPPassword := aString! !
!SLLogWatchdog class methodsFor: 'configuration' stamp: 'gk 6/1/2007 13:05'!
toEmail: anEmailAddress
ToEmail := anEmailAddress! !
!SLLogWatchdog class methodsFor: 'class initialization' stamp: 'gk 6/1/2007
13:07'!
initialize
"Default threshold ignores debug and info but includes warnings and
worse."
"self initialize"
Threshold := 4.
Buffer := Timer := nil.
CollectMinutes := 300.
SMTPServer := 'localhost'! !
!SLLogWatchdog class methodsFor: 'log protocol' stamp: 'gk 6/1/2007 13:03'!
level: level name: symbol sender: sender message: msg
"This method looks messy, and it is - but it is written to be as fast
as possible."
"Is this message over the threshold?"
| message now |
level <= Threshold
ifTrue: [
message := DateAndTime now printString,' - ', symbol,
'(', level asString, '): ', msg, ' (', sender class name, ')'.
Buffer
ifNotNil: [
"Add message to the buffer and possibly
send it if the timer is out."
Buffer nextPutAll: message.
now := DateAndTime now asSeconds.
"Is the timer out? If so, send the
buffer."
now > Timer ifTrue: [
self sendBuffer]]
ifNil: [
"No buffer to send nor add message to.
Set the timer and send the message."
Timer := DateAndTime now asSeconds +
CollectMinutes.
Buffer := String new writeStream.
self sendMessage: message]]
ifFalse: [
"Ok, no message this time - do we have a buffer to send
when the timer goes out?"
Buffer ifNotNil: [
now := DateAndTime now asSeconds.
"Is the timer out? If so, if the buffer has
content - send the buffer and reset Timer. Otherwise nil Buffer."
now > Timer ifTrue: [
Buffer isEmpty
ifTrue: [Buffer := nil]
ifFalse: [self sendBuffer]]]]! !
!SLLogWatchdog class methodsFor: 'log protocol' stamp: 'gk 11/14/2006 23:17'!
reInitialize
Buffer := Timer := nil.
self start! !
!SLLogWatchdog class methodsFor: 'private' stamp: 'gk 6/1/2007 13:14'!
mailFrom: sender to: receivers text: headerAndBody
| smtpClient |
smtpClient := SMTPClient new.
SMTPAccount ifNotNil: [
smtpClient user: SMTPAccount; password: SMTPPassword.
[smtpClient openOnHost: (NetNameResolver addressForName:
SMTPServer timeout: 20) port: 25.
[smtpClient mailFrom: sender to: receivers text: headerAndBody]
ensure: [smtpClient close]]
on: Error do: [:ex |
SLLog error: 'Error when sending email:
', ex asString]
]! !
!SLLogWatchdog class methodsFor: 'private' stamp: 'gk 6/1/2007 13:04'!
sendBuffer
"Send the buffer, reset timer, empty buffer."
self sendMessage: Buffer contents.
Timer := DateAndTime now asSeconds + 60.
Buffer := String new writeStream! !
!SLLogWatchdog class methodsFor: 'private' stamp: 'gk 6/1/2007 13:06'!
sendMessage: msg
"Send the message."
"Transcript show: 'Watchdog sending: ', msg;cr."
ToEmail isEmptyOrNil
ifFalse: [
self
mailFrom: FromEmail
to: (Array with: ToEmail)
text: 'Subject: Important log messages
Log messages above threshold:
', msg]
! !
!SLLogWatchdog class methodsFor: 'start and stop' stamp: 'gk 6/1/2007 13:08'!
start
"self start"
SLLog instance addEmitter: self! !
!SLLogWatchdog class methodsFor: 'start and stop' stamp: 'gk 6/1/2007 13:08'!
stop
"self stop"
SLLog instance removeEmitter: self! !
Object subclass: #SLSyslogSender
instanceVariableNames: 'hostName facility hosts'
classVariableNames: ''
poolDictionaries: ''
category: 'SimpleLog'!
!SLSyslogSender commentStamp: 'gk 11/21/2007 01:31' prior: 0!
An emitter that emits to a remote host (or several) using the syslog protocol
in UDP.
The facility is set by number, default is local0, probably just fine.
You may want to set the hostName to something different than localhost.
- Make sure your syslog host (default is localhost) is enabled to listen on
port 514.
Test this by:
SLLog addSyslog. "Adds a syslog sender emitter to localhost by default"
SLLog info: 'Testing syslog'!
!SLSyslogSender methodsFor: 'accessing' stamp: 'gk 11/21/2007 01:10'!
addHost: aString
"Add a host to send to, 514 is default syslog port."
self addHost: aString port: 514! !
!SLSyslogSender methodsFor: 'accessing' stamp: 'gk 11/21/2007 01:10'!
addHost: aString port: aPortNumber
"Add a host name with portnumber."
hosts add: aString -> (aPortNumber ifNil: [514])! !
!SLSyslogSender methodsFor: 'accessing' stamp: 'gk 11/21/2007 01:07'!
facility: anInteger
"We keep it multiplied with 8 so we don't need to do that every time we
emit."
facility := anInteger * 8! !
!SLSyslogSender methodsFor: 'accessing' stamp: 'gk 11/21/2007 00:03'!
hostName
"Apparently this is not that easy to find cross platform."
^hostName ifNil: ['localhost']! !
!SLSyslogSender methodsFor: 'accessing' stamp: 'gk 11/21/2007 01:08'!
hostName: aHostName
"Apparently this is not that easy to find cross platform."
hostName := aHostName! !
!SLSyslogSender methodsFor: 'initialize-release' stamp: 'gk 11/21/2007 01:12'!
initialize
self facility: 16. "Use 1 (=user level) or 16-23 (=local use local0-7)"
hosts := OrderedCollection with: 'localhost'->514! !
!SLSyslogSender methodsFor: 'private' stamp: 'gk 11/21/2007 01:29'!
level: level name: symbol sender: sender message: msg
"Produce a standard message and send it using UDP to all registered
hosts."
| message now d dd |
now := DateAndTime now.
d := now dayOfMonth.
dd := d < 10 ifTrue: [' ', d asString] ifFalse: [d asString].
message := String streamContents: [:s |
s nextPut: $<;
nextPutAll: (facility + level) asString;
nextPut: $>;
nextPutAll: now monthAbbreviation;
nextPutAll: ' ', dd, ' '.
now asTime print24: true on: s.
s nextPutAll: ' ', self hostName, ' ';
nextPutAll: symbol, '(', level asString, '): ', msg, '
(', sender asString, ')'].
hosts do: [:host | self send: message to: host key port: host value]! !
!SLSyslogSender methodsFor: 'private' stamp: 'gk 11/21/2007 00:04'!
send: message to: host port: port
"Send formatted UDP message to host and port."
| sock |
sock := Socket newUDP.
sock setPeer: NetNameResolver localHostAddress port: port.
sock sendData: message.
sock waitForSendDoneFor: Socket standardDeadline.
sock close! !
SLLog initialize!
SLLogWatchdog initialize!
