--- a/MiniLogger.st Thu Jun 28 11:56:11 2018 +0200
+++ b/MiniLogger.st Thu Jun 28 11:57:01 2018 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2012-2014 by Jan Vrany & eXept Software AG
All Rights Reserved
@@ -526,44 +528,65 @@
"Created: / 14-09-2011 / 21:20:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-log: message severity: severity facility: facility originator: originator attachment: attachment
+log:message severity:severity facility:facilityArg originator:originator attachment:attachment
"Pricipal logging method. This mimics VM __stxLog__()"
- | severityXlated messageXlated logOnStderr logOnTranscript prevLogOnTranscript |
+ | severityXlated messageXlated prevLogOnTranscript facility severityName words secondWord|
- logOnStderr := self logOnStderr.
- logOnTranscript := self logOnTranscript and:[Transcript isView].
-
- (logOnStderr or:[logOnTranscript]) ifFalse:[^ self].
+ (self canLog) ifFalse:[^ self].
severityXlated := severity.
- "/ Be backward compatible, allow for symbolic severities
- "/ but when encountered, issue a warning...
- severity isSymbol ifTrue:[
- severityXlated := Severities detect:[:each| each name == severity] ifNone:[].
+ severityXlated isSymbol ifTrue:[
+ "/ Be backward compatible, allow for symbolic severities
+ "/ but when encountered, issue a warning...
+ severityXlated := Severities detect:[:each| each name == severityXlated] ifNone:[].
"/ This will be enabled later, so far it generates
"/ way to much warnings. at least stx:libjava & exept:jdi has to be rewritten
-
+
"/ self log: 'using symbols as severity is deprecated, use Logger severityXXX to get severity object' severity: WARN facility: 'STX' originator: self.
"/ caller := thisContext sender.
"/ [ caller notNil and: [ caller receiver ~~ originator ] ] whileTrue:[ caller := caller sender ].
"/ self log: 'caller is ', caller printString severity: INFO facility: 'STX' originator: self.
+ ] ifFalse:[
+ "/ Now check whether the severity is one of the predefined ones,
+ "/ if not, issue an error
+ (Severities includesIdentical:severityXlated) ifFalse:[
+ | caller |
+
+ caller := thisContext sender.
+ [caller notNil and:[caller receiver ~~ originator]] whileTrue:[
+ caller := caller sender
+ ].
+ self log:('no such severity (%1, called from %2), use one from predefined severities. Original message will be logged as INFO' bindWith:severityXlated with:caller)
+ severity: ERROR facility: 'STX' originator: self.
+ severityXlated := INFO.
+ ].
].
- "/ Now check whether the severity is one of the predefined ones,
- "/ if not, issue an error
- (Severities includesIdentical: severityXlated) ifFalse:[
- | caller |
+ messageXlated := message value asString.
+ facility := facilityArg.
- caller := thisContext sender.
- [caller notNil and:[caller receiver ~~ originator]] whileTrue:[
- caller := caller sender
+ "/ hack to allow calls from #infoPrint/#errorPrint.
+ "/ if this is an oldStyle #infoPrint or #errorPrint, do not append another facility and severity
+ words := messageXlated asCollectionOfWords.
+ (words size >= 2
+ and:[words first isAlphaNumeric
+ and:[((secondWord := words second) startsWith:$[ )
+ and:[(secondWord endsWith:$]) or:[(secondWord endsWith:']:')]]]]) ifTrue:[
+ facility := words first.
+ severityName := secondWord copyFrom:2 to:(secondWord indexOf:$])-1.
+ severityXlated := Severities detect:[:each| each name = severityName]
+ ifNone:[Severity new initializeWithName:severityName value:severity value].
+
+ messageXlated := messageXlated copyFrom:(messageXlated indexOf:$])+1.
+ (messageXlated startsWith:$:) ifTrue:[
+ messageXlated := messageXlated copyFrom:2.
].
- self log:('no such severity (%1, called from %2), use one from predefined severities. Original message will be logged as INFO' bindWith:severityXlated with:caller)
- severity: ERROR facility: 'STX' originator: self.
- severityXlated := INFO.
+ (messageXlated startsWith:Character space) ifTrue:[
+ messageXlated := messageXlated copyFrom:2.
+ ].
].
"/ a quick rejector to avoid overhead in deployed apps
@@ -573,20 +596,22 @@
((self severityThresholdOf:originator) > severityXlated) ifTrue:[^ self ].
].
- messageXlated := message value asString.
+ thisContext isRecursive ifTrue:[
+ 'STX:Logger [error]: recursive logger invocation.' _errorPrintCR.
+ ^ self.
+ ].
"/ to avoid recursion, turn off logOnTranscript while logging
"/ had this problem with RecursionLock, which wanted to issue a warning
"/ ("cleanup for dead process") from inside Transcript code.
+ prevLogOnTranscript := LogOnTranscript.
[
- prevLogOnTranscript := LogOnTranscript.
LogOnTranscript := false.
- logOnStderr ifTrue:[
- self log:messageXlated severity:severityXlated facility:facility
- originator:originator attachment:attachment on:Stderr.
- ].
- logOnTranscript ifTrue:[
+ self basicLog:messageXlated severity:severityXlated facility:facility
+ originator:originator attachment:attachment.
+
+ (prevLogOnTranscript and:[Transcript isView]) ifTrue:[
Transcript nextPutLine:messageXlated.
].
] ensure:[
@@ -598,11 +623,28 @@
Logger log:'test message' severity:#info facility: 'TEST'
Logger log:'test message' severity:#bla facility: 'TEST'
Logger log:'test message' severity:123 facility: 'TEST'
+
+ Logger log:'test message' severity: DEBUG facility: 'TEST'
+ Logger log:'test message' severity: INFO facility: 'TEST'
+ Logger log:'test message' asUnicode16String severity: INFO facility: 'TEST'
+ Logger log:'test message äöüß' severity: INFO facility: 'TEST'
+ Logger log:'test message' severity: WARNING facility: 'TEST'
+ Logger log:'test message' severity: ERROR facility: 'TEST'
+ 'test message' infoPrintCR
+ 'test message' errorPrintCR
+ "
+
+ "backward compatibility with infoPrint/errorPrint callers:
+ 'foo [info] test message' infoPrintCR
+ 'bar [error] test message' errorPrintCR
+ 'foo [info]: test message' infoPrintCR
+ 'bar [error]: test message' errorPrintCR
"
"Created: / 14-09-2011 / 21:18:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-01-2015 / 18:40:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-03-2017 / 11:15:46 / cg"
+ "Modified: / 28-06-2018 / 11:15:42 / Stefan Vogel"
!
log: message severity: severity originator: originator
@@ -1096,6 +1138,49 @@
!MiniLogger class methodsFor:'private'!
+basicLog: message severity: severity facility: facility originator: originator attachment: attachment
+ "Principal logging method. This mimics VM __stxLog__()"
+
+ |messageAsSent|
+
+ (LogOnStderr not or:[Stderr isNil]) ifFalse:[
+ ^ self.
+ ].
+
+ messageAsSent :=
+ self logFormat
+ bindWith:(facility ? 'STX')
+ with:severity name
+ with:(Timestamp now printStringFormat:(self timestampFormat))
+ with:originator
+ with:message.
+
+ "/ If the message is Unicode 16/32 string and stream is external,
+ "/ we have to recode the message using locale-specific encoding
+ Stderr isExternalStream ifTrue:[
+ messageAsSent := messageAsSent string. "take care of Texts"
+ messageAsSent containsNon7BitAscii ifTrue:[
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ messageAsSent := messageAsSent utf8Encoded.
+ ] ifFalse:[
+ messageAsSent := OperatingSystem encodePath:messageAsSent.
+ ].
+ ].
+ [
+ Stderr nextPutLine: messageAsSent
+ ] on:StreamError do:[:ex|
+ 'STX:Logger [error]: error writing to stream: ' _errorPrint.
+ ex description _errorPrintCR.
+ messageAsSent _errorPrintCR.
+ ].
+ ^ self.
+ ].
+
+ Stderr nextPutLine: messageAsSent
+
+ "Created: / 28-06-2018 / 11:05:17 / Stefan Vogel"
+!
+
expand:message
|d|
@@ -1187,98 +1272,6 @@
"Modified: / 01-03-2017 / 10:43:23 / cg"
!
-log: message severity: severity facility: facilityArg originator: originator attachment: attachment on:aStream
- "Principal logging method. This mimics VM __stxLog__()"
-
- |facility severityName words messageAsSent secondWord|
-
- aStream isNil ifTrue:[^ self].
-
- thisContext isRecursive ifTrue:[
- 'STX:Logger [error]: recursive logger invocation.' _errorPrintCR.
- ^ self.
- ].
-
- facility := facilityArg.
- messageAsSent := message.
- severityName := severity name.
-
- "/ hack to allow calls from infoPrint/errorPrint.
- "/ if this is an oldStyle infoPrint or errorPrint, do not append another facility and severity
- words := messageAsSent asCollectionOfWords.
- (words size >= 2
- and:[words first isAlphaNumeric
- and:[((secondWord := words second) startsWith:$[ )
- and:[(secondWord endsWith:$]) or:[(secondWord endsWith:']:')]]]]) ifTrue:[
- facility := words first.
- severityName := secondWord copyButFirst.
- severityName := severityName copyTo:(severityName indexOf:$])-1.
- messageAsSent := messageAsSent copyFrom:(messageAsSent indexOf:$])+1.
- "/ messageAsSent := messageAsSent withoutSeparators.
- (messageAsSent startsWith:$:) ifTrue:[
- messageAsSent := messageAsSent copyFrom:2.
- "/ messageAsSent := messageAsSent withoutSeparators.
- (messageAsSent startsWith:Character space) ifTrue:[
- messageAsSent := messageAsSent copyFrom:2.
- ].
- ].
- ].
-
- messageAsSent :=
- self logFormat
- bindWith:(facility ? 'STX')
- with:severityName
- with:(Timestamp now printStringFormat:(self timestampFormat))
- with:originator
- with:messageAsSent.
-
- "/ If the message is Unicode 16/32 string and stream is external,
- "/ we have to recode the message using locale-specific encoding
- aStream isExternalStream ifTrue:[
- messageAsSent := messageAsSent string. "take care of Texts"
- messageAsSent containsNon7BitAscii ifTrue:[
- OperatingSystem isMSWINDOWSlike ifTrue:[
- messageAsSent := messageAsSent utf8Encoded.
- ] ifFalse:[
- messageAsSent := OperatingSystem encodePath:messageAsSent.
- ].
- ].
- [
- aStream nextPutLine: messageAsSent
- ] on:StreamError do:[:ex|
- 'STX:Logger [error]: error writing to stream: ' _errorPrint.
- ex description _errorPrintCR.
- messageAsSent _errorPrintCR.
- ].
- ^ self.
- ].
-
- aStream nextPutLine: messageAsSent
-
- "
- 'hello' infoPrintCR.
-
- Logger log:'test message' severity: DEBUG facility: 'TEST'
- Logger log:'test message' severity: INFO facility: 'TEST'
- Logger log:'test message' asUnicode16String severity: INFO facility: 'TEST'
- Logger log:'test message äöüß' severity: INFO facility: 'TEST'
- Logger log:'test message' severity: WARNING facility: 'TEST'
- Logger log:'test message' severity: ERROR facility: 'TEST'
- 'test message' infoPrintCR
- 'test message' errorPrintCR
- "
- "backward compatibility with infoPrint/errorPrint callers:
- 'foo [info] test message' infoPrintCR
- 'bar [error] test message' errorPrintCR
- 'foo [info]: test message' infoPrintCR
- 'bar [error]: test message' errorPrintCR
- "
-
- "Created: / 14-09-2011 / 21:18:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 02-12-2014 / 10:50:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-06-2018 / 15:27:45 / Claus Gittinger"
-!
-
severityThresholdOf:originator
"allow each class to define an individual threshold for Logging"
@@ -1315,6 +1308,17 @@
"Modified (comment): / 01-03-2017 / 10:59:12 / cg"
! !
+!MiniLogger class methodsFor:'queries'!
+
+canLog
+ "answer true, if logging can be performed. Subclasse may redefine this."
+
+ ^ (LogOnStderr and:[Stderr notNil])
+ or:[LogOnTranscript and:[Transcript isView]].
+
+ "Created: / 28-06-2018 / 10:47:29 / Stefan Vogel"
+! !
+
!MiniLogger::Severity methodsFor:'accessing'!
name