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
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Timer" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === Full documentation is available on https://help.libreoffice.org/ ===
REM =======================================================================================================================
Option Compatible
Option ClassModule
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Timer
''' ========
''' Class for management of scripts execution performance
''' A Timer measures durations. It can be suspended, resumed, restarted
''' Duration properties are expressed in seconds with a precision of 3 decimal digits
'''
''' Service invocation example:
''' Dim myTimer As Variant
''' myTimer = CreateScriptService("Timer")
''' myTimer = CreateScriptService("Timer", True) ' => To start timer immediately
'''
''' Detailed user documentation:
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_timer.html?DbPAR=BASIC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
REM ============================================================= PRIVATE MEMBERS
Private [Me] As Object
Private [_Parent] As Object
Private ObjectType As String ' Must be "TIMER"
Private ServiceName As String
Private _TimerStatus As Integer ' inactive, started, suspended or stopped
Private _StartTime As Double ' Moment when timer started, restarted
Private _EndTime As Double ' Moment when timer stopped
Private _SuspendTime As Double ' Moment when timer suspended
Private _SuspendDuration As Double ' Duration of suspended status as a difference of times
REM ============================================================ MODULE CONSTANTS
Private Const STATUSINACTIVE = 0
Private Const STATUSSTARTED = 1
Private Const STATUSSUSPENDED = 2
Private Const STATUSSTOPPED = 3
Private Const DSECOND As Double = 1 / (24 * 60 * 60) ' Duration of 1 second as compared to 1.0 = 1 day
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
Set [Me] = Nothing
Set [_Parent] = Nothing
ObjectType = "TIMER"
ServiceName = "ScriptForge.Timer"
_TimerStatus = STATUSINACTIVE
_StartTime = 0
_EndTime = 0
_SuspendTime = 0
_SuspendDuration = 0
End Sub ' ScriptForge.SF_Timer Constructor
REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
Call Class_Initialize()
End Sub ' ScriptForge.SF_Timer Destructor
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
Call Class_Terminate()
Set Dispose = Nothing
End Function ' ScriptForge.SF_Timer Explicit destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Public Function Duration() As Double
''' Returns the actual (out of suspensions) time elapsed since start or between start and stop
''' Args:
''' Returns:
''' A Double expressing the duration in seconds
''' Example:
''' myTimer.Duration returns 1.234 (1 sec, 234 ms)
Duration = _PropertyGet("Duration")
End Function ' ScriptForge.SF_Timer.Duration
REM -----------------------------------------------------------------------------
Property Get IsStarted() As Boolean
''' Returns True if timer is started or suspended
''' Example:
''' myTimer.IsStarted
IsStarted = _PropertyGet("IsStarted")
End Property ' ScriptForge.SF_Timer.IsStarted
REM -----------------------------------------------------------------------------
Property Get IsSuspended() As Boolean
''' Returns True if timer is started and suspended
''' Example:
''' myTimer.IsSuspended
IsSuspended = _PropertyGet("IsSuspended")
End Property ' ScriptForge.SF_Timer.IsSuspended
REM -----------------------------------------------------------------------------
Public Function SuspendDuration() As Double
''' Returns the actual time elapsed while suspended since start or between start and stop
''' Args:
''' Returns:
''' A Double expressing the duration in seconds
''' Example:
''' myTimer.SuspendDuration returns 1.234 (1 sec, 234 ms)
SuspendDuration = _PropertyGet("SuspendDuration")
End Function ' ScriptForge.SF_Timer.SuspendDuration
REM -----------------------------------------------------------------------------
Public Function TotalDuration() As Double
''' Returns the actual time elapsed (including suspensions) since start or between start and stop
''' Args:
''' Returns:
''' A Double expressing the duration in seconds
''' Example:
''' myTimer.TotalDuration returns 1.234 (1 sec, 234 ms)
TotalDuration = _PropertyGet("TotalDuration")
End Function ' ScriptForge.SF_Timer.TotalDuration
REM ===================================================================== METHODS
REM -----------------------------------------------------------------------------
Public Function Continue() As Boolean
''' Halt suspension of a running timer
''' Args:
''' Returns:
''' True if successful, False if the timer is not suspended
''' Examples:
''' myTimer.Continue()
Const cstThisSub = "Timer.Continue"
Const cstSubArgs = ""
Check:
Continue = False
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If _TimerStatus = STATUSSUSPENDED Then
_TimerStatus = STATUSSTARTED
_SuspendDuration = _SuspendDuration + _Now() - _SuspendTime
_SuspendTime = 0
Continue = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer.Continue
REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Returns:
''' The actual value of the property
''' Exceptions
''' ARGUMENTERROR The property does not exist
''' Examples:
''' myTimer.GetProperty("Duration")
Const cstThisSub = "Timer.GetProperty"
Const cstSubArgs = "PropertyName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
GetProperty = _PropertyGet(PropertyName)
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_Timer.Properties
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list or methods of the Timer class as an array
Methods = Array( _
"Continue" _
, "Restart" _
, "Start" _
, "Suspend" _
, "Terminate" _
)
End Function ' ScriptForge.SF_Timer.Methods
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Timer class as an array
Properties = Array( _
"Duration" _
, "IsStarted" _
, "IsSuspended" _
, "SuspendDuration" _
, "TotalDuration" _
)
End Function ' ScriptForge.SF_Timer.Properties
REM -----------------------------------------------------------------------------
Public Function Restart() As Boolean
''' Terminate the timer and restart a new clean timer
''' Args:
''' Returns:
''' True if successful, False if the timer is inactive
''' Examples:
''' myTimer.Restart()
Const cstThisSub = "Timer.Restart"
Const cstSubArgs = ""
Check:
Restart = False
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If _TimerStatus <> STATUSINACTIVE Then
If _TimerStatus <> STATUSSTOPPED Then Terminate()
Start()
Restart = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer.Restart
REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
, Optional ByRef Value As Variant _
) As Boolean
''' Set a new value to the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Value: its new value
''' Exceptions
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "Timer.SetProperty"
Const cstSubArgs = "PropertyName, Value"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
SetProperty = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
Select Case UCase(PropertyName)
Case Else
End Select
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_Timer.SetProperty
REM -----------------------------------------------------------------------------
Public Function Start() As Boolean
''' Start a new clean timer
''' Args:
''' Returns:
''' True if successful, False if the timer is already started
''' Examples:
''' myTimer.Start()
Const cstThisSub = "Timer.Start"
Const cstSubArgs = ""
Check:
Start = False
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If _TimerStatus = STATUSINACTIVE Or _TimerStatus = STATUSSTOPPED Then
_TimerStatus = STATUSSTARTED
_StartTime = _Now()
_EndTime = 0
_SuspendTime = 0
_SuspendDuration = 0
Start = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer.Start
REM -----------------------------------------------------------------------------
Public Function Suspend() As Boolean
''' Suspend a running timer
''' Args:
''' Returns:
''' True if successful, False if the timer is not started or already suspended
''' Examples:
''' myTimer.Suspend()
Const cstThisSub = "Timer.Suspend"
Const cstSubArgs = ""
Check:
Suspend = False
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If _TimerStatus = STATUSSTARTED Then
_TimerStatus = STATUSSUSPENDED
_SuspendTime = _Now()
Suspend = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer.Suspend
REM -----------------------------------------------------------------------------
Public Function Terminate() As Boolean
''' Terminate a running timer
''' Args:
''' Returns:
''' True if successful, False if the timer is neither started nor suspended
''' Examples:
''' myTimer.Terminate()
Const cstThisSub = "Timer.Terminate"
Const cstSubArgs = ""
Check:
Terminate = False
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED Then
If _TimerSTatus = STATUSSUSPENDED Then Continue()
_TimerStatus = STATUSSTOPPED
_EndTime = _Now()
Terminate = True
End If
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer.Terminate
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _Now() As Double
''' Returns the current date and time
''' Uses the Calc NOW() function to get a higher precision than the usual Basic Now() function
''' Args:
''' Returns:
''' The actual time as a number
''' The integer part represents the date, the decimal part represents the time
_Now = SF_Session.ExecuteCalcFunction("NOW")
End Function ' ScriptForge.SF_Timer._Now
REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String)
''' Return the named property
''' Args:
''' psProperty: the name of the property
Dim dDuration As Double ' Computed duration
Dim cstThisSub As String
Dim cstSubArgs As String
cstThisSub = "Timer.get" & psProperty
cstSubArgs = ""
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Select Case UCase(psProperty)
Case UCase("Duration")
Select Case _TimerStatus
Case STATUSINACTIVE : dDuration = 0.0
Case STATUSSTARTED
dDuration = _Now() - _StartTime - _SuspendDuration
Case STATUSSUSPENDED
dDuration = _SuspendTime - _StartTime - _SuspendDuration
Case STATUSSTOPPED
dDuration = _EndTime - _StartTime - _SuspendDuration
End Select
_PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000
Case UCase("IsStarted")
_PropertyGet = CBool( _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED )
Case UCase("IsSuspended")
_PropertyGet = CBool( _TimerStatus = STATUSSUSPENDED )
Case UCase("SuspendDuration")
Select Case _TimerStatus
Case STATUSINACTIVE : dDuration = 0.0
Case STATUSSTARTED, STATUSSTOPPED
dDuration = _SuspendDuration
Case STATUSSUSPENDED
dDuration = _Now() - _SuspendTime + _SuspendDuration
End Select
_PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000
Case UCase("TotalDuration")
Select Case _TimerStatus
Case STATUSINACTIVE : dDuration = 0.0
Case STATUSSTARTED, STATUSSUSPENDED
dDuration = _Now() - _StartTime
Case STATUSSTOPPED
dDuration = _EndTime - _StartTime
End Select
_PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000
End Select
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' ScriptForge.SF_Timer._PropertyGet
REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the Timer instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
''' "[Timer] Duration:xxx.yyy
Const cstTimer = "[Timer] Duration: "
Const cstMaxLength = 50 ' Maximum length for items
_Repr = cstTimer & Replace(SF_Utils._Repr(Duration), ".", """")
End Function ' ScriptForge.SF_Timer._Repr
REM ============================================ END OF SCRIPTFORGE.SF_TIMER
</script:module>
|
