953 lines
36 KiB
Java
953 lines
36 KiB
Java
<?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 a not case-sensitive string
|
|
''' Items may be of any type
|
|
''' Keys, items can be retrieved, counted, etc.
|
|
'''
|
|
''' The implementation is based on
|
|
''' - one collection mapping keys and entries in the array
|
|
''' - one 1-column array: key + data
|
|
'''
|
|
''' Why a Dictionary class beside the builtin Collection class ?
|
|
''' A standard Basic collection does not support the retrieval of the keys
|
|
''' Additionally it may contain only simple data (strings, numbers, ...)
|
|
'''
|
|
''' Service instantiation example:
|
|
''' Dim myDict As Variant
|
|
''' myDict = CreateScriptService("Dictionary") ' Once per dictionary
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" ' Key exists already
|
|
Const UNKNOWNKEYERROR = "UNKNOWNKEYERROR" ' Key not found
|
|
Const INVALIDKEYERROR = "INVALIDKEYERROR" ' Key contains only spaces
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
' Defines an entry in the MapItems array
|
|
Type ItemMap
|
|
Key As String
|
|
Value As Variant
|
|
End Type
|
|
|
|
Private [Me] As Object
|
|
Private [_Parent] As Object
|
|
Private ObjectType As String ' Must be "DICTIONARY"
|
|
Private ServiceName As String
|
|
Private MapKeys As Variant ' To retain the original keys
|
|
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"
|
|
Set MapKeys = New Collection
|
|
Set 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 oItemMap As ItemMap ' New entry in the MapItems array
|
|
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
|
|
If Exists(Key) Then GoTo CatchDuplicate
|
|
|
|
Try:
|
|
_MapSize = _MapSize + 1
|
|
MapKeys.Add(_MapSize, Key)
|
|
oItemMap.Key = Key
|
|
oItemMap.Value = Item
|
|
ReDim Preserve MapItems(1 To _MapSize)
|
|
MapItems(_MapSize) = oItemMap
|
|
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:
|
|
' Dirty but preferred to go through whole collection
|
|
On Local Error GoTo NotFound
|
|
vItem = MapKeys(Key)
|
|
NotFound:
|
|
Exists = ( Not ( Err = 5 ) And vItem > 0 )
|
|
On Local Error GoTo 0
|
|
|
|
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 lIndex As Long ' To remove entry in the MapItems array
|
|
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
|
|
If Not Exists(Key) Then GoTo CatchUnknown
|
|
|
|
Try:
|
|
lIndex = MapKeys.Item(Key)
|
|
MapKeys.Remove(Key)
|
|
Erase MapItems(lIndex) ' Is now Empty
|
|
_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
|
|
MapKeys.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 oItemMap As ItemMap ' Content to update in the MapItems array
|
|
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 Not SF_Utils._Validate(Value, "Value") Then GoTo Catch
|
|
End If
|
|
If Not Exists(Key) Then GoTo CatchUnknown
|
|
|
|
Try:
|
|
' Find entry in MapItems and update it with the new value
|
|
lIndex = MapKeys.Item(Key)
|
|
oItemMap = MapItems(lIndex)
|
|
oItemMap.Value = 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")
|
|
|
|
Dim oItemMap As ItemMap ' Content to update in the MapItems array
|
|
Dim lIndex As Long ' Entry in the MapItems array
|
|
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 in MapKeys
|
|
With MapKeys
|
|
lIndex = .Item(Key)
|
|
.Remove(Key)
|
|
.Add(lIndex, Value)
|
|
End With
|
|
oItemMap = MapItems(lIndex)
|
|
oItemMap.Key = Value
|
|
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 ' Entry in the MapItems array
|
|
Dim vArray As Variant ' To get Keys or Values
|
|
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
|
|
If Exists(pvKey) Then _PropertyGet = MapItems(MapKeys(pvKey)).Value Else _PropertyGet = Empty
|
|
Case UCase("Keys"), UCase("Items")
|
|
vArray = Array()
|
|
If _MapSize - _MapRemoved - 1 >= 0 Then
|
|
ReDim vArray(0 To (_MapSize - _MapRemoved - 1))
|
|
i = -1
|
|
For each vItemMap In MapItems()
|
|
If Not IsEmpty(vItemMap) Then
|
|
i = i + 1
|
|
If UCase(psProperty) = "KEYS" Then vArray(i) = vItemMap.Key Else vArray(i) = vItemMap.Value
|
|
End If
|
|
Next vItemMap
|
|
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>
|