-
Notifications
You must be signed in to change notification settings - Fork 13
/
LoggerControl.vb
391 lines (362 loc) · 16.4 KB
/
LoggerControl.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
'Verification disabled because of many warnings in generated code
<ContractVerification(False)>
Public Class LoggerControl
Private callbackModeMap As New Dictionary(Of LogMessageType, CallbackMode)
Private callbackColorMap As New Dictionary(Of LogMessageType, Color)
Private WithEvents _logger As Logger
Private ReadOnly uiRef As CallQueue = MakeControlCallQueue(Me)
Private lastQueuedMessage As New QueuedMessage(Nothing, Color.Black)
Private nextQueuedMessage As QueuedMessage
Private numQueuedMessages As Integer
Protected lock As New Object()
Private _logFilename As String
Private filestream As IO.Stream
<ContractInvariantMethod()> Private Sub ObjectInvariant()
Contract.Invariant(callbackModeMap IsNot Nothing)
Contract.Invariant(callbackColorMap IsNot Nothing)
Contract.Invariant(uiRef IsNot Nothing)
Contract.Invariant(lastQueuedMessage IsNot Nothing)
Contract.Invariant(lastQueuedMessage.NextMessage Is Nothing)
Contract.Invariant((_logger Is Nothing) = (_logFilename Is Nothing))
Contract.Invariant((nextQueuedMessage IsNot Nothing) = (numQueuedMessages > 0))
End Sub
Private NotInheritable Class QueuedMessage
Private ReadOnly _message As String
Private ReadOnly _color As Color
Private ReadOnly _replacement As QueuedMessage
Private _nextMessage As QueuedMessage
Public Property InsertPosition As Integer
<ContractInvariantMethod()> Private Sub ObjectInvariant()
Contract.Invariant(_message IsNot Nothing)
End Sub
Public Sub New(message As String, color As Color, Optional replacement As QueuedMessage = Nothing)
Contract.Requires(message IsNot Nothing)
Contract.Ensures(Me.Message = message)
Contract.Ensures(Me.Color = color)
Contract.Ensures(Me.Replacement Is replacement)
Contract.Ensures(Me.NextMessage Is Nothing)
Me._message = message
Me._color = color
Me._replacement = replacement
End Sub
Public ReadOnly Property Message As String
Get
Contract.Ensures(Contract.Result(Of String)() IsNot Nothing)
Contract.Ensures(Contract.Result(Of String)() = _message)
Return _message
End Get
End Property
Public ReadOnly Property Color As Color
Get
Contract.Ensures(Contract.Result(Of Color)() = _color)
Return _color
End Get
End Property
Public ReadOnly Property Replacement As QueuedMessage
Get
Contract.Ensures(Contract.Result(Of QueuedMessage)() Is _replacement)
Return _replacement
End Get
End Property
Public Property NextMessage As QueuedMessage
Get
Contract.Ensures(Contract.Result(Of QueuedMessage)() Is _nextMessage)
Return _nextMessage
End Get
Set(value As QueuedMessage)
Contract.Requires(value IsNot Nothing)
Contract.Requires(NextMessage Is Nothing)
_nextMessage = value
End Set
End Property
End Class
Public Enum CallbackMode As Byte
Unspecified = 0
[On] = 1
File = 2
Off = 3
End Enum
Public Sub New()
InitializeComponent()
callbackModeMap(LogMessageType.Typical) = CallbackMode.On
callbackModeMap(LogMessageType.Problem) = CallbackMode.On
callbackModeMap(LogMessageType.Negative) = CallbackMode.On
callbackModeMap(LogMessageType.Positive) = CallbackMode.On
callbackModeMap(LogMessageType.DataEvent) = CallbackMode.Off
callbackModeMap(LogMessageType.DataParsed) = CallbackMode.Off
callbackModeMap(LogMessageType.DataRaw) = CallbackMode.Off
callbackColorMap(LogMessageType.Typical) = Color.Black
callbackColorMap(LogMessageType.DataEvent) = Color.DarkBlue
callbackColorMap(LogMessageType.DataParsed) = Color.DarkBlue
callbackColorMap(LogMessageType.DataRaw) = Color.DarkBlue
callbackColorMap(LogMessageType.Problem) = Color.Red
callbackColorMap(LogMessageType.Positive) = Color.DarkGreen
callbackColorMap(LogMessageType.Negative) = Color.DarkOrange
End Sub
#Region "State"
Public Sub SetLogger(logger As Logger,
name As InvariantString,
Optional dataEventsMode As CallbackMode = CallbackMode.Unspecified,
Optional parsedDataMode As CallbackMode = CallbackMode.Unspecified,
Optional rawDataMode As CallbackMode = CallbackMode.Unspecified)
SyncLock lock
If Me._logger IsNot Nothing Then
If filestream IsNot Nothing Then
filestream.Dispose()
filestream = Nothing
_logFilename = Nothing
tips.SetToolTip(chkSaveFile, "Determines if data is logged to a file.")
End If
End If
Me._logger = logger
If logger IsNot Nothing Then
_logFilename = "{0} {1}.txt".Frmt(name, DateTime.Now().ToString("MMM d, yyyy, HH-mm-ss", CultureInfo.InvariantCulture))
tips.SetToolTip(chkSaveFile, {"Outputs logged messages to a file.",
"Unchecking does not remove messages from the file.",
"Current Target File: '(Documents)\{0}\Logs\{1}'"
}.StringJoin(Environment.NewLine).Frmt(Application.ProductName, _logFilename))
End If
If dataEventsMode <> CallbackMode.Unspecified Then
callbackModeMap(LogMessageType.DataEvent) = dataEventsMode
SyncToCheckbox(chkDataEvents, LogMessageType.DataEvent)
End If
If parsedDataMode <> CallbackMode.Unspecified Then
callbackModeMap(LogMessageType.DataParsed) = parsedDataMode
SyncToCheckbox(chkParsedData, LogMessageType.DataParsed)
End If
If rawDataMode <> CallbackMode.Unspecified Then
callbackModeMap(LogMessageType.DataRaw) = rawDataMode
SyncToCheckbox(chkRawData, LogMessageType.DataRaw)
End If
End SyncLock
End Sub
Private Function OpenSaveFile() As Boolean
SyncLock lock
If filestream IsNot Nothing Then
filestream.Dispose()
filestream = Nothing
End If
Dim folder = GetDataFolderPath("Logs")
If folder Is Nothing Then
LogMessage("Error opening log folder.", Color.Red)
Return False
End If
Try
filestream = New IO.FileStream(IO.Path.Combine(folder, _logFilename), IO.FileMode.Append, IO.FileAccess.Write, IO.FileShare.Read)
Catch ex As Exception When TypeOf ex Is IO.IOException OrElse
TypeOf ex Is Security.SecurityException
Dim msg = "Error opening file for log {0}: {1}".Frmt(_logFilename, ex.Summarize)
ex.RaiseAsUnexpected(msg)
LogMessage(msg, Color.Red)
Return False
End Try
Dim bb = ("-------------------------" + Environment.NewLine).ToAsciiBytes.ToArray
filestream.Write(bb, 0, bb.Length)
Return True
End SyncLock
End Function
Public ReadOnly Property Logger() As Logger
Get
Return Me._logger
End Get
End Property
Public Sub LogMessage(message As Lazy(Of String),
color As Color,
Optional fileOnly As Boolean = False)
Contract.Requires(message IsNot Nothing)
LogMessage(message.Value, color, fileOnly)
End Sub
Public Sub LogMessage(message As String,
color As Color,
Optional fileOnly As Boolean = False)
Contract.Requires(message IsNot Nothing)
LogMessage(New QueuedMessage(message, color), fileOnly)
End Sub
Private Sub LogMessage(message As QueuedMessage,
Optional fileOnly As Boolean = False)
Contract.Requires(message IsNot Nothing)
SyncLock lock
If Not fileOnly Then
lastQueuedMessage.NextMessage = message
lastQueuedMessage = message
nextQueuedMessage = If(nextQueuedMessage, message)
numQueuedMessages += 1
End If
If filestream IsNot Nothing Then
Dim data = "[{0}]: {1}{2}".Frmt(DateTime.Now().ToString("dd/MM/yy HH:mm:ss.ffff", CultureInfo.InvariantCulture),
message.Message,
Environment.NewLine).ToAsciiBytes.ToArray
filestream.Write(data, 0, data.Length)
End If
End SyncLock
If Not fileOnly Then
uiRef.QueueAction(AddressOf EmptyQueue)
End If
End Sub
Private Sub EmptyQueue()
Try
If txtLog.SelectionStart <> txtLog.TextLength Then
SyncLock lock
btnUnbuffer.Text = "Unbuffer ({0})".Frmt(numQueuedMessages)
btnUnbuffer.Visible = True
lblBuffering.Visible = True
End SyncLock
Return
End If
'Buffer currently queued messages
Dim bq As New Queue(Of QueuedMessage)
SyncLock lock
If nextQueuedMessage Is Nothing Then Return
Do
bq.Enqueue(nextQueuedMessage)
nextQueuedMessage = nextQueuedMessage.NextMessage
numQueuedMessages -= 1
Loop While nextQueuedMessage IsNot Nothing
End SyncLock
'Log buffered messages
While bq.Count > 0
'Get message
Dim n = txtLog.Text.Length
Dim em = bq.Dequeue()
Dim msg = em.Message + Environment.NewLine
em.InsertPosition = n
'Combine messages if possible [operations on txtLog are very expensive because they cause redraws, this minimizes that]
If em.Replacement Is Nothing Then
While bq.Count > 0 AndAlso bq.Peek().Color = em.Color AndAlso bq.Peek.Replacement Is Nothing
n += em.Message.Length + Environment.NewLine.Length
em.InsertPosition = n
em = bq.Dequeue()
msg += em.Message + Environment.NewLine
End While
End If
'Log message
If em.Replacement IsNot Nothing Then
Dim dn = em.Message.Length - em.Replacement.Message.Length
Dim f = em.Replacement.NextMessage
While f IsNot Nothing
f.InsertPosition += dn
f = f.NextMessage
End While
em.InsertPosition = em.Replacement.InsertPosition
txtLog.Select(em.Replacement.InsertPosition, em.Replacement.Message.Length)
txtLog.SelectionColor = em.Color
txtLog.SelectedText = em.Message
Else
Dim prevLength = txtLog.TextLength
txtLog.AppendText(msg)
txtLog.Select(prevLength, txtLog.TextLength - prevLength)
txtLog.SelectionColor() = em.Color
End If
End While
txtLog.Select(txtLog.TextLength, 0)
Catch e As InvalidOperationException
e.RaiseAsUnexpected("Exception rose post LoggerControl.emptyQueue")
End Try
End Sub
Private Async Sub LogFutureMessage(type As LogMessageType, placeholder As Func(Of String), futureMessage As Task(Of Func(Of String)))
Contract.Requires(placeholder IsNot Nothing)
Contract.Requires(futureMessage IsNot Nothing)
Dim fileOnly As Boolean
SyncLock lock
If callbackModeMap(type) = CallbackMode.Off Then Return
fileOnly = callbackModeMap(type) = CallbackMode.File
End SyncLock
Dim m = New QueuedMessage(placeholder(), Color.DarkGoldenrod)
LogMessage(m, fileOnly)
Try
Dim f = Await futureMessage
Dim message = f()
Dim color = callbackColorMap(type)
If message.StartsWith("Failed:") Then color = callbackColorMap(LogMessageType.Problem)
LogMessage(New QueuedMessage(message, color, m), fileOnly)
Catch ex As Exception
SyncLock lock
LogMessage(New QueuedMessage(ex.Summarize, callbackColorMap(LogMessageType.Problem), m))
End SyncLock
End Try
End Sub
#End Region
#Region "Log Events"
Private Sub OnLoggedMessage(type As LogMessageType,
message As Lazy(Of String)) Handles _logger.LoggedMessage
Dim fileOnly As Boolean
SyncLock lock
If callbackModeMap(type) = CallbackMode.Off Then Return
fileOnly = callbackModeMap(type) = CallbackMode.File
End SyncLock
Dim color = callbackColorMap(type)
LogMessage(message, color, fileOnly)
End Sub
Private Sub OnLoggedFutureMessage(type As LogMessageType,
placeholder As Func(Of String),
out As Task(Of Func(Of String))) Handles _logger.LoggedFutureMessage
uiRef.QueueAction(Sub() LogFutureMessage(type, placeholder, out))
End Sub
#End Region
#Region "UI Events"
Private Sub OnCheckedChangedDataEvents() Handles chkDataEvents.CheckStateChanged
SyncFromCheckbox(chkDataEvents, LogMessageType.DataEvent)
End Sub
Private Sub OnCheckChangedParsedData() Handles chkParsedData.CheckStateChanged
SyncFromCheckbox(chkParsedData, LogMessageType.DataParsed)
End Sub
Private Sub OnCheckChangedRawData() Handles chkRawData.CheckStateChanged
SyncFromCheckbox(chkRawData, LogMessageType.DataRaw)
End Sub
Private Sub SyncFromCheckbox(c As CheckBox, e As LogMessageType)
SyncLock lock
Select Case c.CheckState
Case CheckState.Checked : callbackModeMap(e) = CallbackMode.On
Case CheckState.Indeterminate : callbackModeMap(e) = CallbackMode.File
Case CheckState.Unchecked : callbackModeMap(e) = CallbackMode.Off
End Select
End SyncLock
End Sub
Private Sub SyncToCheckbox(c As CheckBox, e As LogMessageType)
SyncLock lock
Select Case callbackModeMap(e)
Case CallbackMode.On : c.CheckState = CheckState.Checked
Case CallbackMode.File : c.CheckState = CheckState.Indeterminate
Case CallbackMode.Off : c.CheckState = CheckState.Unchecked
End Select
End SyncLock
End Sub
Private Sub OnCheckChangedSaveFile() Handles chkSaveFile.CheckStateChanged
SyncLock lock
If chkSaveFile.Checked Then
If Not OpenSaveFile() Then
chkSaveFile.Checked = False
Return
End If
Else
SyncLock lock
If filestream IsNot Nothing Then
filestream.Dispose()
filestream = Nothing
End If
End SyncLock
End If
End SyncLock
End Sub
Private Sub OnClickClear() Handles btnClear.Click
txtLog.Clear()
End Sub
Private Sub OnDisposed() Handles Me.Disposed
SetLogger(Nothing, Nothing)
End Sub
Private Sub OnSelectionChangedLog() Handles txtLog.SelectionChanged
If txtLog.SelectionStart = txtLog.TextLength AndAlso lblBuffering.Visible Then
lblBuffering.Visible = False
btnUnbuffer.Visible = False
SyncLock lock
If numQueuedMessages > 0 Then
uiRef.QueueAction(AddressOf EmptyQueue)
End If
End SyncLock
End If
End Sub
Private Sub btnUnbuffer_Click(sender As System.Object, e As System.EventArgs) Handles btnUnbuffer.Click
txtLog.Select(txtLog.TextLength, 0)
End Sub
#End Region
End Class