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: 'mysystem@brrrrrrrrrrr.org'; toEmail: 'me@brrrrrrrrrrr.org'; 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!