path: root/LogManager.st

"
 (C) 2010-2011 by Holger Hans Peter Freyther
 All Rights Reserved

 This program is free software: you can redistribute it and/or modify
 it under the terms of the GNU Affero General Public License as
 published by the Free Software Foundation, either version 3 of the
 License, or (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU Affero General Public License for more details.

 You should have received a copy of the GNU Affero General Public License
 along with this program.  If not, see <http://www.gnu.org/licenses/>.
"

Object extend [
    logManager [
        <category: '*OsmoLogging-Core'>
        ^ Osmo.LogManager default
    ]

    logDataContext: aData area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            context: 'data' value: aData.
    ]

    logDebug: aMessage area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            log: (LogEntry withMsg: aMessage level: LogLevel debug area: anArea context: self)
    ]

    logInfo: aMessage area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            log: (LogEntry withMsg: aMessage level: LogLevel info area: anArea context: self)
    ]

    logNotice: aMessage area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            log: (LogEntry withMsg: aMessage level: LogLevel notice area: anArea context: self)
    ]

    logError: aMessage area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            log: (LogEntry withMsg: aMessage level: LogLevel error area: anArea context: self)
    ]

    logException: aMessage area: anArea [
        <category: '*OsmoLogging-Core'>
        (self logManager)
            exception: (LogEntry withMsg: aMessage
                            level: LogLevel error
                            area: anArea context: thisContext parentContext)
    ]
]

Object subclass: LogEntry [
    | level ctx area msg |

    <category: 'OsmoLogging-Core'>
    <comment: 'I represent a log entry and hold the text, level, area'>

    LogEntry class >> withMsg: aMsg level: anLevel area: anArea context: aContext [
        ^ self new
            msg: aMsg;
            level: anLevel;
            area: anArea;
            context: aContext;
            yourself.
    ]

    msg [
        ^ msg
    ]

    msg: aMsg [
        msg := aMsg.
    ]

    level [
        ^ level
    ]

    level: anLevel [
        level := anLevel
    ]

    area [
        ^ area
    ]

    area: anArea [
        area := anArea.
    ]

    context [
        ^ ctx
    ]

    context: aContext [
        ctx := aContext.
    ]
]

Object subclass: LogLevel [
    <category: 'OsmoLogging-Core'>
    <comment: 'I represent the available levels for log messages'>

    LogLevel class >> debug [
        ^ 1
    ]

    LogLevel class >> info [
        ^ 3
    ]

    LogLevel class >> notice [
        ^ 5
    ]

    LogLevel class >> error [
        ^ 7
    ]
]

Object subclass: LogArea [
    | name enabled level |
    <category: 'OsmoLogging-Core'>
    <comment: 'I represent a LogArea'>

    LogArea class >> defaultForArea: aSymbol [
        "Find an Area and place the default into our dictionary"
        LogArea allSubclassesDo: [ :each |
            (each areaName) = aSymbol
                ifTrue: [
                    ^ each default.
                ].
        ].

        ^ nil
    ]

    LogArea class >> default [
        <category: 'accessing'>
        ^ self subclassResponsibility
    ]

    LogArea class >> areaName [
        <category: 'accessing'>
        ^ self subclassResponsibility
    ]

    LogArea class >> areaDescription [
        <category: 'accessing'>
        ^ self subclassResponsibility
    ]

    LogArea class >> availableAreas [
        <category: 'accessing'>
        ^ self allSubclasses collect: [ :each |
            Array with: each areaName with: each areaDescription
        ].
    ]

    enabled [
        <category: 'accessing'>
        ^ enabled
    ]

    enabled: anEnabled [
        <category: 'accessing'>
        enabled := anEnabled.
    ]

    minLevel [
        <category: 'accessing'>
        ^ level
    ]

    minLevel: aLevel [
        <category: 'accessing'>
        level := aLevel
    ]
]

Object subclass: LogTarget [
    <category: 'OsmoLogging-Target'>
    <comment: 'I will filter and then output the log message'>


    print: anEntry [
        <category: 'log'>
        self subclassResponsibility.
    ]

    exception: anEntry [
        <category: 'log'>
        self subclassResponsibility.
    ]
]

LogTarget subclass: LogTranscriptTarget [
    <category: 'OsmoLogging-Target'>
    <comment: 'I log to the Transcript buffer'>

    print: anEntry [
        <category: 'log'>
        Transcript show: anEntry msg; nl.
    ]

    exception: anEntry [
        <category: 'log'>
        Transcript show: anEntry msg; nl.
        anEntry context backtraceOn: Transcript.
    ]
]

Object subclass: LogFilter [
    <category: 'OsmoLogging-Core'>
    <comment: 'I filter based on mood, context and Bangkok Law'>

    filter: anEntry [
        <category: 'filter'>
        "I have to decide if anEntry can pass or should be filtered out, I can
        access the logManager of anEntry to access the per process context"
        ^ self subclassResponsibility
    ]
]

Object subclass: LogManager [
    | target filter areas |
    <category: 'OsmoLogging-Core'>
    <comment: 'I handle the actual log invocation'>

    Log := nil.

    LogManager class >> default [
        <category: 'instance'>
        Log ifNil: [
            Log := LogManager new.
            Log target: LogTranscriptTarget new.
        ].

       ^ Log
    ]

    target: aTarget [
        <category: 'private'>
        target := aTarget.
    ]

    areas [
        <category: 'accessing'>
        areas ifNil: [
            areas := Dictionary new.
        ].

        ^ areas 
    ]

    findArea: anArea [
        <category: 'private'>
        "Find anArea, or ask for a default"
        ^ (self areas) at: anArea ifAbsent: [
            | area |
            area := LogArea defaultForArea: anArea.
            area ifNotNil: [
                (self areas) at: anArea put: area.
            ].

            area.
        ].
    ]

    handle: anEntry ifTrue: aBlock [
        <category: 'private'>

        | area |
        area := self findArea: anEntry area.

        (area enabled and: [anEntry level >= area minLevel]) ifTrue: aBlock 
    ]

    log: anEntry [
        <category: 'log'>
        self handle: anEntry ifTrue: [
            target print: anEntry
        ]
    ]

    exception: anEntry [
        <category: 'log'>
        self handle: anEntry ifTrue: [
            target exception: anEntry.
        ]
    ]

    context: aString value: aValue [
        | key |
        key := Array with: 'LogArea' with: aString.
        (ProcessVariable key: key) value: aValue.
    ]

    contextValue: aString [
        | key |
        key := Array with: 'LogArea' with: aString.
        ^ (ProcessVariable key: key) value.
    ]
]