<?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_SharedMemory" 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 Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_SharedMemory
''' ===============
''' Singleton class implementing the "ScriptForge.SharedMemory" service
''' Implemented as a usual Basic module
'''
''' Contains the mechanisms to manage persistent memory storage
''' across Basic and/or Python scripts.
'''
''' When a script stops running, all the variables it uses vanish,
''' except Basic Global variables, which stay in memory until the end
''' of the LibreOffice session.
'''
''' However event-driven scripting can often benefit from having variables
''' still being available when the next script is triggered, probably due
''' to a user action.
'''
''' The SharedMemory service implements interfaces allowing to store both BASIC
''' and PYTHON variables in persistent storage, and to retrieve them later
''' from either BASIC or PYTHON scripts interchangeably.
'''
''' The use of the Basic Global statement is more efficient than the actual service
''' and should be preferred when the variables are created and retrieved in basic
''' scripts only.
'''
''' Service invocation example:
''' Dim memory As Variant
''' memory = CreateScriptService("SharedMemory")
'''
''' Example:
''' Sub CreateDoc()
''' ui = CreateScriptService("UI")
''' doc = ui.CreateDocument("Calc")
''' store = CreateScriptService("SharedMemory")
''' store.StoreValue(doc, "actualdocument")
''' ...
'''
''' def UpdateDoc():
''' store = CreateScriptService("SharedMemory")
''' doc = store.ReadValue("actualdocument")
''' ...
'''
''' Detailed user documentation:
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_SharedMemory.html?DbPAR=BASIC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
REM ============================================================ MODULE CONSTANTS
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
RemoveAll()
Set Dispose = Nothing
End Function ' ScriptForge.SF_SharedMemory Explicit destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Property Get ObjectType As String
''' Only to enable object representation
ObjectType = "SF_SharedMemory"
End Property ' ScriptForge.SF_SharedMemory.ObjectType
REM -----------------------------------------------------------------------------
Property Get ServiceName As String
''' Internal use
ServiceName = "ScriptForge.SharedMemory"
End Property ' ScriptForge.SF_SharedMemory.ServiceName
REM ============================================================== PUBLIC METHODS
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
Const cstThisSub = "SharedMemory.GetProperty"
Const cstSubArgs = "PropertyName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null
Check:SharedMemory
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_SharedMemory.GetProperty
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the SharedMemory service as an array
Methods = Array( _
"Exists" _
, "ReadValue" _
, "Rename" _
, "Remove" _
, "RemoveAll" _
, "StoreValue" _
)
End Function ' ScriptForge.SF_SharedMemory.Methods
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties as an array
Properties = Array( _
)
End Function ' ScriptForge.SF_SharedMemory.Properties
REM -----------------------------------------------------------------------------
Public Function Exists(Optional ByVal VariableName As Variant) As Boolean
''' Returns True if the given name exists in the shared and persistent storage.
''' Args:
''' VariableName: a case-sensitive name.
''' Returns:
''' True if VariableName exists.
''' Example:
''' memory = CreateScriptService("SharedMemory")
''' If memory.Exists("ActualDoc") Then
''' ...
Dim bExists As Boolean ' Return value
Const cstThisSub = "SharedMemory.Exists"
Const cstSubArgs = "VariableName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bExists = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(VariableName, "VariableName", V_STRING) Then GoTo Catch
End If
Try:
If Not IsNull(_SF_.GlobalStorage) Then bExists = _SF_.GlobalStorage.Exists(VariableName)
Finally:
Exists = bExists
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.Exists
REM -----------------------------------------------------------------------------
Public Function ReadValue(Optional ByVal VariableName As Variant) As Variant
''' Read in the shared and persistent storage area the requested value or array of values.
''' If the returned value is a ScriptForge class instance, the user script can verify if the
''' corresponding interface (dialog, document, ...) is still valid with its IsAlive property.
''' Args:
''' VariableName: the case-sensitive name of the value to retrieve.
''' Returns:
''' A scalar or an array of scalars.
''' If VariableName does not exist, an error is generated.
''' Example:
''' memory = CreateScriptService("SharedMemory")
''' doc = CreateScriptService("Document", ThisComponent)
''' memory.StoreValue("ActualDoc", doc)
''' ... ' The script might be stopped
''' doc2 = memory.ReadValue("ActualDoc")
''' If doc2.IsAlive Then ' Check that the document has not been closed by the user
''' ...
Dim vRead As Variant ' Return value
Dim vKeys As Variant ' Array of dictionary keys
Const cstThisSub = "SharedMemory.ReadValue"
Const cstSubArgs = "VariableName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vRead = Empty
' Initialize the dictionary if necessary
If IsNull(_SF_.GlobalStorage) Then _SF_.GlobalStorage = CreateScriptService("Dictionary", True)
Check:
vKeys = _SF_.GlobalStorage.Keys
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(VariableName, "VariableName", V_STRING, vKeys, True) Then GoTo Catch
End If
Try:
' Read the value in the persistent dictionary
vRead = _SF_.GlobalStorage.Item(VariableName)
Finally:
ReadValue = vRead
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.ReadValue
REM -----------------------------------------------------------------------------
Public Function Remove(Optional ByVal VariableName As Variant) As Boolean
''' Remove the entry in the shared and persistent storage area corresponding with the given name.
''' Args:
''' VariableName: the case-sensitive name to remove.
''' Returns:
''' True when successful.
''' If VariableName does not exist, an error is generated.
''' Example:
''' memory = CreateScriptService("SharedMemory")
''' If memory.Exists("ActualDoc") Then memory.Remove("ActualDoc")
''' ...
Dim bRemove As Boolean ' Return value
Dim vKeys As Variant ' Array of dictionary keys
Const cstThisSub = "SharedMemory.Remove"
Const cstSubArgs = "VariableName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bRemove = False
' Initialize the dictionary if necessary
If IsNull(_SF_.GlobalStorage) Then _SF_.GlobalStorage = CreateScriptService("Dictionary", True)
Check:
vKeys = _SF_.GlobalStorage.Keys
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(VariableName, "VariableName", V_STRING, vKeys, True) Then GoTo Catch
End If
Try:
' Remove key and item from the persistent dictionary
bRemove = _SF_.GlobalStorage.Remove(VariableName)
Finally:
Remove = bRemove
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.Remove
REM -----------------------------------------------------------------------------
Public Function RemoveAll() As Boolean
''' Remove the whole content of the shared and persistent storage area.
''' Returns:
''' True when successful.
''' Example:
''' memory = CreateScriptService("SharedMemory")
''' memory.RemoveAll()
''' MsgBox memory.Exists("ActualDoc") ' False
''' ...
Dim bRemoveAll As Boolean ' Return value
Const cstThisSub = "SharedMemory.RemoveAll"
Const cstSubArgs = ""
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bRemoveAll = False
Check:
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
Try:
If Not IsNull(_SF_.GlobalStorage) Then bRemoveAll = _SF_.GlobalStorage.RemoveAll()
Finally:
RemoveAll = bRemoveAll
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.RemoveAll
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 = "SharedMemory.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
SetProperty = True
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.SetProperty
REM -----------------------------------------------------------------------------
Public Function StoreValue(Optional ByVal VariableName As Variant _
, Optional ByVal Value As Variant _
) As Boolean
''' Store in the shared and persistent storage area the given value.
''' Later retrieval will be done thanks to the given variable name.
''' If the given name already exists, its value is replaced without warning.
''' Args:
''' VariableName: the case-sensitive name to retrieve the Value when needed.
''' Value: the value to be stored.
''' The supported variable types are:
''' * Scalar or 1D-array/tuple combining :
''' - Integer/Long or int, within the bounds of the Basic Long type
''' - Single/Double or float, within the bounds of the Basic Double type
''' - String or str
''' - Boolean or bool
''' - Null or None (Empty and Nothing are reset to Null)
''' - Variant embedding one of above types
''' * Date or datetime.datetime
''' * UNO object
''' * ScriptForge class instance
''' Returns:
''' True when successful
''' Example:
''' memory = CreateScriptService("SharedMemory")
''' doc = CreateScriptService("Document", ThisComponent)
''' memory.StoreValue("ActualDoc", doc)
Dim bStore As Boolean ' Return value
Dim vGlobal As Variant ' A stored value
Dim i As Long
Const cstThisSub = "SharedMemory.StoreValue"
Const cstSubArgs = "VariableName, Value"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bStore = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(VariableName, "VariableName", V_STRING) Then GoTo Catch
If IsArray(Value) Then
If Not SF_Utils._ValidateArray(Value, "Value", 1) Then GoTo Catch
End If
End If
Try:
' Initialize the dictionary if necessary
If IsNull(_SF_.GlobalStorage) Then _SF_.GlobalStorage = CreateScriptService("Dictionary", True)
' Size the returned array when the input is an array
If IsArray(Value) Then
vGlobal = Array()
ReDim vGlobal(LBound(Value) To UBound(Value))
For i = LBound(vGlobal) To UBound(vGlobal)
vGlobal(i) = _ConvertValue(Value(i), pbArray := True)
If IsEmpty(vGlobal(i)) Then
vGlobal = Empty
Exit For
End If
Next i
Else
vGlobal = _ConvertValue(Value, pbArray := False)
End If
' Store the value in the persistent dictionary
If Not IsEmpty(vGlobal) Then
With _SF_.GlobalStorage
If .Exists(VariableName) Then bStore = .ReplaceItem(VariableName, vGlobal) Else bStore = .Add(VariableName, vGlobal)
End With
End If
Finally:
StoreValue = bStore
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_SharedMemory.StoreValue
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Private Function _ConvertValue(pvValue As Variant _
, pbArray As Boolean _
) As Variant
''' Convert the input value to one of the types applicable
''' to shared memory constraints.
''' Args:
''' pvValue: the input value, must not be an array
''' pbArray: when True, pvValue is an item inside an array
''' Returns:
''' The converted value.
''' Empty when the conversion was not successful.
Dim vGlobal As Variant ' Return value
Dim iObjectType As Integer ' The object type returned by _VarTypeObj()
Try:
vGlobal = Empty
Select Case VarType(pvValue)
Case V_INTEGER, V_LONG, V_BIGINT
vGlobal = CLng(pvValue)
Case V_SINGLE, V_DOUBLE, V_CURRENCY, V_DECIMAL
vGlobal = CDbl(pvValue)
Case V_EMPTY, V_NULL
vGlobal = Null
Case V_STRING, ScriptForge.V_BOOLEAN
vGlobal = pvValue
Case V_DATE ' No dates in arrays
If Not pbArray Then vGlobal = pvValue
Case ScriptForge.V_OBJECT
If Not pbArray Then ' No objects in arrays
iObjectType = SF_Utils._VarTypeObj(pvValue).iVarType
Select Case iObjectType
Case ScriptForge.V_Nothing
vGlobal = Null
Case ScriptForge.V_UNOOBJECT, ScriptForge.V_SFOBJECT
vGlobal = pvValue
Case Else ' V_BASICOBJECT
End Select
End If
Case >= ScriptForge.V_ARRAY ' No subarrays
Case Else
End Select
Finally:
_ConvertValue = vGlobal
Exit Function
End Function ' ScriptForge.SF_SharedMemory._ConvertValue
REM =============================================== END OF SCRIPTFORGE.SF_SHAREDMEMORY
</script:module>