| blob | f352e1135744b2a9b9641ace0f032a7f220d82cd |
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 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
26 REM ================================================================== EXCEPTIONS
28 REM ============================================================= PRIVATE MEMBERS
30 Private [Me] As Object
31 Private [_Parent] As Object
33 Private ServiceName As String
34 Private _TimerStatus As Integer ' inactive, started, suspended or stopped
35 Private _StartTime As Double ' Moment when timer started, restarted
36 Private _EndTime As Double ' Moment when timer stopped
37 Private _SuspendTime As Double ' Moment when timer suspended
38 Private _SuspendDuration As Double ' Duration of suspended status as a difference of times
40 REM ============================================================ MODULE CONSTANTS
42 Private Const STATUSINACTIVE = 0
43 Private Const STATUSSTARTED = 1
44 Private Const STATUSSUSPENDED = 2
45 Private Const STATUSSTOPPED = 3
47 Private Const DSECOND As Double = 1 / (24 * 60 * 60) ' Duration of 1 second as compared to 1.0 = 1 day
49 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
51 REM -----------------------------------------------------------------------------
52 Private Sub Class_Initialize()
53 Set [Me] = Nothing
54 Set [_Parent] = Nothing
57 _TimerStatus = STATUSINACTIVE
58 _StartTime = 0
59 _EndTime = 0
60 _SuspendTime = 0
61 _SuspendDuration = 0
62 End Sub ' ScriptForge.SF_Timer Constructor
64 REM -----------------------------------------------------------------------------
65 Private Sub Class_Terminate()
66 Call Class_Initialize()
67 End Sub ' ScriptForge.SF_Timer Destructor
69 REM -----------------------------------------------------------------------------
70 Public Function Dispose() As Variant
71 Call Class_Terminate()
72 Set Dispose = Nothing
73 End Function ' ScriptForge.SF_Timer Explicit destructor
75 REM ================================================================== PROPERTIES
77 REM -----------------------------------------------------------------------------
78 Public Function Duration() As Double
79 ''' Returns the actual (out of suspensions) time elapsed since start or between start and stop
80 ''' Args:
81 ''' Returns:
82 ''' A Double expressing the duration in seconds
83 ''' Example:
88 End Function ' ScriptForge.SF_Timer.Duration
90 REM -----------------------------------------------------------------------------
91 Property Get IsStarted() As Boolean
92 ''' Returns True if timer is started or suspended
93 ''' Example:
94 ''' myTimer.IsStarted
98 End Property ' ScriptForge.SF_Timer.IsStarted
100 REM -----------------------------------------------------------------------------
101 Property Get IsSuspended() As Boolean
102 ''' Returns True if timer is started and suspended
103 ''' Example:
104 ''' myTimer.IsSuspended
108 End Property ' ScriptForge.SF_Timer.IsSuspended
110 REM -----------------------------------------------------------------------------
111 Public Function SuspendDuration() As Double
112 ''' Returns the actual time elapsed while suspended since start or between start and stop
113 ''' Args:
114 ''' Returns:
115 ''' A Double expressing the duration in seconds
116 ''' Example:
121 End Function ' ScriptForge.SF_Timer.SuspendDuration
123 REM -----------------------------------------------------------------------------
124 Public Function TotalDuration() As Double
125 ''' Returns the actual time elapsed (including suspensions) since start or between start and stop
126 ''' Args:
127 ''' Returns:
128 ''' A Double expressing the duration in seconds
129 ''' Example:
134 End Function ' ScriptForge.SF_Timer.TotalDuration
136 REM ===================================================================== METHODS
138 REM -----------------------------------------------------------------------------
139 Public Function Continue() As Boolean
140 ''' Halt suspension of a running timer
141 ''' Args:
142 ''' Returns:
143 ''' True if successful, False if the timer is not suspended
144 ''' Examples:
145 ''' myTimer.Continue()
148 Const cstSubArgs = ""
150 Check:
151 Continue = False
152 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
154 Try:
155 If _TimerStatus = STATUSSUSPENDED Then
156 _TimerStatus = STATUSSTARTED
157 _SuspendDuration = _SuspendDuration + _Now() - _SuspendTime
158 _SuspendTime = 0
159 Continue = True
160 End If
162 Finally:
163 SF_Utils._ExitFunction(cstThisSub)
164 Exit Function
165 End Function ' ScriptForge.SF_Timer.Continue
167 REM -----------------------------------------------------------------------------
168 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
169 ''' Return the actual value of the given property
170 ''' Args:
171 ''' PropertyName: the name of the property as a string
172 ''' Returns:
173 ''' The actual value of the property
174 ''' Exceptions
175 ''' ARGUMENTERROR The property does not exist
176 ''' Examples:
182 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
183 GetProperty = Null
185 Check:
186 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
187 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
188 End If
190 Try:
191 GetProperty = _PropertyGet(PropertyName)
193 Finally:
194 SF_Utils._ExitFunction(cstThisSub)
195 Exit Function
196 Catch:
197 GoTo Finally
198 End Function ' ScriptForge.SF_Timer.Properties
200 REM -----------------------------------------------------------------------------
201 Public Function Methods() As Variant
202 ''' Return the list or methods of the Timer class as an array
204 Methods = Array( _
210 )
212 End Function ' ScriptForge.SF_Timer.Methods
214 REM -----------------------------------------------------------------------------
215 Public Function Properties() As Variant
216 ''' Return the list or properties of the Timer class as an array
218 Properties = Array( _
224 )
226 End Function ' ScriptForge.SF_Timer.Properties
228 REM -----------------------------------------------------------------------------
229 Public Function Restart() As Boolean
230 ''' Terminate the timer and restart a new clean timer
231 ''' Args:
232 ''' Returns:
233 ''' True if successful, False if the timer is inactive
234 ''' Examples:
235 ''' myTimer.Restart()
238 Const cstSubArgs = ""
240 Check:
241 Restart = False
242 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
244 Try:
245 If _TimerStatus <> STATUSINACTIVE Then
246 If _TimerStatus <> STATUSSTOPPED Then Terminate()
247 Start()
248 Restart = True
249 End If
251 Finally:
252 SF_Utils._ExitFunction(cstThisSub)
253 Exit Function
254 End Function ' ScriptForge.SF_Timer.Restart
256 REM -----------------------------------------------------------------------------
257 Public Function SetProperty(Optional ByVal PropertyName As Variant _
258 , Optional ByRef Value As Variant _
259 ) As Boolean
260 ''' Set a new value to the given property
261 ''' Args:
262 ''' PropertyName: the name of the property as a string
263 ''' Value: its new value
264 ''' Exceptions
265 ''' ARGUMENTERROR The property does not exist
270 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
271 SetProperty = False
273 Check:
274 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
275 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
276 End If
278 Try:
279 Select Case UCase(PropertyName)
280 Case Else
281 End Select
283 Finally:
284 SF_Utils._ExitFunction(cstThisSub)
285 Exit Function
286 Catch:
287 GoTo Finally
288 End Function ' ScriptForge.SF_Timer.SetProperty
290 REM -----------------------------------------------------------------------------
291 Public Function Start() As Boolean
292 ''' Start a new clean timer
293 ''' Args:
294 ''' Returns:
295 ''' True if successful, False if the timer is already started
296 ''' Examples:
297 ''' myTimer.Start()
300 Const cstSubArgs = ""
302 Check:
303 Start = False
304 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
306 Try:
307 If _TimerStatus = STATUSINACTIVE Or _TimerStatus = STATUSSTOPPED Then
308 _TimerStatus = STATUSSTARTED
309 _StartTime = _Now()
310 _EndTime = 0
311 _SuspendTime = 0
312 _SuspendDuration = 0
313 Start = True
314 End If
316 Finally:
317 SF_Utils._ExitFunction(cstThisSub)
318 Exit Function
319 End Function ' ScriptForge.SF_Timer.Start
321 REM -----------------------------------------------------------------------------
322 Public Function Suspend() As Boolean
323 ''' Suspend a running timer
324 ''' Args:
325 ''' Returns:
326 ''' True if successful, False if the timer is not started or already suspended
327 ''' Examples:
328 ''' myTimer.Suspend()
331 Const cstSubArgs = ""
333 Check:
334 Suspend = False
335 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
337 Try:
338 If _TimerStatus = STATUSSTARTED Then
339 _TimerStatus = STATUSSUSPENDED
340 _SuspendTime = _Now()
341 Suspend = True
342 End If
344 Finally:
345 SF_Utils._ExitFunction(cstThisSub)
346 Exit Function
347 End Function ' ScriptForge.SF_Timer.Suspend
349 REM -----------------------------------------------------------------------------
350 Public Function Terminate() As Boolean
351 ''' Terminate a running timer
352 ''' Args:
353 ''' Returns:
354 ''' True if successful, False if the timer is neither started nor suspended
355 ''' Examples:
356 ''' myTimer.Terminate()
359 Const cstSubArgs = ""
361 Check:
362 Terminate = False
363 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
365 Try:
366 If _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED Then
367 If _TimerSTatus = STATUSSUSPENDED Then Continue()
368 _TimerStatus = STATUSSTOPPED
369 _EndTime = _Now()
370 Terminate = True
371 End If
373 Finally:
374 SF_Utils._ExitFunction(cstThisSub)
375 Exit Function
376 End Function ' ScriptForge.SF_Timer.Terminate
378 REM =========================================================== PRIVATE FUNCTIONS
380 REM -----------------------------------------------------------------------------
381 Private Function _Now() As Double
382 ''' Returns the current date and time
383 ''' Uses the Calc NOW() function to get a higher precision than the usual Basic Now() function
384 ''' Args:
385 ''' Returns:
386 ''' The actual time as a number
387 ''' The integer part represents the date, the decimal part represents the time
391 End Function ' ScriptForge.SF_Timer._Now
393 REM -----------------------------------------------------------------------------
394 Private Function _PropertyGet(Optional ByVal psProperty As String)
395 ''' Return the named property
396 ''' Args:
397 ''' psProperty: the name of the property
399 Dim dDuration As Double ' Computed duration
400 Dim cstThisSub As String
401 Dim cstSubArgs As String
404 cstSubArgs = ""
405 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
407 Select Case UCase(psProperty)
409 Select Case _TimerStatus
410 Case STATUSINACTIVE : dDuration = 0.0
411 Case STATUSSTARTED
412 dDuration = _Now() - _StartTime - _SuspendDuration
413 Case STATUSSUSPENDED
414 dDuration = _SuspendTime - _StartTime - _SuspendDuration
415 Case STATUSSTOPPED
416 dDuration = _EndTime - _StartTime - _SuspendDuration
417 End Select
420 _PropertyGet = ( _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED )
422 _PropertyGet = ( _TimerStatus = STATUSSUSPENDED )
424 Select Case _TimerStatus
425 Case STATUSINACTIVE : dDuration = 0.0
426 Case STATUSSTARTED, STATUSSTOPPED
427 dDuration = _SuspendDuration
428 Case STATUSSUSPENDED
429 dDuration = _Now() - _SuspendTime + _SuspendDuration
430 End Select
433 Select Case _TimerStatus
434 Case STATUSINACTIVE : dDuration = 0.0
435 Case STATUSSTARTED, STATUSSUSPENDED
436 dDuration = _Now() - _StartTime
437 Case STATUSSTOPPED
438 dDuration = _EndTime - _StartTime
439 End Select
441 End Select
443 Finally:
444 SF_Utils._ExitFunction(cstThisSub)
445 Exit Function
446 End Function ' ScriptForge.SF_Timer._PropertyGet
448 REM -----------------------------------------------------------------------------
449 Private Function _Repr() As String
450 ''' Convert the Timer instance to a readable string, typically for debugging purposes (DebugPrint ...)
451 ''' Args:
452 ''' Return:
453 ''' "[Timer] Duration:xxx.yyy
458 _Repr = cstTimer & Replace(SF_Utils._Repr(Duration), ".", """")
460 End Function ' ScriptForge.SF_Timer._Repr
462 REM ============================================ END OF SCRIPTFORGE.SF_TIMER
463 </script:module>