Current File : //usr/lib/libreoffice/share/basic/ScriptForge/SF_Timer.xba
<?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>
Mini Shell