 | 
 | |
| Subject | Class to add (Agent) logging |
| Created | 06/23/2007 02:15 PM by Jan Schulz. |
| Modified | <none> by <none>. |
Here is a first try to add a logger. I use it to collect information from agent runs without cluttering the normal OpenLog view. Only one entry is added per agent (or more, in case the output is really long, could probably benefit from http://www.openntf.org/Projects/codebin/codebin.nsf/CodeByDate/84F37FE2DB46E185862572FD006D5428).
I will probably add something, so that one log is used also ove serveral runs of an agent (using some idea I got from !!!HELP!!!).
This class "reuses" some code form openlog: it would be nice to get a function into the logintems, to get the underlying doc. Currently no changes to the openLog Libs are nessesary. I used the 1.0 Version...
It works for me, but the only tests are the ones in the TestLogger function...
Enjoy!
Jan
Option Public
Option Declare
Use "OpenLogFunctions"
Const PREFIX_LOGITEMNAME= "Agent Log: "
Const LOG_SEVERITY = SEVERITY_LOW
Const TYPE_LOG= "Message-Log"
Const ERROR_COULD_NOT_WRITE_TO_LOG = 4001
'** common severity types
'Const SEVERITY_LOW = "0"
'Const SEVERITY_MEDIUM = "1"
'Const SEVERITY_HIGH = "2"
'** common event types
'Const TYPE_ERROR = "Error"
'Const TYPE_EVENT = "Event"
Public Class Logger
Private m_LogDocument As NotesDocument
Private StartTime As NotesDateTime
Private EndTime As NotesDateTime
' knows whether we have flushed the last message
Private m_needsflush As Boolean
'config of this log
Private LogName As String
Private LogLevel As Integer
Private bLogMethod As Boolean
Private bLogTime As Boolean
Private bFlushAlways As Boolean
Private currentMethodName As String
Public Sub new(NewLogName As String)
LogName =NewLogName
'Setting Defaults
Me.bLogMethod = True
Me.bLogTime = True
'flush always could be a performance hog on slow networks...
Me.bFlushAlways = False
End Sub
Sub Delete
' If we have an startTime but no EndTime, something happend as the Log was not closed properly
If (Not (StartTime Is Nothing)) And (EndTime Is Nothing) Then
' Time should be usefull, but method isn't (it's "DELETE")...
Me.bLogTime = True
Dim tmpLogMethod As Boolean
tmpLogMethod = Me.bLogMethod
Me.bLogMethod = False
Call Me.LogError("Abnormal end of log: Log was not closed!", Nothing)
bLogMethod = tmpLogMethod
End If
'Save in any case
Call Me.flush()
End Sub
Public Sub SetLogLevel (NewLevel As Integer)
If NewLevel > SEVERITY_HIGH Then
Me.LogLevel = SEVERITY_HIGH
Elseif NewLevel < SEVERITY_LOW Then
Me.LogLevel = SEVERITY_LOW
Else
Me.LogLevel = NewLevel
End If
End Sub
Public Sub setLogMethod(NewLogMethod As Boolean)
bLogMethod = NewLogMethod
End Sub
Public Sub setLogTime(NewLogTime As Boolean)
bLogTime = NewLogTime
End Sub
Public Sub setFlushAlways(NewFlushAlways As Boolean)
bFlushAlways = NewFlushAlways
End Sub
Public Function start(message As String) As String
' first start the time -> logAction uses it
Set Me.StartTime = New NotesDateTime (Now ())
Set Me.EndTime = Nothing
' Code Duplication with OpenLog::LogEvent
Dim LogItem As LogItem
Set LogItem = CreateLogItem( PREFIX_LOGITEMNAME & LogName, LOG_SEVERITY, Nothing)
If LogItem Is Nothing Then
Error ERROR_COULD_NOT_WRITE_TO_LOG , "Could not create LogItem to log to"
End If
Dim session As New NotesSession
Dim strAccessLevel As String
Select Case session.CurrentDatabase.CurrentAccessLevel
Case 0 : strAccessLevel = "0: No Access"
Case 1 : strAccessLevel = "1: Depositor"
Case 2 : strAccessLevel = "2: Reader"
Case 3 : strAccessLevel = "3: Author"
Case 4 : strAccessLevel = "4: Editor"
Case 5 : strAccessLevel = "5: Designer"
Case 6 : strAccessLevel = "6: Manager"
End Select
With LogItem
.eventTime = Now
.eventType = TYPE_LOG
.userName = session.UserName
.effName = session.EffectiveUserName
.accessLevel = strAccessLevel
.userRoles = Evaluate("@UserRoles")
.clientVersion = StringToArray(Trim(session.NotesVersion) & "|Build " & session.NotesBuildVersion, "|")
End With
' Code Duplication with 'OpenLog::LogItem.writeToLog'
On Error Goto processError
Dim logDoc As NotesDocument
Set logDoc = LogItem.CreateLogDoc(GetLogDatabase)
If (logDoc Is Nothing) Then
Error ERROR_COULD_NOT_WRITE_TO_LOG , "Could not create Log Document to log to"
End If
'** make sure Depositor level users can still write/save their docs
logDoc.~$PublicAccess = "1"
Set m_LogDocument = logDoc
Call Me.logAction(message, SEVERITY_MEDIUM, Nothing )
Call Me.askForFlush()
' return the String, so i could be printed/messageboxed
start = message
Exit Function
processError:
' hm... Bad! and we can't handle it with OpenLog :-(, so pass it on.
Dim db As NotesDatabase
Set db = getLogDatabase()
Dim dbname As String
If db Is Nothing Then
dbName = "No Database specified!"
Else
dbName = db.FileName
End If
Error ERROR_COULD_NOT_WRITE_TO_LOG , "Cold not Write to Log-Database (" & dbName & "). [OLD ERROR: " & Error$ & "]"
End Function
Public Function logDebug(msg As String, doc As NotesDocument) As String
currentMethodName = Lsi_info(12)
logDebug = Me.logAction(msg, SEVERITY_LOW, doc)
End Function
Public Function logError(msg As String, doc As NotesDocument) As String
currentMethodName = Lsi_info(12)
logError = Me.logAction(msg, SEVERITY_HIGH, doc)
End Function
Public Function logMessage(msg As String, doc As NotesDocument) As String
currentMethodName = Lsi_info(12)
logMessage = Me.logAction(msg, SEVERITY_MEDIUM, doc)
End Function
Public Function flush() As Boolean
If m_LogDocument .Save(True, False) Then
m_needsFlush = False
End If
flush = Not m_NeedsFlush
End Function
Public Function stop(Message As String) As String
Set Me.EndTime = New NotesDateTime (Now ())
Call Me.logAction(message, SEVERITY_MEDIUM, Nothing )
Call Me.LogAction ("Total running time: " & Cstr (EndTime.TimeDifference (StartTime)) & " seconds", SEVERITY_MEDIUM, Nothing )
Call Me.flush()
End Function
Private Function logAction(msg As String, severity As String, doc As NotesDocument) As String
' Log must be 'Started', otherweise there is no document to log to.
If m_LogDocument Is Nothing Then
Call Me.start("Log started automatically")
End If
' only log if we must
If severity < Me.LogLevel Then
Exit Function
End If
' Add the Message to the RT Field
Dim rtitem As NotesRichTextItem
Set rtItem = Me.getLoggingItem()
' I had problems with higher Sizes: Adding one entry took longer and longer
' 31000 -> each one doc: 2k Logmessages -> 6s, 10k -> 100s, 30000 -> 10k: 23 doc, but 1/10 of the time
If rtItem.ValueLength + Len(msg) + 200 > 30000 Then
Call switchToNewLogDoc()
Set rtItem = Me.getLoggingItem()
End If
Call rtitem.appendText(getPrefix() & msg)
If Not doc Is Nothing Then
Call rtitem.appendText(" Associated document: notes://" & Cstr(doc.ParentDatabase.Server) & "/" & Cstr(doc.ParentDatabase.ReplicaID) & "/0/" & doc.UniversalID )
' Problems when using a DB without default view
'Call rtitem.AppendDocLink(doc, doc.UniversalID)
'Call rtitem.appendText(")")
End If
rtitem.AddNewline(1)
Call Me.askForFlush()
End Function
Private Function getPrefix() As String
' returns a prefix string including a final space, if needed
getPrefix = ""
If bLogTime Then
getPrefix = getPrefix & Format$(Now, "YYYY/MM/DD HH:NN:SS")
End If
If bLogMethod Then
getPrefix = getPrefix & " (" & currentMethodName &")"
End If
If getPrefix <> "" Then
getPrefix = getPrefix & ": "
End If
End Function
Private Function getLoggingItem() As NotesRichTextItem
Dim rtField As NotesRichTextItem
Set rtField = m_LogDocument.GetFirstItem("LogDocInfo")
If rtField Is Nothing Then
Set rtfield = New NotesRichTextItem(m_LogDocument, "LogDocInfo")
End If
Set getLoggingItem= rtField
End Function
Private Sub askForFlush()
If bFlushAlways Then
Call Me.flush()
Else
m_needsFlush = True
End If
End Sub
'to get a handle to the doc for testing purpose
Function getLogDoc() As NotesDocument
Set getLogDoc = m_LogDocument
End Function
Private Function switchToNewLogDoc()
On Error Goto handleError
Dim docOld As NotesDocument
Dim docNew As NotesDocument
Set docOld = m_LogDocument
Set docNew = docOld.CopyToDatabase(docOld.ParentDatabase)
Call docNew.RemoveItem("LogDocInfo")
Call docNew.Save(True, False)
' calling LogAction gets a endless loop, so do it by hand
Dim rtItem As NotesRichTextItem
Set rtItem = docOld.GetFirstItem("LogDocInfo")
Call rtitem.appendText(getPrefix() & "Logging document full: opened new logging document:" )
Call rtitem.appendText(" Associated document: notes://" & Cstr(docNew.ParentDatabase.Server) & "/" & Cstr(docNew.ParentDatabase.ReplicaID) & "/0/" & docNew.UniversalID )
' Problems when using a DB without default view
'Call rtitem.AppendDocLink(doc, doc.UniversalID)
'Call rtitem.appendText(")")
rtitem.AddNewline(1)
Call Me.flush()
Set m_LogDocument = docNew
' No problem here with calling logAction
Call Me.logAction("Continued logging from old logging document: ", SEVERITY_HIGH, docOld)
Delete docOld
Call Me.flush()
Exit Function
handleError:
Error ERROR_COULD_NOT_WRITE_TO_LOG , "Cold not Write to Log-Database."
End Function
End Class
Sub Initialize
End Sub
Public Sub TestLogger()
Dim l As New Logger("TestLogger")
Call l.start("Starting Test")
Dim doc As NotesDocument
Set doc = l.getLogDoc()
Call l.logError("A Line with a doclink", doc)
Call l.setLogLevel(SEVERITY_LOW)
Call l.logDebug("This should be in the Log", Nothing)
Call l.setLogLevel(SEVERITY_MEDIUM)
Call l.logDebug("ERROR: This should NOT be in the Log", Nothing)
Call l.logMessage("A normal Message", Nothing)
Call l.setLogMethod(False)
Call l.logMessage("A normal Message without Method Name", Nothing)
Call l.setLogTime(False)
Call l.logMessage("A normal Message without Anything", Nothing)
Call l.setLogMethod(True)
Call l.logMessage("A normal Message without Time but with Methodname", Nothing)
Delete l
Dim m As Integer
Set l = New Logger("Long Running Test")
Call l.setFlushAlways(True)
Call l.start("start Long Running Test")
m = 0
While m <10000
Call l.logMessage("A normal Message " & Cstr(m), Nothing)
m = m+1
Wend
Call l.stop("finished")
Delete l
Set l = New Logger("Performance commit Always")
Call l.setFlushAlways(True)
Call l.start("start Performance with always commit")
m = 0
While m <2000
Call l.logMessage("A normal Message " & Cstr(m), Nothing)
m = m+1
Wend
Call l.stop("finished")
Delete l
Set l = New Logger("Performance commit ONCE")
Call l.setFlushAlways(True)
Call l.start("start Performance with commit ONCE")
m = 0
While m <2000
Call l.logMessage("A normal Message " & Cstr(m), Nothing)
m = m+1
Wend
Call l.stop("finished")
Delete l
Set l = New Logger("Without start and delete")
Call l.logMessage("A normal Message", Nothing)
End Sub
|