| blob | 2b3286e041ab0fa1ff335fec6fadca5149fbe0de |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Timer" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option ClassModule
11 Option Explicit
13 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
14 ''' SF_Timer
15 ''' ========
16 ''' Class for management of scripts execution performance
17 ''' A Timer measures durations. It can be suspended, resumed, restarted
18 ''' Duration properties are expressed in seconds with a precision of 3 decimal digits
19 '''
20 ''' Service invocation example:
21 ''' Dim myTimer As Variant
23 ''' myTimer = CreateScriptService("Timer", True) ' => To start timer immediately
24 '''
25 ''' Detailed user documentation:
26 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_timer.html?DbPAR=BASIC
27 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
29 REM ================================================================== EXCEPTIONS
31 REM ============================================================= PRIVATE MEMBERS
33 Private [Me] As Object
34 Private [_Parent] As Object
36 Private ServiceName As String
37 Private _TimerStatus As Integer ' inactive, started, suspended or stopped
38 Private _StartTime As Double ' Moment when timer started, restarted
39 Private _EndTime As Double ' Moment when timer stopped
40 Private _SuspendTime As Double ' Moment when timer suspended
41 Private _SuspendDuration As Double ' Duration of suspended status as a difference of times
43 REM ============================================================ MODULE CONSTANTS
45 Private Const STATUSINACTIVE = 0
46 Private Const STATUSSTARTED = 1
47 Private Const STATUSSUSPENDED = 2
48 Private Const STATUSSTOPPED = 3
50 Private Const DSECOND As Double = 1 / (24 * 60 * 60) ' Duration of 1 second as compared to 1.0 = 1 day
52 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
54 REM -----------------------------------------------------------------------------
55 Private Sub Class_Initialize()
56 Set [Me] = Nothing
57 Set [_Parent] = Nothing
60 _TimerStatus = STATUSINACTIVE
61 _StartTime = 0
62 _EndTime = 0
63 _SuspendTime = 0
64 _SuspendDuration = 0
65 End Sub ' ScriptForge.SF_Timer Constructor
67 REM -----------------------------------------------------------------------------
68 Private Sub Class_Terminate()
69 Call Class_Initialize()
70 End Sub ' ScriptForge.SF_Timer Destructor
72 REM -----------------------------------------------------------------------------
73 Public Function Dispose() As Variant
74 Call Class_Terminate()
75 Set Dispose = Nothing
76 End Function ' ScriptForge.SF_Timer Explicit destructor
78 REM ================================================================== PROPERTIES
80 REM -----------------------------------------------------------------------------
81 Public Function Duration() As Double
82 ''' Returns the actual (out of suspensions) time elapsed since start or between start and stop
83 ''' Args:
84 ''' Returns:
85 ''' A Double expressing the duration in seconds
86 ''' Example:
91 End Function ' ScriptForge.SF_Timer.Duration
93 REM -----------------------------------------------------------------------------
94 Property Get IsStarted() As Boolean
95 ''' Returns True if timer is started or suspended
96 ''' Example:
97 ''' myTimer.IsStarted
101 End Property ' ScriptForge.SF_Timer.IsStarted
103 REM -----------------------------------------------------------------------------
104 Property Get IsSuspended() As Boolean
105 ''' Returns True if timer is started and suspended
106 ''' Example:
107 ''' myTimer.IsSuspended
111 End Property ' ScriptForge.SF_Timer.IsSuspended
113 REM -----------------------------------------------------------------------------
114 Public Function SuspendDuration() As Double
115 ''' Returns the actual time elapsed while suspended since start or between start and stop
116 ''' Args:
117 ''' Returns:
118 ''' A Double expressing the duration in seconds
119 ''' Example:
124 End Function ' ScriptForge.SF_Timer.SuspendDuration
126 REM -----------------------------------------------------------------------------
127 Public Function TotalDuration() As Double
128 ''' Returns the actual time elapsed (including suspensions) since start or between start and stop
129 ''' Args:
130 ''' Returns:
131 ''' A Double expressing the duration in seconds
132 ''' Example:
137 End Function ' ScriptForge.SF_Timer.TotalDuration
139 REM ===================================================================== METHODS
141 REM -----------------------------------------------------------------------------
142 Public Function Continue() As Boolean
143 ''' Halt suspension of a running timer
144 ''' Args:
145 ''' Returns:
146 ''' True if successful, False if the timer is not suspended
147 ''' Examples:
148 ''' myTimer.Continue()
151 Const cstSubArgs = ""
153 Check:
154 Continue = False
155 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
157 Try:
158 If _TimerStatus = STATUSSUSPENDED Then
159 _TimerStatus = STATUSSTARTED
160 _SuspendDuration = _SuspendDuration + _Now() - _SuspendTime
161 _SuspendTime = 0
162 Continue = True
163 End If
165 Finally:
166 SF_Utils._ExitFunction(cstThisSub)
167 Exit Function
168 End Function ' ScriptForge.SF_Timer.Continue
170 REM -----------------------------------------------------------------------------
171 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
172 ''' Return the actual value of the given property
173 ''' Args:
174 ''' PropertyName: the name of the property as a string
175 ''' Returns:
176 ''' The actual value of the property
177 ''' Exceptions
178 ''' ARGUMENTERROR The property does not exist
179 ''' Examples:
185 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
186 GetProperty = Null
188 Check:
189 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
190 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
191 End If
193 Try:
194 GetProperty = _PropertyGet(PropertyName)
196 Finally:
197 SF_Utils._ExitFunction(cstThisSub)
198 Exit Function
199 Catch:
200 GoTo Finally
201 End Function ' ScriptForge.SF_Timer.Properties
203 REM -----------------------------------------------------------------------------
204 Public Function Methods() As Variant
205 ''' Return the list or methods of the Timer class as an array
207 Methods = Array( _
213 )
215 End Function ' ScriptForge.SF_Timer.Methods
217 REM -----------------------------------------------------------------------------
218 Public Function Properties() As Variant
219 ''' Return the list or properties of the Timer class as an array
221 Properties = Array( _
227 )
229 End Function ' ScriptForge.SF_Timer.Properties
231 REM -----------------------------------------------------------------------------
232 Public Function Restart() As Boolean
233 ''' Terminate the timer and restart a new clean timer
234 ''' Args:
235 ''' Returns:
236 ''' True if successful, False if the timer is inactive
237 ''' Examples:
238 ''' myTimer.Restart()
241 Const cstSubArgs = ""
243 Check:
244 Restart = False
245 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
247 Try:
248 If _TimerStatus <> STATUSINACTIVE Then
249 If _TimerStatus <> STATUSSTOPPED Then Terminate()
250 Start()
251 Restart = True
252 End If
254 Finally:
255 SF_Utils._ExitFunction(cstThisSub)
256 Exit Function
257 End Function ' ScriptForge.SF_Timer.Restart
259 REM -----------------------------------------------------------------------------
260 Public Function SetProperty(Optional ByVal PropertyName As Variant _
261 , Optional ByRef Value As Variant _
262 ) As Boolean
263 ''' Set a new value to the given property
264 ''' Args:
265 ''' PropertyName: the name of the property as a string
266 ''' Value: its new value
267 ''' Exceptions
268 ''' ARGUMENTERROR The property does not exist
273 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
274 SetProperty = False
276 Check:
277 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
278 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
279 End If
281 Try:
282 Select Case UCase(PropertyName)
283 Case Else
284 End Select
286 Finally:
287 SF_Utils._ExitFunction(cstThisSub)
288 Exit Function
289 Catch:
290 GoTo Finally
291 End Function ' ScriptForge.SF_Timer.SetProperty
293 REM -----------------------------------------------------------------------------
294 Public Function Start() As Boolean
295 ''' Start a new clean timer
296 ''' Args:
297 ''' Returns:
298 ''' True if successful, False if the timer is already started
299 ''' Examples:
300 ''' myTimer.Start()
303 Const cstSubArgs = ""
305 Check:
306 Start = False
307 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
309 Try:
310 If _TimerStatus = STATUSINACTIVE Or _TimerStatus = STATUSSTOPPED Then
311 _TimerStatus = STATUSSTARTED
312 _StartTime = _Now()
313 _EndTime = 0
314 _SuspendTime = 0
315 _SuspendDuration = 0
316 Start = True
317 End If
319 Finally:
320 SF_Utils._ExitFunction(cstThisSub)
321 Exit Function
322 End Function ' ScriptForge.SF_Timer.Start
324 REM -----------------------------------------------------------------------------
325 Public Function Suspend() As Boolean
326 ''' Suspend a running timer
327 ''' Args:
328 ''' Returns:
329 ''' True if successful, False if the timer is not started or already suspended
330 ''' Examples:
331 ''' myTimer.Suspend()
334 Const cstSubArgs = ""
336 Check:
337 Suspend = False
338 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
340 Try:
341 If _TimerStatus = STATUSSTARTED Then
342 _TimerStatus = STATUSSUSPENDED
343 _SuspendTime = _Now()
344 Suspend = True
345 End If
347 Finally:
348 SF_Utils._ExitFunction(cstThisSub)
349 Exit Function
350 End Function ' ScriptForge.SF_Timer.Suspend
352 REM -----------------------------------------------------------------------------
353 Public Function Terminate() As Boolean
354 ''' Terminate a running timer
355 ''' Args:
356 ''' Returns:
357 ''' True if successful, False if the timer is neither started nor suspended
358 ''' Examples:
359 ''' myTimer.Terminate()
362 Const cstSubArgs = ""
364 Check:
365 Terminate = False
366 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
368 Try:
369 If _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED Then
370 If _TimerSTatus = STATUSSUSPENDED Then Continue()
371 _TimerStatus = STATUSSTOPPED
372 _EndTime = _Now()
373 Terminate = True
374 End If
376 Finally:
377 SF_Utils._ExitFunction(cstThisSub)
378 Exit Function
379 End Function ' ScriptForge.SF_Timer.Terminate
381 REM =========================================================== PRIVATE FUNCTIONS
383 REM -----------------------------------------------------------------------------
384 Private Function _Now() As Double
385 ''' Returns the current date and time
386 ''' Uses the Calc NOW() function to get a higher precision than the usual Basic Now() function
387 ''' Args:
388 ''' Returns:
389 ''' The actual time as a number
390 ''' The integer part represents the date, the decimal part represents the time
394 End Function ' ScriptForge.SF_Timer._Now
396 REM -----------------------------------------------------------------------------
397 Private Function _PropertyGet(Optional ByVal psProperty As String)
398 ''' Return the named property
399 ''' Args:
400 ''' psProperty: the name of the property
402 Dim dDuration As Double ' Computed duration
403 Dim cstThisSub As String
404 Dim cstSubArgs As String
407 cstSubArgs = ""
408 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
410 Select Case UCase(psProperty)
412 Select Case _TimerStatus
413 Case STATUSINACTIVE : dDuration = 0.0
414 Case STATUSSTARTED
415 dDuration = _Now() - _StartTime - _SuspendDuration
416 Case STATUSSUSPENDED
417 dDuration = _SuspendTime - _StartTime - _SuspendDuration
418 Case STATUSSTOPPED
419 dDuration = _EndTime - _StartTime - _SuspendDuration
420 End Select
423 _PropertyGet = CBool( _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED )
425 _PropertyGet = CBool( _TimerStatus = STATUSSUSPENDED )
427 Select Case _TimerStatus
428 Case STATUSINACTIVE : dDuration = 0.0
429 Case STATUSSTARTED, STATUSSTOPPED
430 dDuration = _SuspendDuration
431 Case STATUSSUSPENDED
432 dDuration = _Now() - _SuspendTime + _SuspendDuration
433 End Select
436 Select Case _TimerStatus
437 Case STATUSINACTIVE : dDuration = 0.0
438 Case STATUSSTARTED, STATUSSUSPENDED
439 dDuration = _Now() - _StartTime
440 Case STATUSSTOPPED
441 dDuration = _EndTime - _StartTime
442 End Select
444 End Select
446 Finally:
447 SF_Utils._ExitFunction(cstThisSub)
448 Exit Function
449 End Function ' ScriptForge.SF_Timer._PropertyGet
451 REM -----------------------------------------------------------------------------
452 Private Function _Repr() As String
453 ''' Convert the Timer instance to a readable string, typically for debugging purposes (DebugPrint ...)
454 ''' Args:
455 ''' Return:
456 ''' "[Timer] Duration:xxx.yyy
461 _Repr = cstTimer & Replace(SF_Utils._Repr(Duration), ".", """")
463 End Function ' ScriptForge.SF_Timer._Repr
465 REM ============================================ END OF SCRIPTFORGE.SF_TIMER
466 </script:module>