forked from amazingfate/loongoffice
70f3fea2f3
To enhance the compatibility between
- sf dictionaries
- python dicts
- arrays of PropertyValues
it was necessary to propose the support
of case-sensitive keys, i.e. keys are
different if a case-sensitive comparison
finds them different.
So far only not case-sensitive keys
were supported.
This required a re-visit of the implementation
of the ScriptForge.SF_Dictionary service. So far
it was built upon a Basic Collection class which
differentiates keys not case-sensitively. The
new implementation uses sorted arrays.
The invocation of the service is now:
dict = CreateScriptService("Dictionary", True/False)
True means case-sensitive keys.
Default = False, which preserves the compatibility
with the past.
ScriptForge uses dictionaries internally in
several places. For each of them it has been
assessed if the new attribute was justified
or not. For most of the contexts, it was.
The functionality makes sense only for Basic
user scripts.
The documentation of the Dictionary page
should be revised according to the new invocation
syntax.
Change-Id: If1f695bcbf1673a2b71c1e41487b1781caab71c2
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/173044
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
955 lines
37 KiB
XML
955 lines
37 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_Dictionary" 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_Dictionary
|
|
''' =============
|
|
''' Class for management of dictionaries
|
|
''' A dictionary is a collection of key-item pairs
|
|
''' The key is either a case-sensitive or a not case-sensitive string
|
|
''' Items may be of any type
|
|
''' Keys, items can be retrieved, counted, etc.
|
|
'''
|
|
''' The implementation is based on 3 one-column arrays:
|
|
''' 1) The keys - sorted
|
|
''' 2) The positions in 3) - same sequence as 1)
|
|
''' 3) The item contents - stacked up when defined - erased items are set to Empty
|
|
'''
|
|
''' Why a Dictionary class beside the builtin Collection class ?
|
|
''' A standard Basic collection does not support the retrieval of the keys
|
|
''' A standard Basic collection does not support the update/removal of entries
|
|
''' No easy conversion to/from json or PropertyValues
|
|
'''
|
|
''' Service instantiation example:
|
|
''' Dim myDict As Variant
|
|
''' myDict = CreateScriptService("Dictionary", True) ' Case-sensitive, default = False
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dictionary.html?DbPAR=BASIC
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" ' Key exists already
|
|
Const UNKNOWNKEYERROR = "UNKNOWNKEYERROR" ' Key not found
|
|
Const INVALIDKEYERROR = "INVALIDKEYERROR" ' Key contains only spaces
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be "DICTIONARY"
|
|
Private ServiceName As String
|
|
Private CaseSensitive As Boolean ' Determined at dictionary creation, default = False
|
|
Private MapKeys As Variant ' Array of keys
|
|
Private MapPositions As Variant ' Array of indexes in MapItems, sorted as MapKeys
|
|
Private MapItems As Variant ' Array of ItemMaps
|
|
Private _MapSize As Long ' Total number of entries in the dictionary
|
|
Private _MapRemoved As Long ' Number of inactive entries in the dictionary
|
|
|
|
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Parent] = Nothing
|
|
ObjectType = "DICTIONARY"
|
|
ServiceName = "ScriptForge.Dictionary"
|
|
CaseSensitive = False
|
|
MapKeys = Array()
|
|
MapPositions = Array()
|
|
MapItems = Array()
|
|
_MapSize = 0
|
|
_MapRemoved = 0
|
|
End Sub ' ScriptForge.SF_Dictionary Constructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Call Class_Initialize()
|
|
End Sub ' ScriptForge.SF_Dictionary Destructor
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
RemoveAll()
|
|
Set Dispose = Nothing
|
|
End Function ' ScriptForge.SF_Dictionary Explicit destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Count() As Long
|
|
''' Actual number of entries in the dictionary
|
|
''' Example:
|
|
''' myDict.Count
|
|
|
|
Count = _PropertyGet("Count")
|
|
|
|
End Property ' ScriptForge.SF_Dictionary.Count
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Item(Optional ByVal Key As Variant) As Variant
|
|
''' Return the value of the item related to Key
|
|
''' Args:
|
|
''' Key: the key value (string)
|
|
''' Returns:
|
|
''' Empty if not found, otherwise the found value
|
|
''' Example:
|
|
''' myDict.Item("ThisKey")
|
|
''' NB: defined as a function to not disrupt the Basic IDE debugger
|
|
|
|
Item = _PropertyGet("Item", Key)
|
|
|
|
End Function ' ScriptForge.SF_Dictionary.Item
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Items() as Variant
|
|
''' Return the list of Items as a 1D array
|
|
''' The Items and Keys properties return their respective contents in the same order
|
|
''' The order is however not necessarily identical to the creation sequence
|
|
''' Returns:
|
|
''' The array is empty if the dictionary is empty
|
|
''' Examples
|
|
''' a = myDict.Items
|
|
''' For Each b In a ...
|
|
|
|
Items = _PropertyGet("Items")
|
|
|
|
End Property ' ScriptForge.SF_Dictionary.Items
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get Keys() as Variant
|
|
''' Return the list of keys as a 1D array
|
|
''' The Keys and Items properties return their respective contents in the same order
|
|
''' The order is however not necessarily identical to the creation sequence
|
|
''' Returns:
|
|
''' The array is empty if the dictionary is empty
|
|
''' Examples
|
|
''' a = myDict.Keys
|
|
''' For each b In a ...
|
|
|
|
Keys = _PropertyGet("Keys")
|
|
|
|
End Property ' ScriptForge.SF_Dictionary.Keys
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Add(Optional ByVal Key As Variant _
|
|
, Optional ByVal Item As Variant _
|
|
) As Boolean
|
|
''' Add a new key-item pair into the dictionary
|
|
''' Args:
|
|
''' Key: must not yet exist in the dictionary
|
|
''' Item: any value, including an array, a Basic object, a UNO object, ...
|
|
''' Returns: True if successful
|
|
''' Exceptions:
|
|
''' DUPLICATEKEYERROR: such a key exists already
|
|
''' INVALIDKEYERROR: zero-length string or only spaces
|
|
''' Examples:
|
|
''' myDict.Add("NewKey", NewValue)
|
|
|
|
Dim vItemMap As Variant ' Output of SF_Array._FindItem
|
|
Dim lIndex As Long ' Index in MapKeys and MapPositions
|
|
Const cstThisSub = "Dictionary.Add"
|
|
Const cstSubArgs = "Key, Item"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Add = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch
|
|
If IsArray(Item) Then
|
|
If Not SF_Utils._ValidateArray(Item, "Item") Then GoTo Catch
|
|
Else
|
|
If Not SF_Utils._Validate(Item, "Item") Then GoTo Catch
|
|
End If
|
|
End If
|
|
If Key = Space(Len(Key)) Then GoTo CatchInvalid
|
|
|
|
Try:
|
|
_MapSize = _MapSize + 1
|
|
vItemMap = SF_Array._FindItem(MapKeys, Key, CaseSensitive, "ASC")
|
|
If vItemMap(0) Then GoTo CatchDuplicate ' Key exists already
|
|
lIndex = vItemMap(1)
|
|
MapKeys = SF_Array.Insert(MapKeys, lIndex, Key)
|
|
MapPositions = SF_Array.Insert(MapPositions, lIndex, _MapSize)
|
|
ReDim Preserve MapItems(1 To _MapSize)
|
|
MapItems(_MapSize) = Item
|
|
Add = True
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchDuplicate:
|
|
SF_Exception.RaiseFatal(DUPLICATEKEYERROR, "Key", Key)
|
|
GoTo Finally
|
|
CatchInvalid:
|
|
SF_Exception.RaiseFatal(INVALIDKEYERROR, "Key")
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.Add
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ConvertToArray() As Variant
|
|
''' Store the content of the dictionary in a 2-columns array:
|
|
''' Key stored in 1st column, Item stored in 2nd
|
|
''' Args:
|
|
''' Returns:
|
|
''' a zero-based 2D array(0:Count - 1, 0:1)
|
|
''' an empty array if the dictionary is empty
|
|
|
|
Dim vArray As Variant ' Return value
|
|
Dim sKey As String ' Tempry key
|
|
Dim vKeys As Variant ' Array of keys
|
|
Dim lCount As Long ' Counter
|
|
Const cstThisSub = "Dictionary.ConvertToArray"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
|
|
Try:
|
|
vArray = Array()
|
|
If Count = 0 Then
|
|
Else
|
|
ReDim vArray(0 To Count - 1, 0 To 1)
|
|
lCount = -1
|
|
vKeys = Keys
|
|
For Each sKey in vKeys
|
|
lCount = lCount + 1
|
|
vArray(lCount, 0) = sKey
|
|
vArray(lCount, 1) = Item(sKey)
|
|
Next sKey
|
|
End If
|
|
|
|
Finally:
|
|
ConvertToArray = vArray()
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ConvertToArray
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ConvertToJson(ByVal Optional Indent As Variant) As Variant
|
|
''' Convert the content of the dictionary to a JSON string
|
|
''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON
|
|
''' Limitations
|
|
''' Allowed item types: String, Boolean, numbers, Null and Empty
|
|
''' Arrays containing above types are allowed
|
|
''' Dates are converted into strings (not within arrays)
|
|
''' Other types are converted to their string representation (cfr. SF_String.Represent)
|
|
''' Args:
|
|
''' Indent:
|
|
''' If indent is a non-negative integer or string, then JSON array elements and object members will be pretty-printed with that indent level.
|
|
''' An indent level <= 0 will only insert newlines.
|
|
''' "", (the default) selects the most compact representation.
|
|
''' Using a positive integer indent indents that many spaces per level.
|
|
''' If indent is a string (such as Chr(9)), that string is used to indent each level.
|
|
''' Returns:
|
|
''' the JSON string
|
|
''' Example:
|
|
''' myDict.Add("p0", 12.5)
|
|
''' myDict.Add("p1", "a string àé""ê")
|
|
''' myDict.Add("p2", DateSerial(2020,9,28))
|
|
''' myDict.Add("p3", True)
|
|
''' myDict.Add("p4", Array(1,2,3))
|
|
''' MsgBox a.ConvertToJson() ' {"p0": 12.5, "p1": "a string \u00e0\u00e9\"\u00ea", "p2": "2020-09-28", "p3": true, "p4": [1, 2, 3]}
|
|
|
|
Dim sJson As String ' Return value
|
|
Dim vArray As Variant ' Array of property values
|
|
Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
|
|
Dim sKey As String ' Tempry key
|
|
Dim vKeys As Variant ' Array of keys
|
|
Dim vItem As Variant ' Tempry item
|
|
Dim iVarType As Integer ' Extended VarType
|
|
Dim lCount As Long ' Counter
|
|
Dim vIndent As Variant ' Python alias of Indent
|
|
Const cstPyHelper = "$" & "_SF_Dictionary__ConvertToJson"
|
|
|
|
Const cstThisSub = "Dictionary.ConvertToJson"
|
|
Const cstSubArgs = "[Indent=Null]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Indent) Or IsEmpty(INDENT) Then Indent = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Indent, "Indent", Array(V_STRING, V_NUMERIC)) Then GoTo Finally
|
|
End If
|
|
sJson = ""
|
|
|
|
Try:
|
|
vArray = Array()
|
|
If Count = 0 Then
|
|
Else
|
|
ReDim vArray(0 To Count - 1)
|
|
lCount = -1
|
|
vKeys = Keys
|
|
For Each sKey in vKeys
|
|
' Check item type
|
|
vItem = Item(sKey)
|
|
iVarType = SF_Utils._VarTypeExt(vItem)
|
|
Select Case iVarType
|
|
Case V_STRING, V_BOOLEAN, V_NUMERIC, V_NULL, V_EMPTY
|
|
Case V_DATE
|
|
vItem = SF_Utils._CDateToIso(vItem)
|
|
Case >= V_ARRAY
|
|
Case Else
|
|
vItem = SF_Utils._Repr(vItem)
|
|
End Select
|
|
' Build in each array entry a (Name, Value) pair
|
|
Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, vItem)
|
|
lCount = lCount + 1
|
|
Set vArray(lCount) = oPropertyValue
|
|
Next sKey
|
|
End If
|
|
|
|
'Pass array to Python script for the JSON conversion
|
|
With ScriptForge.SF_Session
|
|
vIndent = Indent
|
|
If VarType(Indent) = V_STRING Then
|
|
If Len(Indent) = 0 Then vIndent = Null
|
|
End If
|
|
sJson = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, vArray, vIndent)
|
|
End With
|
|
|
|
Finally:
|
|
ConvertToJson = sJson
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ConvertToJson
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ConvertToPropertyValues() As Variant
|
|
''' Store the content of the dictionary in an array of PropertyValues
|
|
''' Key stored in Name, Item stored in Value
|
|
''' Args:
|
|
''' Returns:
|
|
''' a zero-based 1D array(0:Count - 1). Each entry is a com.sun.star.beans.PropertyValue
|
|
''' Name: the key in the dictionary
|
|
''' Value:
|
|
''' Dates are converted to UNO dates
|
|
''' Empty arrays are replaced by Null
|
|
''' an empty array if the dictionary is empty
|
|
|
|
Dim vArray As Variant ' Return value
|
|
Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
|
|
Dim sKey As String ' Tempry key
|
|
Dim vKeys As Variant ' Array of keys
|
|
Dim lCount As Long ' Counter
|
|
Const cstThisSub = "Dictionary.ConvertToPropertyValues"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
|
|
Try:
|
|
vArray = Array()
|
|
If Count = 0 Then
|
|
Else
|
|
ReDim vArray(0 To Count - 1)
|
|
lCount = -1
|
|
vKeys = Keys
|
|
For Each sKey in vKeys
|
|
' Build in each array entry a (Name, Value) pair
|
|
Set oPropertyValue = SF_Utils._MakePropertyValue(sKey, Item(sKey))
|
|
lCount = lCount + 1
|
|
Set vArray(lCount) = oPropertyValue
|
|
Next sKey
|
|
End If
|
|
|
|
Finally:
|
|
ConvertToPropertyValues = vArray()
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ConvertToPropertyValues
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Exists(Optional ByVal Key As Variant) As Boolean
|
|
''' Determine if a key exists in the dictionary
|
|
''' Args:
|
|
''' Key: the key value (string)
|
|
''' Returns: True if key exists
|
|
''' Examples:
|
|
''' If myDict.Exists("SomeKey") Then ' don't add again
|
|
|
|
Dim vItem As Variant ' Item part in MapKeys
|
|
Const cstThisSub = "Dictionary.Exists"
|
|
Const cstSubArgs = "Key"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Exists = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
Exists = SF_Array.Contains(MapKeys, Key, CaseSensitive, SortOrder := "ASC")
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.Exists
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByVal Key As Variant _
|
|
) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Key: mandatory if PropertyName = "Item", ignored otherwise
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions:
|
|
''' ARGUMENTERROR The property does not exist
|
|
''' Examples:
|
|
''' myDict.GetProperty("Count")
|
|
|
|
Const cstThisSub = "Dictionary.GetProperty"
|
|
Const cstSubArgs = "PropertyName, [Key]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If IsMissing(Key) Or IsEmpty(Key) Then Key = ""
|
|
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, Key)
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ImportFromJson(Optional ByVal InputStr As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
) As Boolean
|
|
''' Adds the content of a Json string into the current dictionary
|
|
''' JSON = JavaScript Object Notation: https://en.wikipedia.org/wiki/JSON
|
|
''' Limitations
|
|
''' The JSON string may contain numbers, strings, booleans, null values and arrays containing those types
|
|
''' It must not contain JSON objects, i.e. sub-dictionaries
|
|
''' An attempt is made to convert strings to dates if they fit one of next patterns:
|
|
''' YYYY-MM-DD, HH:MM:SS or YYYY-MM-DD HH:MM:SS
|
|
''' Args:
|
|
''' InputStr: the json string to import
|
|
''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten
|
|
''' Default = False
|
|
''' Returns:
|
|
''' True if successful
|
|
''' Exceptions:
|
|
''' DUPLICATEKEYERROR: such a key exists already
|
|
''' INVALIDKEYERROR: zero-length string or only spaces
|
|
''' Example:
|
|
''' Dim s As String
|
|
''' s = "{'firstName': 'John','lastName': 'Smith','isAlive': true,'age': 66, 'birth': '1954-09-28 20:15:00'" _
|
|
''' & ",'address': {'streetAddress': '21 2nd Street','city': 'New York','state': 'NY','postalCode': '10021-3100'}" _
|
|
''' & ",'phoneNumbers': [{'type': 'home','number': '212 555-1234'},{'type': 'office','number': '646 555-4567'}]" _
|
|
''' & ",'children': ['Q','M','G','T'],'spouse': null}"
|
|
''' s = Replace(s, "'", """")
|
|
''' myDict.ImportFromJson(s, OverWrite := True)
|
|
''' ' The (sub)-dictionaries "address" and "phoneNumbers(0) and (1) are reduced to Empty
|
|
|
|
Dim bImport As Boolean ' Return value
|
|
Dim vArray As Variant ' JSON string converted to array
|
|
Dim vArrayEntry As Variant ' A single entry in vArray
|
|
Dim vKey As Variant ' Tempry key
|
|
Dim vItem As Variant ' Tempry item
|
|
Dim bExists As Boolean ' True when an entry exists
|
|
Dim dDate As Date ' String converted to Date
|
|
Const cstPyHelper = "$" & "_SF_Dictionary__ImportFromJson"
|
|
|
|
Const cstThisSub = "Dictionary.ImportFromJson"
|
|
Const cstSubArgs = "InputStr, [Overwrite=False]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bImport = False
|
|
|
|
Check:
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoYo Finally
|
|
End If
|
|
|
|
Try:
|
|
With ScriptForge.SF_Session
|
|
vArray = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper, InputStr)
|
|
End With
|
|
If Not IsArray(vArray) Then GoTo Finally ' Conversion error or nothing to do
|
|
|
|
' vArray = Array of subarrays = 2D DataArray (cfr. Calc)
|
|
For Each vArrayEntry In vArray
|
|
vKey = vArrayEntry(0)
|
|
If VarType(vKey) = V_STRING Then ' Else skip
|
|
vItem = vArrayEntry(1)
|
|
If Overwrite Then bExists = Exists(vKey) Else bExists = False
|
|
' When the item matches a date pattern, convert it to a date
|
|
If VarType(vItem) = V_STRING Then
|
|
dDate = SF_Utils._CStrToDate(vItem)
|
|
If dDate > -1 Then vItem = dDate
|
|
End If
|
|
If bExists Then
|
|
ReplaceItem(vKey, vItem)
|
|
Else
|
|
Add(vKey, vItem) ' Key controls are done in Add
|
|
End If
|
|
End If
|
|
Next vArrayEntry
|
|
|
|
bImport = True
|
|
|
|
Finally:
|
|
ImportFromJson = bImport
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ImportFromJson
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ImportFromPropertyValues(Optional ByVal PropertyValues As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
) As Boolean
|
|
''' Adds the content of an array of PropertyValues into the current dictionary
|
|
''' Names contain Keys, Values contain Items
|
|
''' UNO dates are replaced by Basic dates
|
|
''' Args:
|
|
''' PropertyValues: a zero-based 1D array. Each entry is a com.sun.star.beans.PropertyValue
|
|
''' Overwrite: when True entries with same name may exist in the dictionary and their values are overwritten
|
|
''' Default = False
|
|
''' Returns:
|
|
''' True if successful
|
|
''' Exceptions:
|
|
''' DUPLICATEKEYERROR: such a key exists already
|
|
''' INVALIDKEYERROR: zero-length string or only spaces
|
|
|
|
Dim bImport As Boolean ' Return value
|
|
Dim oPropertyValue As Object ' com.sun.star.beans.PropertyValue
|
|
Dim vItem As Variant ' Tempry item
|
|
Dim sObjectType As String ' UNO object type of dates
|
|
Dim bExists As Boolean ' True when an entry exists
|
|
Const cstThisSub = "Dictionary.ImportFromPropertyValues"
|
|
Const cstSubArgs = "PropertyValues, [Overwrite=False]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bImport = False
|
|
|
|
Check:
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If IsArray(PropertyValues) Then
|
|
If Not SF_Utils._ValidateArray(PropertyValues, "PropertyValues", 1, V_OBJECT, True) Then GoTo Finally
|
|
Else
|
|
If Not SF_Utils._Validate(PropertyValues, "PropertyValues", V_OBJECT) Then GoTo Finally
|
|
End If
|
|
If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoYo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Not IsArray(PropertyValues) Then PropertyValues = Array(PropertyValues)
|
|
With oPropertyValue
|
|
For Each oPropertyValue In PropertyValues
|
|
If Overwrite Then bExists = Exists(.Name) Else bExists = False
|
|
If SF_Session.UnoObjectType(oPropertyValue) = "com.sun.star.beans.PropertyValue" Then
|
|
If IsUnoStruct(.Value) Then
|
|
sObjectType = SF_Session.UnoObjectType(.Value)
|
|
Select Case sObjectType
|
|
Case "com.sun.star.util.DateTime" : vItem = CDateFromUnoDateTime(.Value)
|
|
Case "com.sun.star.util.Date" : vItem = CDateFromUnoDate(.Value)
|
|
Case "com.sun.star.util.Time" : vItem = CDateFromUnoTime(.Value)
|
|
Case Else : vItem = .Value
|
|
End Select
|
|
Else
|
|
vItem = .Value
|
|
End If
|
|
If bExists Then
|
|
ReplaceItem(.Name, vItem)
|
|
Else
|
|
Add(.Name, vItem) ' Key controls are done in Add
|
|
End If
|
|
End If
|
|
Next oPropertyValue
|
|
End With
|
|
bImport = True
|
|
|
|
Finally:
|
|
ImportFromPropertyValues = bImport
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ImportFromPropertyValues
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list or methods of the Dictionary class as an array
|
|
|
|
Methods = Array( _
|
|
"Add" _
|
|
, "ConvertToArray" _
|
|
, "ConvertToJson" _
|
|
, "ConvertToPropertyValues" _
|
|
, "Exists" _
|
|
, "ImportFromJson" _
|
|
, "ImportFromPropertyValues" _
|
|
, "Remove" _
|
|
, "RemoveAll" _
|
|
, "ReplaceItem" _
|
|
, "ReplaceKey" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_Dictionary.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Dictionary class as an array
|
|
|
|
Properties = Array( _
|
|
"Count" _
|
|
, "Item" _
|
|
, "Items" _
|
|
, "Keys" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_Dictionary.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Remove(Optional ByVal Key As Variant) As Boolean
|
|
''' Remove an existing dictionary entry based on its key
|
|
''' Args:
|
|
''' Key: must exist in the dictionary
|
|
''' Returns: True if successful
|
|
''' Exceptions:
|
|
''' UNKNOWNKEYERROR: the key does not exist
|
|
''' Examples:
|
|
''' myDict.Remove("OldKey")
|
|
|
|
Dim vItemMap As Variant ' Output of SF_Array._FindItem
|
|
Dim lIndex As Long ' Index in MapKeys and MapPositions
|
|
Const cstThisSub = "Dictionary.Remove"
|
|
Const cstSubArgs = "Key"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Remove = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch
|
|
End If
|
|
Try:
|
|
vItemMap = SF_Array._FindItem(MapKeys, Key, CaseSensitive, "ASC")
|
|
If Not vItemMap(0) Then GoTo CatchUnknown
|
|
lIndex = vItemMap(1)
|
|
MapKeys(lIndex) = ""
|
|
MapKeys = SF_Array.TrimArray(MapKeys)
|
|
Erase MapItems(MapPositions(lIndex))
|
|
MapPositions(lIndex) = Null
|
|
MapPositions = SF_Array.TrimArray(MapPositions)
|
|
_MapRemoved = _MapRemoved + 1
|
|
Remove = True
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchUnknown:
|
|
SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.Remove
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function RemoveAll() As Boolean
|
|
''' Remove all the entries from the dictionary
|
|
''' Args:
|
|
''' Returns: True if successful
|
|
''' Examples:
|
|
''' myDict.RemoveAll()
|
|
|
|
Dim vKeys As Variant ' Array of keys
|
|
Dim sColl As String ' A collection key in MapKeys
|
|
Const cstThisSub = "Dictionary.RemoveAll"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
RemoveAll = False
|
|
|
|
Check:
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
|
|
Try:
|
|
vKeys = Keys
|
|
For Each sColl In vKeys
|
|
Remove(sColl)
|
|
Next sColl
|
|
Erase MapKeys
|
|
Erase MapItems
|
|
' Make dictionary ready to receive new entries
|
|
Call Class_Initialize()
|
|
RemoveAll = True
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.RemoveAll
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ReplaceItem(Optional ByVal Key As Variant _
|
|
, Optional ByVal Value As Variant _
|
|
) As Boolean
|
|
''' Replace the item value
|
|
''' Args:
|
|
''' Key: must exist in the dictionary
|
|
''' Returns: True if successful
|
|
''' Exceptions:
|
|
''' UNKNOWNKEYERROR: the old key does not exist
|
|
''' Examples:
|
|
''' myDict.ReplaceItem("Key", NewValue)
|
|
|
|
Dim vItemMap As Variant ' Output of SF_Array._FindItem
|
|
Dim lIndex As Long ' Entry in the MapItems array
|
|
Const cstThisSub = "Dictionary.ReplaceItem"
|
|
Const cstSubArgs = "Key, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
ReplaceItem = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch
|
|
If IsArray(Value) Then
|
|
If Not SF_Utils._ValidateArray(Value, "Value") Then GoTo Catch
|
|
Else
|
|
If Not SF_Utils._Validate(Value, "Value") Then GoTo Catch
|
|
End If
|
|
End If
|
|
|
|
Try:
|
|
' Find entry in MapItems and update it with the new value
|
|
vItemMap = SF_Array._FindItem(MapKeys, Key, CaseSensitive, "ASC")
|
|
If Not vItemMap(0) Then GoTo CatchUnknown
|
|
lIndex = vItemMap(1)
|
|
MapItems(MapPositions(lIndex)) = Value
|
|
ReplaceItem = True
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchUnknown:
|
|
SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ReplaceItem
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ReplaceKey(Optional ByVal Key As Variant _
|
|
, Optional ByVal Value As Variant _
|
|
) As Boolean
|
|
''' Replace existing key
|
|
''' Args:
|
|
''' Key: must exist in the dictionary
|
|
''' Value: must not exist in the dictionary
|
|
''' Returns: True if successful
|
|
''' Exceptions:
|
|
''' UNKNOWNKEYERROR: the old key does not exist
|
|
''' DUPLICATEKEYERROR: the new key exists
|
|
''' Examples:
|
|
''' myDict.ReplaceKey("OldKey", "NewKey")
|
|
|
|
Const cstThisSub = "Dictionary.ReplaceKey"
|
|
Const cstSubArgs = "Key, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
ReplaceKey = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(Key, "Key", V_STRING) Then GoTo Catch
|
|
If Not SF_Utils._Validate(Value, "Value", V_STRING) Then GoTo Catch
|
|
End If
|
|
If Not Exists(Key) Then GoTo CatchUnknown
|
|
If Value = Space(Len(Value)) Then GoTo CatchInvalid
|
|
If Exists(Value) Then GoTo CatchDuplicate
|
|
|
|
Try:
|
|
' Remove the Key entry and create a new one
|
|
Add(Value, Item(Key))
|
|
Remove(Key)
|
|
ReplaceKey = True
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchUnknown:
|
|
SF_Exception.RaiseFatal(UNKNOWNKEYERROR, "Key", Key)
|
|
GoTo Finally
|
|
CatchDuplicate:
|
|
SF_Exception.RaiseFatal(DUPLICATEKEYERROR, "Value", Value)
|
|
GoTo Finally
|
|
CatchInvalid:
|
|
SF_Exception.RaiseFatal(INVALIDKEYERROR, "Key")
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary.ReplaceKey
|
|
|
|
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 = "Dictionary.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_Dictionary.SetProperty
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _PropertyGet(Optional ByVal psProperty As String _
|
|
, Optional pvKey As Variant _
|
|
)
|
|
''' Return the named property
|
|
''' Args:
|
|
''' psProperty: the name of the property
|
|
''' pvKey: the key to retrieve, numeric or string
|
|
|
|
Dim vItemMap As Variant ' Output of SF_Array._FindItem
|
|
Dim lIndex As Long ' Entry in the MapItems array
|
|
Dim vArray As Variant ' To get Keys or Items
|
|
Dim i As Long
|
|
Dim cstThisSub As String
|
|
Dim cstSubArgs As String
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
cstThisSub = "SF_Dictionary.get" & psProperty
|
|
If IsMissing(pvKey) Then cstSubArgs = "" Else cstSubArgs = "[Key]"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
|
|
Select Case UCase(psProperty)
|
|
Case UCase("Count")
|
|
_PropertyGet = _MapSize - _MapRemoved
|
|
Case UCase("Item")
|
|
If Not SF_Utils._Validate(pvKey, "Key", V_STRING) Then GoTo Catch
|
|
vItemMap = SF_Array._FindItem(MapKeys, pvKey, CaseSensitive, "ASC")
|
|
lIndex = vItemMap(1)
|
|
If vItemMap(0) Then _PropertyGet = MapItems(MapPositions(lIndex)) Else _PropertyGet = Empty
|
|
Case UCase("Keys"), UCase("Items")
|
|
vArray = Array()
|
|
If UBound(MapKeys) >= 0 Then
|
|
ReDim vArray(0 To UBound(MapKeys))
|
|
For i = 0 To UBound(MapKeys)
|
|
Select Case UCase(psProperty)
|
|
Case "KEYS" : vArray(i) = MapKeys(i)
|
|
Case "ITEMS" : vArray(i) = MapItems(MapPositions(i))
|
|
End Select
|
|
Next i
|
|
End If
|
|
_PropertyGet = vArray
|
|
End Select
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_Dictionary._PropertyGet
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Repr() As String
|
|
''' Convert the Dictionary instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
|
''' Args:
|
|
''' Return:
|
|
''' "[Dictionary] (key1:value1, key2:value2, ...)
|
|
|
|
Dim sDict As String ' Return value
|
|
Dim vKeys As Variant ' Array of keys
|
|
Dim sKey As String ' Tempry key
|
|
Dim vItem As Variant ' Tempry item
|
|
Const cstDictEmpty = "[Dictionary] ()"
|
|
Const cstDict = "[Dictionary]"
|
|
Const cstMaxLength = 50 ' Maximum length for items
|
|
Const cstSeparator = ", "
|
|
|
|
_Repr = ""
|
|
|
|
If Count = 0 Then
|
|
sDict = cstDictEmpty
|
|
Else
|
|
sDict = cstDict & " ("
|
|
vKeys = Keys
|
|
For Each sKey in vKeys
|
|
vItem = Item(sKey)
|
|
sDict = sDict & sKey & ":" & SF_Utils._Repr(vItem, cstMaxLength) & cstSeparator
|
|
Next sKey
|
|
sDict = Left(sDict, Len(sDict) - Len(cstSeparator)) & ")" ' Suppress last comma
|
|
End If
|
|
|
|
_Repr = sDict
|
|
|
|
End Function ' ScriptForge.SF_Dictionary._Repr
|
|
|
|
REM ============================================ END OF SCRIPTFORGE.SF_DICTIONARY
|
|
</script:module> |