Jean-Pierre Ledure
61c6321c76
The durations in the Timer service are measured with a precision of the millisecond. Thanks to tdf#161469 the Basic Now() function provides sub-seconds precision since LO 25.2. Hence the use of the Calc NOW() function is replaced in the Basic code by the more immediately available Basic Now() equivalent. No impact on existing user scripts. Documentation is unchanged. Change-Id: Ia3b0f07918d9b9a9e96f62aaa5ce3862a2b48579 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/194070 Tested-by: Jenkins Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
466 lines
17 KiB
XML
466 lines
17 KiB
XML
<?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 with a required precision of at least the millisecond.
|
|
''' Uses the Basic NOW() (i.o. Calc's) function as it provides the required precision since LO 25.2 (tdf#161469).
|
|
''' Args:
|
|
''' Returns:
|
|
''' The actual time as a number
|
|
''' The integer part represents the date, the decimal part represents the time
|
|
|
|
_Now = CDbl(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> |