diff options
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/scriptforge/SF_Dictionary.xba | 959 |
1 files changed, 959 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_Dictionary.xba b/wizards/source/scriptforge/SF_Dictionary.xba new file mode 100644 index 000000000..22ada5148 --- /dev/null +++ b/wizards/source/scriptforge/SF_Dictionary.xba @@ -0,0 +1,959 @@ +<?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 +''' +''' 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 + +' 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 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 + 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>
\ No newline at end of file |