"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 2012-2014 by Jan Vrany & eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

Object subclass:#MiniLogger

	instanceVariableNames:''

	classVariableNames:'ALL DEBUG ENTER ERROR FATAL INFO Instance LEAVE NONE Severities

		TRACE TRACE0 TRACE1 TRACE2 TRACE3 Threshold WARN WARNING

		LogOnTranscript LogOnStderr'

	poolDictionaries:''

	category:'System-Debugging-Support'

!

Object subclass:#Severity

	instanceVariableNames:'name value'

	classVariableNames:''

	poolDictionaries:''

	privateIn:MiniLogger

!

!MiniLogger class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2012-2014 by Jan Vrany & eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"   

    A very simple logger for Smalltalk/X. This one is always present.

    It mimics the protocol of the loggers found in stx:goodies/loggia,

    which can be activated by setting the global 'Logger' to an instance of

    on of them.

    All 

        `Transcript show: 'Processor [info]: xxx' 

    should be rewritten over time to use the Logger.

    'Object infoPrint' and 'Object debugPrint' have been changed to

    forward their message to the global 'Logger' unless nil.

    Usage:

        Logger info: 'Hello worlds'.

        Logger debug: 'Hello worlds'.

        Logger warning: 'Hello worlds'.

        Logger error: 'Hello worlds'.

    For more examples, see #examples.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

        Loggia logging framrwork (stx:goodies/loggia)

"

!

examples

"   

    Simple logging (make sure logging threshold is lower or equal then

    Logger severityDEBUG, see #loggingThreshold:)

                                                                        [exBegin]    

        Logger debug: 'Hello world!!'

                                                                        [exEnd]

    You may use #<severity>:with:with: utility to format log message:

                                                                        [exBegin]    

        | hostname port |

        hostname := 'www.google.com'.

        port := 80.

        Logger error: 'Cannot connect to %1 port %2' with: hostname with: port

                                                                        [exEnd]

    When a log message is costly to construct, you may pass a block returning

    the message instead of string. Then the log message creation os deferred until

    really needed (i.e., if the severity is not logged, block is not evaluated.

    Useful for trace messages (severities DEBUG and TRACE?):

                                                                        [exBegin]    

        | hostname port |

        hostname := 'www.google.com'.

        Logger trace: [ 'Connecting to %1' bindWith: (IPSocketAddress hostName:hostname) address ]

                                                                        [exEnd]

"

! !

!MiniLogger class methodsFor:'initialization'!

initialize

    ALL := Severity new initializeWithName:#all value:0.

    ENTER := Severity new initializeWithName:#enter value:10.

    LEAVE := Severity new initializeWithName:#leave value:10.

    TRACE3 := Severity new initializeWithName:#trace3 value:20.

    TRACE2 := Severity new initializeWithName:#trace2 value:30.

    TRACE1 := Severity new initializeWithName:#trace1 value:40.

    TRACE0 := Severity new initializeWithName:#trace0 value:50.

    TRACE := Severity new initializeWithName:#trace value:50.

    DEBUG := Severity new initializeWithName:#debug value:60.

    INFO := Severity new initializeWithName:#info value:70.

    WARN := Severity new initializeWithName:#warn value:88.

    WARNING := Severity new initializeWithName:#warning value:88.

    ERROR := Severity new initializeWithName:#error value:99.

    FATAL := Severity new initializeWithName:#fatal value:100.

    NONE := Severity new initializeWithName:#none value:65535.

    Severities := Array new:13.

    Severities at:1 put:ENTER.

    Severities at:2 put:LEAVE.

    Severities at:3 put:TRACE3.

    Severities at:4 put:TRACE2.

    Severities at:5 put:TRACE1.

    Severities at:6 put:TRACE0.

    Severities at:7 put:TRACE.

    Severities at:8 put:DEBUG.

    Severities at:9 put:INFO.

    Severities at:10 put:WARN.

    Severities at:11 put:WARNING.

    Severities at:12 put:ERROR.

    Severities at:13 put:FATAL.

    Threshold := InfoPrinting ifTrue:[INFO] ifFalse:[WARN].

    (Smalltalk at:#Logger) isNil ifTrue:[

        Smalltalk at:#Logger put:self

    ].

    "Modified: / 13-08-2014 / 14:36:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

logOnStderr 

    ^ LogOnStderr ? true

!

logOnStderr:aBoolean 

    LogOnStderr := aBoolean

!

logOnTranscript

    ^ LogOnTranscript ? true

!

logOnTranscript:aBoolean

    LogOnTranscript := aBoolean

! !

!MiniLogger class methodsFor:'accessing-severities'!

severityDEBUG

    ^ DEBUG

    "Created: / 13-08-2014 / 14:15:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityENTER

    ^ ENTER

    "Created: / 13-08-2014 / 14:14:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityERROR

    ^ ERROR

    "Created: / 13-08-2014 / 14:15:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityFATAL

    ^ FATAL

    "Created: / 13-08-2014 / 14:15:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityINFO

    ^ INFO

    "Created: / 13-08-2014 / 14:15:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityLEAVE

    ^ LEAVE

    "Created: / 13-08-2014 / 14:14:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityTRACE

    ^ TRACE

    "Created: / 13-08-2014 / 14:15:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityTRACE0

    ^ TRACE0

    "Created: / 13-08-2014 / 14:14:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityTRACE1

    ^ TRACE1

    "Created: / 13-08-2014 / 14:14:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityTRACE2

    ^ TRACE2

    "Created: / 13-08-2014 / 14:14:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityTRACE3

    ^ TRACE3

    "Created: / 13-08-2014 / 14:14:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityWARN

    ^ WARN

    "Created: / 13-08-2014 / 14:15:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MiniLogger class methodsFor:'accessing-severities-special'!

severityALL

    ^ ALL

    "Created: / 13-08-2014 / 14:14:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

severityNONE

    ^ NONE

    "Created: / 13-08-2014 / 14:15:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MiniLogger class methodsFor:'configuration'!

loggingThreshold

    "Return the logging threshold. No messages with severity lower than 

     threshold will be logged."

    ^ Threshold

    "Created: / 13-08-2014 / 14:36:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

loggingThreshold:severity 

    "Sets logging threshold. No severity lower than given one will be logged.

     Use `Logger severityNONE` to suppress logging completely or

     `Logger severityALL` to log all messages"

    ((Severities includes:severity) 

        or:[ severity == ALL or:[ severity == NONE ] ]) 

            ifFalse:[

                self error:'Invalid severity. Use of Logger severityXXX'.

                ^ self.

            ].

    Threshold := severity

    "

    Logger loggingThreshold: Logger severityALL.

    Logger loggingThreshold: Logger severityINFO.

    Logger loggingThreshold: Logger severityNONE.

    "

    "Created: / 13-08-2014 / 14:34:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 26-08-2014 / 08:23:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 09-10-2014 / 09:35:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MiniLogger class methodsFor:'logging'!

log: message

    self log: message severity: DEBUG originator: thisContext sender receiver.

    "Created: / 15-09-2011 / 10:27:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-12-2014 / 10:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message facility: facility

    self log: message severity: DEBUG facility: facility originator: thisContext sender receiver

    "Created: / 14-09-2011 / 21:22:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-12-2014 / 10:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message severity: severity

    self log: message severity: severity originator: thisContext sender receiver

    "Created: / 15-09-2011 / 10:25:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-12-2014 / 10:53:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message severity: severity attachment: attachment

    | originator |

    originator := thisContext sender receiver.

    self log: message severity: severity facility: (self facilityOf: originator) originator: originator attachment: attachment

    "Created: / 15-09-2011 / 11:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-03-2013 / 11:20:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 26-08-2014 / 08:23:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message severity: severity facility: facility

    self log: message severity: severity facility: facility originator: thisContext sender receiver

    "Created: / 14-09-2011 / 21:20:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message severity: severity facility: facility originator: originator

    self log: message severity: severity facility: facility originator: originator attachment: nil

    "Created: / 14-09-2011 / 21:20:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log: message severity: severity facility: facility originator: originator attachment: attachment

    "Pricipal logging method. This mimics VM __stxLog__()"

    | severityXlated messageXlated |

    (self logOnStderr or:[self logOnTranscript]) ifFalse:[^ self].

    severityXlated := severity.

    "/ Be backward compatible, allow for symbolic severities

    "/ but when encountered, issue a warning...

    severity isSymbol ifTrue:[ 

        | nseverities i |

        i := 1.

        nseverities := Severities size.

        [ i <= nseverities ] whileTrue:[

            | s | 

            (s := Severities at: i) name = severity ifTrue:[ 

                | caller |    

                severityXlated := s.

                i := nseverities + 1. "/ exit the loop

                "/ 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.

            ].

            i := i + 1.

        ].

    ].

    "/ Now check whether the severity is one of the predefined ones,

    "/ if not, issue an error

    (Severities includesIdentical: severityXlated) ifFalse:[ 

        | caller |

        self log: ('no such severity (%1), use one from predefined severities. Original message will be logged as INFO' bindWith: severityXlated) severity: ERROR 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.

        severityXlated := INFO.

    ].

    severityXlated value < Threshold value ifTrue:[ ^ self ].

    messageXlated := message value asString.

    self logOnStderr ifTrue:[

        self log: messageXlated severity: severityXlated facility: facility originator: originator attachment: attachment on:Stderr.

    ].

    self logOnTranscript ifTrue:[

        (Transcript isView) ifTrue:[ 

            self log: messageXlated severity: severityXlated facility: facility originator: originator attachment: attachment on:Transcript

        ].

    ].

    "

     Logger log:'test message' severity: #debug facility: 'TEST'

    "

    "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>"

!

log: message severity: severity originator: originator

    self log: message severity: severity facility: (self facilityOf: originator) originator: originator

    "Created: / 15-09-2011 / 10:26:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-03-2013 / 11:20:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MiniLogger class methodsFor:'logging - utils'!

debug: message

    DEBUG value < Threshold value ifTrue:[ ^ self ].

    self log: message severity: DEBUG originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

debug: format with: arg1

    DEBUG value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1) severity: DEBUG originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

debug: format with: arg1 with: arg2

    DEBUG value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1 with: arg2) severity: DEBUG originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

debug: format with: arg1 with: arg2 with:arg3

    DEBUG value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1 with: arg2 with:arg3) severity: DEBUG originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enter: message

    ENTER value < Threshold value ifTrue:[ ^ self ].

    self log: message severity: ENTER originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enter: format with: arg1

    ENTER value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1) severity: ENTER originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enter: format with: arg1 with: arg2

    ENTER value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1 with: arg2) severity: ENTER originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enter: format with: arg1 with: arg2 with:arg3

    ENTER value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1 with: arg2 with:arg3) severity: ENTER originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

error: message

    ERROR value < Threshold value ifTrue:[ ^ self ].

    self log: message severity: ERROR originator: thisContext sender receiver

    "Modified: / 02-12-2014 / 10:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

error: format with: arg1

    ERROR value < Threshold value ifTrue:[ ^ self ].

    self log: (format bindWith: arg1) severity: ERROR originator: thisContext sender receiver