VbaLogger.xlam added

src/VbaLogger.xlam/ConsoleLogger.cls

@@ -0,0 +1,61 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ConsoleLogger"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' Class ConsoleLogger
+Implements Logger
+Implements LoggerPrototype
+' We are required to implement both interfaces, even if LoggerPrototype also implements Logger.
+
+' This logger appends to the 'immediate window' in the Excel VBA IDE.
+
+
+Private name As String ' The name of this logger
+
+
+Private Function Logger_whereIsMyLog() As String
+    Logger_whereIsMyLog = "Log output is printed to the immediate window."
+End Function
+
+
+Private Sub Logger_info(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.info, message, msg2, msg3
+End Sub
+
+
+Private Sub Logger_warn(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.warn, message, msg2, msg3
+End Sub
+
+
+Private Sub Logger_fatal(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.fatal, message, msg2, msg3
+End Sub
+
+
+Public Sub LoggerPrototype_setName(loggerName As String)
+    name = loggerName
+End Sub
+
+
+Private Function LoggerPrototype_clone() As LoggerPrototype
+    Dim clone As ConsoleLogger
+    Set clone = New ConsoleLogger
+    ' the clone's name will be overwritten, so no need to: clone.LoggerPrototype_setName name
+    Set LoggerPrototype_clone = clone
+End Function
+
+
+' The actual implementation of the 'info' , 'warn' and 'fatal' subs.
+Private Sub logMessage(status As String, message As String, Optional msg2 As String, Optional msg3 As String)
+    Dim formatted As String
+    formatted = LogFactory.formatLogMessage(status & "|" & name, message, msg2, msg3)
+    Debug.Print formatted
+End Sub

src/VbaLogger.xlam/FileLogger.cls

@@ -0,0 +1,81 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "FileLogger"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' Class FileLogger
+Implements Logger
+Implements LoggerPrototype
+' We are required to implement both interfaces, even if LoggerPrototype also implements Logger.
+
+
+' This logger appends to a file in the given directory
+
+Private name As String ' The name of this logger
+Private logDir As String 'The full absolute path to the directory for the logfile.
+
+
+' Returns the full absolute path to the logfile.
+Private Function logFilePath() As String
+    logFilePath = logDir & name & ".log"
+End Function
+
+
+Private Function Logger_whereIsMyLog() As String
+    Logger_whereIsMyLog = logFilePath()
+End Function
+
+
+Private Sub Logger_info(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.info, message, msg2, msg3
+End Sub
+
+
+Private Sub Logger_warn(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.warn, message, msg2, msg3
+End Sub
+
+
+Private Sub Logger_fatal(message As String, Optional msg2 As String, Optional msg3 As String)
+    logMessage LogFactory.fatal, message, msg2, msg3
+End Sub
+
+
+Public Sub LoggerPrototype_setName(loggerName As String)
+    name = loggerName
+End Sub
+
+
+Private Function LoggerPrototype_clone() As LoggerPrototype
+    Dim clone As FileLogger
+    Set clone = New FileLogger
+    clone.setLogDir logDir
+    ' the clone's name will be overwritten, so no need to: clone.LoggerPrototype_setName name
+    Set LoggerPrototype_clone = clone
+End Function
+
+
+' The actual implementation of the 'info' , 'warn' and 'fatal' subs.
+Private Sub logMessage(status As String, message As String, Optional msg2 As String, Optional msg3 As String)
+    Dim formatted As String
+    formatted = LogFactory.formatLogMessage(status, message, msg2, msg3)
+    Debug.Print formatted
+
+    Dim fso As FileSystemObject, ts As TextStream
+    Set fso = New FileSystemObject
+    Set ts = fso.OpenTextFile(logFilePath(), ForAppending, Create:=True)
+    ts.WriteLine formatted
+    ts.Close
+End Sub
+
+
+' The fullDirPath is expected to end with a '\' character.
+Public Sub setLogDir(fullDirPath As String)
+    logDir = fullDirPath
+End Sub

src/VbaLogger.xlam/LogFactory.bas

@@ -0,0 +1,127 @@
+Attribute VB_Name = "LogFactory"
+Option Explicit
+
+' Requires reference to Microsoft Scripting Runtime.
+' The LogFactory holds common configuration for all loggers and
+' creates and manages instances of loggers.
+
+
+
+Public Const info As String = "INFO"
+Public Const warn As String = "WARN"
+Public Const fatal As String = "FATAL"
+
+Private loggerMap As Dictionary ' maps loggerName to instance
+Private thePrototype As LoggerPrototype ' the prototype from which to create new logger instances
+
+
+' Common log configuration for all loggers
+Private Const dateFormat As String = "YYMMDD hh:mm.ss"
+Private Const SEP As String = "|" ' the separator between different parts on the line
+Private Const logDirPath As String = "C:\Temp\"
+
+' usage:
+'
+'Property Get log() As Logger
+'    Set log = LogFactory.getLogger(ThisWorkbook.name)
+'End Property
+
+
+' The logger that is returned will depend on the configuration and prototype above.
+Public Function getLogger(loggerName As String) As Logger
+    If loggers.Exists(loggerName) Then
+        Set getLogger = loggers.Item(loggerName)
+        Exit Function
+    End If
+    Dim loggerInstance As LoggerPrototype
+    Set loggerInstance = prototype.clone()
+    loggerInstance.setName loggerName
+    loggers.Add Key:=loggerName, Item:=loggerInstance
+    Set getLogger = loggerInstance
+End Function
+
+
+' Configure the prototype to use for producing all logger instances.
+' Expects a fully configured logger instance.
+Public Sub configurePrototype(instance As LoggerPrototype)
+    Set loggers = New Dictionary
+    Set prototype = instance
+End Sub
+
+
+' Creates a new Logger instance that appends to immediate window.
+Public Function getConsoleLogger(loggerName As String) As Logger
+    Dim loggerInstance As ConsoleLogger
+    Set loggerInstance = New ConsoleLogger
+    loggerInstance.LoggerPrototype_setName loggerName
+    Set getConsoleLogger = loggerInstance
+End Function
+
+
+' Creates a new Logger instance that appends to the file at the given full absolute path.
+Public Function getFileLogger(loggerName As String) As Logger
+    Dim fileLoggerInstance As FileLogger
+    Set fileLoggerInstance = New FileLogger
+    fileLoggerInstance.setLogDir logDirPath
+    fileLoggerInstance.LoggerPrototype_setName loggerName
+    Set getFileLogger = fileLoggerInstance
+End Function
+
+
+' Returns the loggerMap and initializes it if necessary.
+Private Property Get loggers() As Dictionary
+    If loggerMap Is Nothing Then
+        Set loggerMap = New Dictionary
+    End If
+    Set loggers = loggerMap
+End Property
+
+
+' Returns the prototype and initializes it with a default logger if necessary.
+Private Property Get prototype() As LoggerPrototype
+    If thePrototype Is Nothing Then
+        Set thePrototype = getConsoleLogger(ThisWorkbook.name)
+    End If
+    Set prototype = thePrototype
+End Property
+
+
+' Formats the given message parts into one string with date and status in front, all separated by the SEP character.
+Function formatLogMessage(status As String, message As String, Optional msg2 As String, Optional msg3 As String)
+    Dim formatted As String
+    formatted = Format(Now(), dateFormat) & SEP & status & SEP & message
+    If Not msg2 = "" Then
+        formatted = formatted & SEP & msg2
+    End If
+    If Not msg3 = "" Then
+        formatted = formatted & SEP & msg3
+    End If
+    formatLogMessage = formatted
+End Function
+
+
+' Release all logger instances.
+Public Sub clear()
+    Set loggers = Nothing
+    Set prototype = Nothing
+End Sub
+
+
+Sub testFileLogger()
+    clear
+
+    Dim thePrototype As Logger
+    Set thePrototype = getFileLogger(ThisWorkbook.name)
+    configurePrototype thePrototype
+
+    Dim log As Logger
+    Set log = getLogger(ThisWorkbook.name)
+
+    Debug.Print "logging to " & log.whereIsMyLog()
+
+    log.info "hello it works"
+    log.warn "hello it works2"
+    log.fatal " a fatal message"
+End Sub
+
+

src/VbaLogger.xlam/Logger.cls

@@ -0,0 +1,31 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "Logger"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Option Explicit
+
+' Interface Class Logger
+
+' Returns (a description of) the location where the log messages are written to.
+Public Function whereIsMyLog() As String
+End Function
+
+
+' Log the given messages at INFO level
+Public Sub info(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub
+
+
+' Log the given messages at WARN level
+Public Sub warn(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub
+
+
+' Log the given messages at FATAL level
+Public Sub fatal(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub

src/VbaLogger.xlam/LoggerPrototype.cls

@@ -0,0 +1,37 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "LoggerPrototype"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' Interface Class LoggerPrototype
+Implements Logger
+
+
+' Returns a new instance of this class with exact same configuration as this object.
+Public Function clone() As LoggerPrototype
+End Function
+
+
+' Depending on the implementation, the given loggerName could be used to determine location where the log messages are written to
+' or can be used inside the messages.
+Public Sub setName(loggerName As String)
+End Sub
+
+
+Private Sub Logger_fatal(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub
+
+Private Sub Logger_info(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub
+
+Private Sub Logger_warn(message As String, Optional msg2 As String, Optional msg3 As String)
+End Sub
+
+Private Function Logger_whereIsMyLog() As String
+End Function