𝚃𝚑𝚒𝚜 𝚒𝚜 𝚝𝚑𝚎 𝚏𝚒𝚛𝚜𝚝 𝚟𝚎𝚛𝚜𝚒𝚘𝚗 𝚘𝚏 𝚊 𝙹SON 𝚕𝚒𝚋𝚛𝚊𝚛𝚢, 𝚠𝚑𝚒𝚌𝚑 𝚠𝚊𝚜 𝚊𝚍𝚖𝚒𝚝𝚝𝚎𝚍𝚕𝚢 𝚍𝚎𝚜𝚒𝚐𝚗𝚎𝚍 𝚊𝚗𝚍 𝚌𝚛𝚎𝚊𝚝𝚎𝚍 𝚠𝚒𝚝𝚑 𝚝𝚑𝚎 𝚑𝚎𝚕𝚙 𝚘𝚏 𝙰𝙸 𝚒𝚗 𝚛𝚎𝚌𝚘𝚛𝚍 𝚝𝚒𝚖𝚎.
This JSON Library provides functions to parse, manipulate, generate, and
repair JSON data within PowerBASIC. It supports handling JSON objects, arrays, strings, numbers, booleans, and null values. The library internally represents JSON documents as a tree of nodes, each identified by a numeric ID. Multiple documents can be managed simultaneously via handles.
𝚃𝚑𝚎 𝚏𝚎𝚊𝚝𝚞𝚛𝚎𝚜 𝚊𝚛𝚎 𝚊𝚕𝚕 𝚞𝚗𝚝𝚎𝚜𝚝𝚎𝚍, 𝚜𝚘 𝙸 𝚠𝚘𝚞𝚕𝚍 𝚊𝚙𝚙𝚛𝚎𝚌𝚒𝚊𝚝𝚎 𝚊𝚗𝚢 𝚏𝚎𝚎𝚍𝚋𝚊𝚌𝚔 𝚢𝚘𝚞 𝚖𝚊𝚢 𝚑𝚊𝚟𝚎. 𝙾𝚝𝚑𝚎𝚛𝚠𝚒𝚜𝚎, 𝚎𝚗𝚓𝚘𝚢!
#𝙹𝚘𝚝𝚜𝚘𝚗𝙻𝚒𝚋𝚛𝚊𝚛𝚢 #𝙰𝙸𝙳𝚎𝚜𝚒𝚐𝚗 #𝙵𝚎𝚎𝚍𝚋𝚊𝚌𝚔𝚆𝚎𝚕𝚌𝚘𝚖𝚎 #𝙾𝚙𝚎𝚗𝚂𝚘𝚞𝚛𝚌𝚎 #𝙸𝚗𝚗𝚘𝚟𝚊𝚝𝚒𝚘𝚗
'#################################################################################
'
'#################################################################################
#INCLUDE THIS ONCE
'------------------------------------------------------------------------------
' JSON Library Overview
'------------------------------------------------------------------------------
' This JSON Library provides functions to parse, manipulate, generate, and
' repair JSON data within PowerBASIC. It supports handling JSON objects, arrays,
' strings, numbers, booleans, and null values. The library internally represents
' JSON documents as a tree of nodes, each identified by a numeric ID. Multiple
' documents can be managed simultaneously via handles.
'
' Global Data Structures:
' - gNodeType(), gNodeParent(), gNodeName(), gNodeValue(), gNodeChildren():
' Arrays used to store all nodes in a tree-like structure.
' - gDocRoot(), gDocInUse(), gDocOriginalText():
' Arrays used to manage multiple JSON documents, their root nodes,
' usage flags, and original input text.
'
' Initialization and Cleanup:
' - JSON_Init():
' Initializes global arrays and counters. Must be called before using any other function.
' Description:
' JSON_Init is typically called once at the start of your program before you
' perform any JSON operations. Its purpose is to set up global arrays,
' counters, and other necessary initialization steps.
' You do not need to call JSON_Init before each new parse;
' rather, call it once at the beginning of your program or the section
' where you intend to handle JSON data. After that, you can parse multiple JSON
' strings without reinitializing, as long as you do not call JSON_Shutdown
' in between.
' - JSON_Shutdown():
' Frees all resources, resets global arrays and counters. Call after all JSON operations are done.
'
'
' Parsing and Document Handling:
' - JSON_ParseString(jsonText AS STRING) AS LONG:
' Parses a full JSON string into an internal node tree and returns a doc handle.
' On success, returns a handle (>0) that can be used with other functions.
' On error, returns 0 and sets gLastJSONError/gLastJSONErrorMsg.
'
' - JSON_FreeHandle(docHandle AS LONG) AS LONG:
' Frees all resources associated with the given JSON document.
' Returns 0 on success, non-0 on error.
'
' - JSON_DuplicateHandle(docHandle AS LONG) AS LONG:
' Creates a complete copy of an existing JSON document.
' Returns a new doc handle on success, or 0 on error.
'
'
' Querying and Accessing Data:
' These functions navigate JSON structures using "paths". A path is a string
' specifying keys and indexes, e.g. "root.items[0].name".
'
' - JSON_GetValueTypeByPath(docHandle AS LONG, path AS STRING) AS LONG:
' Returns the type of the JSON value at the given path:
' %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY, %JSON_TYPE_STRING, %JSON_TYPE_NUMBER,
' %JSON_TYPE_BOOL, %JSON_TYPE_NULL, or 0 if error.
'
' - JSON_GetStringByPath(docHandle AS LONG, path AS STRING) AS STRING:
' Returns the value at the path as a string, converting numbers, bools, etc.
' Returns "" on error or if not convertible.
'
' - JSON_GetNumberByPath(docHandle AS LONG, path AS STRING) AS DOUBLE:
' Returns the value at the path as a DOUBLE. Converts bools, tries to parse strings.
' Returns 0.0 if error.
'
' - JSON_GetBooleanByPath(docHandle AS LONG, path AS STRING) AS LONG:
' Returns 1=true,0=false, or -1 if error. Converts from various types.
'
' - JSON_GetNullByPath(docHandle AS LONG, path AS STRING) AS LONG:
' Returns 1 if the element is null, 0 otherwise.
'
' Object-Specific Queries:
' - JSON_ObjectGetKeysCount(docHandle AS LONG, path AS STRING) AS LONG:
' Returns the number of keys in the object at path, or -1 if error.
'
' - JSON_ObjectGetKeyNameByIndex(docHandle AS LONG, path AS STRING, keyIndex AS LONG) AS STRING:
' Returns the key name at the specified 0-based index in the object.
' Returns "" if error.
'
' Array-Specific Queries:
' - JSON_ArrayGetCount(docHandle AS LONG, path AS STRING) AS LONG:
' Returns the number of elements in the array, or -1 if error.
'
' - JSON_ArrayGetStringElement(docHandle AS LONG, path AS STRING, elementIndex AS LONG) AS STRING:
' Returns the array element at elementIndex as a string, converting as needed.
' Returns "" if error.
'
'
' Modification and Generation:
' Creating New Documents:
' - JSON_CreateObject() AS LONG:
' Creates a new empty JSON object document. Returns doc handle or 0 if error.
'
' - JSON_CreateArray() AS LONG:
' Creates a new empty JSON array document. Returns doc handle or 0 if error.
'
' Modifying Objects:
' - JSON_ObjectSetStringByPath(docHandle AS LONG, path AS STRING, value AS STRING) AS LONG:
' Sets or updates a string value at the specified key in an object.
' If key doesn't exist, creates it. Returns 0=success.
'
' - JSON_ObjectSetNumberByPath(docHandle AS LONG, path AS STRING, value AS DOUBLE) AS LONG:
' Sets/updates a number value at the key. Creates the key if it doesn't exist.
'
' - JSON_ObjectSetBooleanByPath(docHandle AS LONG, path AS STRING, value AS LONG) AS LONG:
' Sets/updates a boolean (0=false,1=true).
'
' - JSON_ObjectSetNullByPath(docHandle AS LONG, path AS STRING) AS LONG:
' Sets a null value at the specified key.
'
' - JSON_ObjectRemoveKey(docHandle AS LONG, path AS STRING) AS LONG:
' Removes a key from the object. Returns 0=success.
'
' Modifying Arrays:
' - JSON_ArrayAppendString(docHandle AS LONG, path AS STRING, value AS STRING) AS LONG:
' Appends a string element to the array.
'
' - JSON_ArrayAppendNumber(docHandle AS LONG, path AS STRING, value AS DOUBLE) AS LONG:
' Appends a number element to the array.
'
' - JSON_ArrayAppendBoolean(docHandle AS LONG, path AS STRING, value AS LONG) AS LONG:
' Appends a boolean element.
'
' - JSON_ArrayAppendNull(docHandle AS LONG, path AS STRING) AS LONG:
' Appends a null element.
'
' - JSON_ArrayInsertElement(docHandle AS LONG, path AS STRING, elementIndex AS LONG, elementHandle AS LONG) AS LONG:
' Inserts an existing node into the array at the specified index.
'
' - JSON_ArrayRemoveElement(docHandle AS LONG, path AS STRING, elementIndex AS LONG) AS LONG:
' Removes the element at the given index.
'
'
' Validation & Repair:
' - JSON_Validate(docHandle AS LONG) AS LONG:
' Checks if the structure is valid. Returns 0 if valid, else error code.
'
' - JSON_Repair(docHandle AS LONG) AS LONG:
' Attempts to repair known issues (e.g., orphaned nodes, duplicate keys, non-standard number formats).
' Returns 0 if repairs succeeded or no repairs needed.
'
'
' Utility Functions:
' - JSON_ToString(docHandle AS LONG, prettyPrint AS LONG) AS STRING:
' Serializes the document back to a JSON string. If prettyPrint=1, outputs nicely formatted JSON.
' Returns "" if error.
'
' - JSON_GetLastError() AS LONG:
' Returns the last error code.
'
' - JSON_GetLastErrorMsg() AS STRING:
' Returns the last error message as a string.
'
'
' Error Handling:
' gLastJSONError and gLastJSONErrorMsg are set whenever an error occurs.
' Use JSON_GetLastError and JSON_GetLastErrorMsg to retrieve error details.
'
'
' Summary:
' 1. Call JSON_Init.
' 2. Parse or create a JSON doc using JSON_ParseString, JSON_CreateObject, or JSON_CreateArray.
' 3. Use get/set functions to query or modify data.
' 4. Validate and optionally repair the structure if needed.
' 5. Convert back to string using JSON_ToString.
' 6. Free handles with JSON_FreeHandle when done.
' 7. Call JSON_Shutdown at the end.
'
' This library simplifies working with JSON data in PowerBASIC, allowing structured
' access and manipulation of JSON documents entirely in memory.
'------------------------------------------------------------------------------
'FUNCTION PBMAIN() AS LONG
' ' Initialize the JSON environment
' JSON_Init
' ' Sample JSON string
' ' This represents a simple object with nested data:
' ' {
' ' "name": "Alice",
' ' "age": 30,
' ' "address": {
' ' "city": "Wonderland",
' ' "zip": "12345"
' ' }
' ' }
' LOCAL jsonText AS STRING
' jsonText = "{""name"":""Alice"",""age"":30,""address"":{""city"":""Wonderland"",""zip"":""12345""}}"
' ' Parse the JSON text
' LOCAL docHandle AS LONG
' docHandle = JSON_ParseString(jsonText)
' IF docHandle=0 THEN
' PRINT "Error parsing JSON: " + JSON_GetLastErrorMsg()
' GOTO Cleanup
' END IF
' ' Access some data
' ' Get the name
' LOCAL personName AS STRING
' personName = JSON_GetStringByPath(docHandle, "name")
' IF JSON_GetLastError<>0 THEN
' PRINT "Error getting name: " + JSON_GetLastErrorMsg()
' ELSE
' PRINT "Name: "; personName
' END IF
' ' Get the age
' LOCAL age AS DOUBLE
' age = JSON_GetNumberByPath(docHandle, "age")
' IF JSON_GetLastError<>0 THEN
' PRINT "Error getting age: " + JSON_GetLastErrorMsg()
' ELSE
' PRINT "Age: "; STR$(age)
' END IF
' ' Get the city
' LOCAL city AS STRING
' city = JSON_GetStringByPath(docHandle, "address.city")
' IF JSON_GetLastError<>0 THEN
' PRINT "Error getting city: " + JSON_GetLastErrorMsg()
' ELSE
' PRINT "City: "; city
' END IF
' ' Convert back to JSON string (pretty print)
' LOCAL prettyJson AS STRING
' prettyJson = JSON_ToString(docHandle, 1)
' IF JSON_GetLastError=0 THEN
' PRINT "Pretty Printed JSON:"
' PRINT prettyJson
' ELSE
' PRINT "Error converting to string: " + JSON_GetLastErrorMsg()
' END IF
'Cleanup:
' ' Free the document handle
' IF docHandle<>0 THEN
' JSON_FreeHandle(docHandle)
' END IF
' ' Shutdown the JSON environment
' JSON_Shutdown
' PRINT "Press any key to exit..."
' WAITKEY$
'END FUNCTION
'-------------------------------------------------------------------------------
' Global variables and constants
GLOBAL gLastJSONError AS LONG
GLOBAL gLastJSONErrorMsg AS STRING
GLOBAL gNodeCount AS LONG
GLOBAL gNodeType() AS LONG
GLOBAL gNodeParent() AS LONG
GLOBAL gNodeName() AS STRING
GLOBAL gNodeValue() AS STRING
GLOBAL gNodeChildren() AS STRING
GLOBAL gDocOriginalText() AS STRING
GLOBAL gDocCount AS LONG
GLOBAL gDocRoot() AS LONG
GLOBAL gDocInUse() AS LONG
' Node type constants
%JSON_TYPE_OBJECT = 1
%JSON_TYPE_ARRAY = 2
%JSON_TYPE_STRING = 3
%JSON_TYPE_NUMBER = 4
%JSON_TYPE_BOOL = 5
%JSON_TYPE_NULL = 6
' Error codes
%JSON_ERR_NONE = 0
%JSON_ERR_PARSE = 1
%JSON_ERR_NOTFOUND = 2
%JSON_ERR_TYPE = 3
%JSON_ERR_MEMORY = 4
%JSON_ERR_INVALID = 5
'-------------------------------------------------------------------------------
SUB JSON_Init
' Clear error states
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Initialize node arrays and counters
gNodeCount = 0
REDIM gDocOriginalText(1 TO 10)
REDIM gNodeType(1 TO 100)
REDIM gNodeParent(1 TO 100)
REDIM gNodeName(1 TO 100)
REDIM gNodeValue(1 TO 100)
REDIM gNodeChildren(1 TO 100)
' Initialize document arrays and counters
gDocCount = 0
REDIM gDocRoot(1 TO 10)
REDIM gDocInUse(1 TO 10)
' Set all arrays to default values
' For numeric arrays, default is 0, which is fine for now
' For string arrays, default is empty string ""
' No return value, but we can consider this successful initialization
END SUB
'-------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' SUB NAME: Node_EnsureCapacity
'
' PURPOSE:
' Ensures that the global node arrays have enough capacity for at least one
' more node. If not, it expands their size using REDIM PRESERVE.
'
' PARAMETERS:
' None
'
' RETURN VALUE:
' None
'
' GLOBAL VARIABLES:
' Uses gNodeCount, gNodeType(), gNodeParent(), gNodeName(), gNodeValue(), gNodeChildren()
' Can set gLastJSONError and gLastJSONErrorMsg if memory allocation fails.
'
' LOGIC:
' 1. Check the current UBOUND of the node arrays.
' 2. If gNodeCount >= UBOUND, we need to expand.
' 3. Attempt to REDIM PRESERVE the arrays to a larger size.
' 4. If REDIM fails, set error variables accordingly.
'
' NOTES:
' This helper is used by Node_Create and possibly other functions that add new nodes.
'------------------------------------------------------------------------------
SUB Node_EnsureCapacity
LOCAL uboundN AS LONG
LOCAL newSize AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
uboundN = UBOUND(gNodeType)
' If current count is equal or exceeds the UBOUND, we need to expand
IF gNodeCount >= uboundN THEN
newSize = uboundN * 2
IF newSize < (uboundN + 100) THEN
newSize = uboundN + 100
END IF
ON ERROR GOTO MemError
REDIM PRESERVE gNodeType(1 TO newSize)
REDIM PRESERVE gNodeParent(1 TO newSize)
REDIM PRESERVE gNodeName(1 TO newSize)
REDIM PRESERVE gNodeValue(1 TO newSize)
REDIM PRESERVE gNodeChildren(1 TO newSize)
ON ERROR GOTO 0
END IF
EXIT SUB
MemError:
gLastJSONError = %JSON_ERR_MEMORY
gLastJSONErrorMsg = "Failed to allocate memory during Node_EnsureCapacity."
END SUB
'-------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ParseString
'
' PURPOSE:
' Parses a JSON document from a single ANSI STRING into an internal node tree.
' Returns a doc handle.
'
' PARAMETERS:
' jsonText AS STRING
'
' RETURN VALUE:
' LONG - The document handle (>=1) on success, or 0 if an error occurs.
'
' GLOBAL VARIABLES:
' Uses gDocCount, gDocRoot(), gDocInUse(), gNode* arrays, gDocOriginalText().
' Sets gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Clear error variables.
' 2. Perform a lexical scan and parse the JSON text into a tree of nodes.
' - Identify the root element (object or array).
' - Recursively parse objects, arrays, and values.
' - Use Node_Create to build nodes.
' 3. If successful, increment gDocCount, store root node, mark gDocInUse(gDocCount)=1,
' and store jsonText in gDocOriginalText(gDocCount).
' 4. Return gDocCount as the document handle.
' 5. On any error, set gLastJSONError/gLastJSONErrorMsg and return 0.
'
' NOTES:
' This example assumes the existence of helper functions:
' - ParseValue(jsonText, pos) which returns a nodeID and advances pos.
' - ParseObject, ParseArray, ParseString, ParseNumber, ParseBoolean, ParseNull
' which handle respective JSON constructs.
' The parsing logic is non-trivial. Here we show a skeleton for demonstration.
' In a real implementation, these helpers must be defined.
'------------------------------------------------------------------------------
FUNCTION JSON_ParseString (BYVAL jsonText AS STRING) AS LONG
LOCAL rootNodeID AS LONG
LOCAL PS AS LONG
LOCAL nodeType AS LONG
' Clear previous error states
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Trim leading/trailing spaces
jsonText = TRIM$(jsonText)
' If empty, error out
IF LEN(jsonText)=0 THEN
gLastJSONError = %JSON_ERR_PARSE
gLastJSONErrorMsg = "Empty JSON string."
FUNCTION = 0
EXIT FUNCTION
END IF
' PS will track current parsing position
PS = 1
' Skip initial whitespace if any
CALL SkipWhitespace(jsonText, PS)
' Determine root element type by checking first non-whitespace char
SELECT CASE MID$(jsonText, PS, 1)
CASE "{"
' Parse object
rootNodeID = ParseObject(jsonText, PS, -1)
CASE "["
' Parse array
rootNodeID = ParseArray(jsonText, PS, -1)
CASE ELSE
' JSON should start with { or [ for a valid top-level object/array
' Some APIs return a single value (e.g., number, bool) - we could handle that:
rootNodeID = ParseValue(jsonText, PS, -1)
END SELECT
' If rootNodeID=0, parsing failed and error is set
IF rootNodeID=0 THEN
' gLastJSONError/gLastJSONErrorMsg set by parsing functions
FUNCTION = 0
EXIT FUNCTION
END IF
' After parsing root, skip whitespace and ensure we've consumed all text
CALL SkipWhitespace(jsonText, PS)
IF PS <= LEN(jsonText) THEN
' Extra characters after valid JSON
gLastJSONError = %JSON_ERR_PARSE
gLastJSONErrorMsg = "Extra characters after valid JSON structure."
' Free the created subtree
CALL Node_FreeSubtree(rootNodeID)
FUNCTION = 0
EXIT FUNCTION
END IF
' Successfully parsed the JSON
INCR gDocCount
' Expand doc arrays if needed
IF gDocCount > UBOUND(gDocRoot) THEN
LOCAL oldUbound AS LONG, newSize AS LONG
oldUbound = UBOUND(gDocRoot)
newSize = oldUbound * 2
IF newSize < oldUbound + 10 THEN newSize = oldUbound + 10
ON ERROR GOTO MemError
REDIM PRESERVE gDocRoot(1 TO newSize)
REDIM PRESERVE gDocInUse(1 TO newSize)
REDIM PRESERVE gDocOriginalText(1 TO newSize)
ON ERROR GOTO 0
END IF
gDocRoot(gDocCount) = rootNodeID
gDocInUse(gDocCount) = 1
gDocOriginalText(gDocCount) = jsonText
FUNCTION = gDocCount
EXIT FUNCTION
MemError:
gLastJSONError = %JSON_ERR_MEMORY
gLastJSONErrorMsg = "Failed to allocate memory for document arrays in JSON_ParseString."
' Free created subtree
CALL Node_FreeSubtree(rootNodeID)
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' Below are stubs for the helper functions referenced above:
' In a real implementation, these must be fully defined to parse JSON.
'------------------------------------------------------------------------------
SUB SkipWhitespace (BYREF s AS STRING, BYREF p AS LONG)
DO WHILE p <= LEN(s) AND (MID$(s,p,1)=" " OR MID$(s,p,1)=CHR$(9) OR MID$(s,p,1)=CHR$(10) OR MID$(s,p,1)=CHR$(13))
INCR p
LOOP
END SUB
'------------------------------------------------------------------------------
FUNCTION ParseObject (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' Stub: Must parse { key:value, ... }
' Create object node
LOCAL objID AS LONG
objID = Node_Create(%JSON_TYPE_OBJECT, parentID, "", "")
IF objID=0 THEN FUNCTION=0:EXIT FUNCTION
' Advance past '{'
INCR p
CALL SkipWhitespace(s,p)
' Check if empty object
IF MID$(s,p,1)="}" THEN
INCR p ' skip '}'
FUNCTION = objID
EXIT FUNCTION
END IF
DO
' Parse key (string)
LOCAL keyStr AS STRING, valNodeID AS LONG
keyStr = ParseKey(s, p)
IF keyStr="" THEN
' Error set by ParseKey
CALL Node_FreeSubtree(objID)
FUNCTION=0
EXIT FUNCTION
END IF
CALL SkipWhitespace(s,p)
IF MID$(s,p,1) <> ":" THEN
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Expected ':' in object."
CALL Node_FreeSubtree(objID)
FUNCTION=0
EXIT FUNCTION
END IF
INCR p ' skip ':'
CALL SkipWhitespace(s,p)
' Parse value
valNodeID=ParseValue(s,p,objID)
IF valNodeID=0 THEN
' Error set by ParseValue
CALL Node_FreeSubtree(objID)
FUNCTION=0
EXIT FUNCTION
END IF
' Assign key to valNodeID
gNodeName(valNodeID)=keyStr
' Add valNodeID as child of objID
CALL Node_AddChild(objID,valNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN
' Error in adding child
CALL Node_FreeSubtree(objID)
FUNCTION=0
EXIT FUNCTION
END IF
CALL SkipWhitespace(s,p)
IF MID$(s,p,1)="}" THEN
INCR p ' close object
EXIT DO
END IF
IF MID$(s,p,1)<>"," THEN
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Expected ',' or '}' in object."
CALL Node_FreeSubtree(objID)
FUNCTION=0
EXIT FUNCTION
END IF
INCR p ' skip ','
CALL SkipWhitespace(s,p)
LOOP
FUNCTION=objID
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseArray (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' Stub: Must parse [ value, value... ]
LOCAL arrID AS LONG
arrID=Node_Create(%JSON_TYPE_ARRAY, parentID, "", "")
IF arrID=0 THEN FUNCTION=0:EXIT FUNCTION
INCR p ' skip '['
CALL SkipWhitespace(s,p)
' Check if empty array
IF MID$(s,p,1)="]" THEN
INCR p
FUNCTION=arrID
EXIT FUNCTION
END IF
DO
LOCAL valNodeID AS LONG
valNodeID=ParseValue(s,p,arrID)
IF valNodeID=0 THEN
CALL Node_FreeSubtree(arrID)
FUNCTION=0
EXIT FUNCTION
END IF
CALL Node_AddChild(arrID,valNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN
CALL Node_FreeSubtree(arrID)
FUNCTION=0
EXIT FUNCTION
END IF
CALL SkipWhitespace(s,p)
IF MID$(s,p,1)="]" THEN
INCR p
EXIT DO
END IF
IF MID$(s,p,1)<>"," THEN
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Expected ',' or ']' in array."
CALL Node_FreeSubtree(arrID)
FUNCTION=0
EXIT FUNCTION
END IF
INCR p ' skip ','
CALL SkipWhitespace(s,p)
LOOP
FUNCTION=arrID
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseValue (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' Stub: Detect value type: string, number, bool, null, object, array
CALL SkipWhitespace(s,p)
LOCAL c AS STRING
c=MID$(s,p,1)
SELECT CASE c
CASE "{"
FUNCTION=ParseObject(s,p,parentID)
CASE "["
FUNCTION=ParseArray(s,p,parentID)
CASE CHR$(34) ' string
FUNCTION=ParseStringValue(s,p,parentID)
CASE "t","f" ' boolean
FUNCTION=ParseBooleanValue(s,p,parentID)
CASE "n" ' null
FUNCTION=ParseNullValue(s,p,parentID)
CASE "-", "0" TO "9"
FUNCTION=ParseNumberValue(s,p,parentID)
CASE ELSE
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Unexpected character in value."
FUNCTION=0
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseStringRaw (BYVAL s AS STRING, BYREF p AS LONG) AS STRING
LOCAL startPos AS LONG, VL AS STRING
IF MID$(s,p,1) <> CHR$(34) THEN
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Expected '\"' at start of string."
FUNCTION=""
EXIT FUNCTION
END IF
startPos = p
INCR p ' skip opening quote
DO WHILE p <= LEN(s)
IF MID$(s,p,1)=CHR$(34) THEN
' found closing quote
VL = MID$(s, startPos+1, p-(startPos+1))
INCR p ' skip closing "
EXIT DO
END IF
' handle escapes if needed
INCR p
LOOP
IF VL="" AND MID$(s,p-1,1)<>CHR$(34) THEN
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Unterminated string."
FUNCTION=""
EXIT FUNCTION
END IF
FUNCTION=VL
END FUNCTION
'------------------------------------------------------------------------------
' Now ParseStringValue uses ParseStringRaw:
FUNCTION ParseStringValue (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
LOCAL VL AS STRING
VL = ParseStringRaw(s,p)
IF VL="" AND gLastJSONError<>%JSON_ERR_NONE THEN
' Error set by ParseStringRaw
FUNCTION=0
EXIT FUNCTION
END IF
FUNCTION=Node_Create(%JSON_TYPE_STRING, parentID, "", VL)
END FUNCTION
'------------------------------------------------------------------------------
' ParseKey now just returns a string by calling ParseStringRaw:
FUNCTION ParseKey (BYVAL s AS STRING, BYREF p AS LONG) AS STRING
LOCAL VL AS STRING
VL = ParseStringRaw(s,p)
IF VL="" AND gLastJSONError<>%JSON_ERR_NONE THEN
' Error set by ParseStringRaw
FUNCTION=""
EXIT FUNCTION
END IF
FUNCTION = VL
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseBooleanValue (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' Stub: parse 'true' or 'false'
IF UCASE$(MID$(s,p,4))="TRUE" THEN
p=p+4
FUNCTION=Node_Create(%JSON_TYPE_BOOL, parentID, "", "true")
ELSEIF UCASE$(MID$(s,p,5))="FALSE" THEN
p=p+5
FUNCTION=Node_Create(%JSON_TYPE_BOOL, parentID, "", "false")
ELSE
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Invalid boolean value."
FUNCTION=0
END IF
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseNullValue (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' parse 'null'
IF UCASE$(MID$(s,p,4))="NULL" THEN
p=p+4
FUNCTION=Node_Create(%JSON_TYPE_NULL, parentID, "", "")
ELSE
gLastJSONError=%JSON_ERR_PARSE
gLastJSONErrorMsg="Invalid null value."
FUNCTION=0
END IF
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ParseNumberValue (BYVAL s AS STRING, BYREF p AS LONG, BYVAL parentID AS LONG) AS LONG
' Stub: extract a number pattern
LOCAL startPos AS LONG, numStr AS STRING
startPos = p
DO WHILE p<=LEN(s)
SELECT CASE MID$(s,p,1)
CASE "0" TO "9","-","+",".","E","e"
' valid number chars
CASE ELSE
EXIT DO
END SELECT
INCR p
LOOP
numStr = MID$(s,startPos,p-startPos)
' Validate or just trust, normally we'd check IsValidNumber
FUNCTION=Node_Create(%JSON_TYPE_NUMBER, parentID, "", numStr)
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_Create
'
' PURPOSE:
' Creates a new node in the global node arrays with the specified type, parent,
' nodeName, and nodeValue. It will call Node_EnsureCapacity to expand arrays
' if needed.
'
' PARAMETERS:
' nodeType AS LONG - The type of the node (%JSON_TYPE_OBJECT, etc.)
' parentID AS LONG - The parent node ID, or -1 if none
' nodeName AS STRING - The key/name for object members, otherwise ""
' nodeValue AS STRING - The value if this is a primitive type node, otherwise ""
'
' RETURN VALUE:
' LONG - The newly created node's ID (>=1). Returns 0 on error.
'
' GLOBAL VARIABLES:
' Writes to gNodeCount, gNodeType(), gNodeParent(), gNodeName(), gNodeValue(),
' gNodeChildren(). May set gLastJSONError and gLastJSONErrorMsg on failure.
'
' LOGIC:
' 1. Call Node_EnsureCapacity to make sure we have space.
' 2. If no error, increment gNodeCount and use it as the new nodeID.
' 3. Assign gNodeType(nodeID)=nodeType, gNodeParent(nodeID)=parentID, etc.
' 4. Return nodeID.
' 5. If an error occurs (e.g., capacity expansion failed), set error and return 0.
'
' NOTES:
' This is an internal helper used by parsing and other node creation functions.
'------------------------------------------------------------------------------
FUNCTION Node_Create (BYVAL nodeType AS LONG, BYVAL parentID AS LONG, BYVAL nodeName AS STRING, BYVAL nodeValue AS STRING) AS LONG
LOCAL newID AS LONG
' Clear error states before operation
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Ensure capacity for one more node
CALL Node_EnsureCapacity
IF gLastJSONError <> %JSON_ERR_NONE THEN
' Memory allocation failed in Node_EnsureCapacity
FUNCTION = 0
EXIT FUNCTION
END IF
' Now we have space, create the node
INCR gNodeCount
newID = gNodeCount
gNodeType(newID) = nodeType
gNodeParent(newID) = parentID
gNodeName(newID) = nodeName
gNodeValue(newID) = nodeValue
gNodeChildren(newID) = ""
FUNCTION = newID
END FUNCTION
'------------------------------------------------------------------------------
' SUB NAME: Node_AddChild
'
' PURPOSE:
' Appends a child node ID to the parent node's child list. This is used when
' building objects or arrays. The parent must be %JSON_TYPE_OBJECT or
' %JSON_TYPE_ARRAY. If not, an error is set.
'
' PARAMETERS:
' parentID AS LONG - The node ID of the parent
' childID AS LONG - The node ID of the child to add
'
' RETURN VALUE:
' None (but sets global error if failed)
'
' GLOBAL VARIABLES:
' Uses gNodeChildren() and gNodeType().
' Can set gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Validate that parentID and childID are within valid ranges and that
' gNodeType(parentID) is either OBJECT or ARRAY.
' 2. Append STR$(childID) to gNodeChildren(parentID) separated by a comma if not empty.
' 3. If parent or child are invalid, set error accordingly.
'
' NOTES:
' This function does not create nodes, it only links them.
'------------------------------------------------------------------------------
SUB Node_AddChild (BYVAL parentID AS LONG, BYVAL childID AS LONG)
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Validate parent
IF (parentID < 1) OR (parentID > gNodeCount) OR (gNodeType(parentID) = 0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid parent node ID in Node_AddChild."
EXIT SUB
END IF
' Validate child
IF (childID < 1) OR (childID > gNodeCount) OR (gNodeType(childID) = 0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid child node ID in Node_AddChild."
EXIT SUB
END IF
' Check parent type
SELECT CASE gNodeType(parentID)
CASE %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY
' OK to add children
CASE ELSE
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent is not an object or array in Node_AddChild."
EXIT SUB
END SELECT
' Append to children list
IF gNodeChildren(parentID) = "" THEN
gNodeChildren(parentID) = STR$(childID)
ELSE
gNodeChildren(parentID) = gNodeChildren(parentID) + "," + STR$(childID)
END IF
END SUB
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_GetChildIDs
'
' PURPOSE:
' Extracts all child node IDs from gNodeChildren(nodeID) and returns them
' in a dynamic LONG array. The caller must DIM the array before calling or
' can REDIM inside. The function returns the count of children.
'
' PARAMETERS:
' nodeID AS LONG - The node ID whose children we want.
' childArray() AS LONG (ByRef) - Dynamic array to be filled with child IDs.
'
' RETURN VALUE:
' LONG - Number of children, or -1 on error.
'
' GLOBAL VARIABLES:
' Reads gNodeChildren().
' May set gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Validate nodeID.
' 2. If gNodeChildren(nodeID)="" then no children, return 0.
' 3. Split gNodeChildren(nodeID) by commas, convert to LONG, store in childArray().
' 4. Return the count of children.
'
' NOTES:
' Caller should handle the returned count. If -1, an error occurred.
'------------------------------------------------------------------------------
FUNCTION Node_GetChildIDs (BYVAL nodeID AS LONG, childArray() AS LONG) AS LONG
LOCAL childList AS STRING
LOCAL PS AS LONG
LOCAL startPos AS LONG
LOCAL cID AS STRING
LOCAL CNT AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Validate nodeID
IF (nodeID < 1) OR (nodeID > gNodeCount) OR (gNodeType(nodeID) = 0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid node ID in Node_GetChildIDs."
FUNCTION = -1
EXIT FUNCTION
END IF
childList = gNodeChildren(nodeID)
IF childList = "" THEN
' No children
REDIM childArray(1 TO 0) ' Empty array
FUNCTION = 0
EXIT FUNCTION
END IF
' Count commas and split
' We'll split by commas manually
CNT = 1
PS = 1
DO
PS = INSTR(PS, childList, ",")
IF PS = 0 THEN EXIT DO
INCR CNT
INCR PS
LOOP
' Now we know how many IDs we have: CNT
REDIM childArray(1 TO CNT)
' Extract IDs
startPos = 1
PS = INSTR(childList, ",")
LOCAL idx AS LONG: idx = 1
DO WHILE PS > 0
cID = MID$(childList, startPos, PS - startPos)
childArray(idx) = VAL(cID)
idx = idx + 1
startPos = PS + 1
PS = INSTR(startPos, childList, ",")
LOOP
' Last one
cID = MID$(childList, startPos)
childArray(idx) = VAL(cID)
FUNCTION = CNT
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_FindChildByName
'
' PURPOSE:
' For an object node, finds a child's node ID by its key/name. Returns 0 if not found.
'
' PARAMETERS:
' parentID AS LONG - ID of the parent node (must be an object)
' keyName AS STRING - The name of the child to find
'
' RETURN VALUE:
' LONG - The child's node ID if found, or 0 if not found or error.
'
' GLOBAL VARIABLES:
' Reads gNodeChildren(), gNodeName(), gNodeType().
' Sets gLastJSONError and gLastJSONErrorMsg if invalid parent or other error occurs.
'
' LOGIC:
' 1. Validate parentID and ensure it's an object.
' 2. Use Node_GetChildIDs to get an array of children.
' 3. Loop through children, check gNodeName(childID) for a match.
' 4. If match found, return childID.
' 5. If none found, return 0.
'
' NOTES:
' Only makes sense for object nodes. For arrays, keys are not used.
'------------------------------------------------------------------------------
FUNCTION Node_FindChildByName (BYVAL parentID AS LONG, BYVAL keyName AS STRING) AS LONG
LOCAL childArray() AS LONG
LOCAL CNT AS LONG
LOCAL i AS LONG
LOCAL cID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Validate parentID
IF (parentID < 1) OR (parentID > gNodeCount) OR (gNodeType(parentID)=0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid parentID in Node_FindChildByName."
FUNCTION = 0
EXIT FUNCTION
END IF
' Check if object
IF gNodeType(parentID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent is not an object in Node_FindChildByName."
FUNCTION = 0
EXIT FUNCTION
END IF
' Get children
CNT = Node_GetChildIDs(parentID, childArray())
IF CNT = -1 THEN
' error is already set by Node_GetChildIDs
FUNCTION = 0
EXIT FUNCTION
END IF
' Search children
FOR i = 1 TO CNT
cID = childArray(i)
' Validate cID
IF (cID > 0) AND (cID <= gNodeCount) THEN
IF UCASE$(gNodeName(cID)) = UCASE$(keyName) THEN
FUNCTION = cID
EXIT FUNCTION
END IF
END IF
NEXT i
' Not found
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetLastError
'
' PURPOSE:
' Returns the last error code set by any JSON operation.
'
' PARAMETERS:
' None
'
' RETURN VALUE:
' LONG - The last error code (%JSON_ERR_NONE if no error).
'
' GLOBAL VARIABLES:
' Reads gLastJSONError.
'
' LOGIC:
' Simply return gLastJSONError.
'
' NOTES:
' Useful for checking errors after operations that return 0 or other sentinel values.
'------------------------------------------------------------------------------
FUNCTION JSON_GetLastError COMMON AS LONG
FUNCTION = gLastJSONError
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_GetNodeByPath
'
' PURPOSE:
' Given a docHandle and a path string (like "root.items[2].name"), return the
' nodeID that the path refers to. The root node corresponds to gDocRoot(docHandle).
' The path can navigate through objects by keys and arrays by indices.
'
' PARAMETERS:
' docHandle AS LONG - The document handle
' path AS STRING - The path to navigate (e.g. "" for root, "data.items[0]" etc.)
'
' RETURN VALUE:
' LONG - The node ID if found, or 0 if not found or error.
'
' GLOBAL VARIABLES:
' Uses gDocRoot(), gDocInUse(), gDocType(), gNodeChildren(), gNodeName(), etc.
' Sets gLastJSONError/gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Validate docHandle.
' 2. If path is empty, return the root node of the doc.
' 3. Split the path by '.' and handle array indexes indicated by [n].
' 4. Start from the root node and navigate step-by-step:
' - If step is like "keyName", we are navigating an object by key:
' * Use Node_FindChildByName to find the child node.
' - If step includes "[n]", we are navigating into an array element:
' * Extract the index and find that child by index.
' 5. If any step fails, set error and return 0.
'
' NOTES:
' This function is critical for all path-based getters/setters.
'------------------------------------------------------------------------------
FUNCTION Node_GetNodeByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL currentNode AS LONG
LOCAL steps() AS STRING
LOCAL stepIndex AS LONG
LOCAL delimiterIndex AS LONG
LOCAL elementTotal AS LONG
LOCAL segment AS STRING
LOCAL bracketIndex AS LONG
LOCAL arrayIndexStr AS STRING
LOCAL arrayIndexNum AS LONG
LOCAL childArray() AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Validate docHandle
IF (docHandle < 1) OR (docHandle > gDocCount) OR (gDocInUse(docHandle)=0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid docHandle in Node_GetNodeByPath."
FUNCTION = 0
EXIT FUNCTION
END IF
' If empty path, return root
IF PATH = "" THEN
FUNCTION = gDocRoot(docHandle)
EXIT FUNCTION
END IF
' Split path by '.' into steps
' Count how many '.' are there to REDIM steps array
LOCAL dotIndex AS LONG, dotSearch AS LONG, stepCount AS LONG
dotSearch = 1
stepCount = 1
DO
dotIndex = INSTR(dotSearch, PATH, ".")
IF dotIndex = 0 THEN EXIT DO
stepCount = stepCount + 1
dotSearch = dotIndex + 1
LOOP
REDIM steps(1 TO stepCount)
' Extract steps
LOCAL startIndex AS LONG
startIndex = 1
dotIndex = INSTR(startIndex, PATH, ".")
stepIndex = 1
DO WHILE dotIndex > 0
steps(stepIndex) = MID$(PATH, startIndex, dotIndex - startIndex)
stepIndex = stepIndex + 1
startIndex = dotIndex + 1
dotIndex = INSTR(startIndex, PATH, ".")
LOOP
' Last segment
steps(stepIndex) = MID$(PATH, startIndex)
currentNode = gDocRoot(docHandle)
' For each step, navigate down
FOR stepIndex = 1 TO stepCount
segment = steps(stepIndex)
' Check if segment has array index like "items[2]"
bracketIndex = INSTR(segment, "[")
IF bracketIndex > 0 THEN
' This means we have something like keyName[index]
' Extract keyName
LOCAL objectKey AS STRING
objectKey = LEFT$(segment, bracketIndex-1)
' Extract the index part between [ and ]
LOCAL closeBracketIndex AS LONG
closeBracketIndex = INSTR(bracketIndex, segment, "]")
IF closeBracketIndex = 0 THEN
gLastJSONError = %JSON_ERR_PARSE
gLastJSONErrorMsg = "Missing closing bracket in path segment."
FUNCTION = 0
EXIT FUNCTION
END IF
arrayIndexStr = MID$(segment, bracketIndex+1, closeBracketIndex - bracketIndex - 1)
arrayIndexNum = VAL(arrayIndexStr)
' Navigate object by key (if objectKey not empty)
IF objectKey <> "" THEN
' currentNode must be an object
IF gNodeType(currentNode) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Trying to access object key on non-object node."
FUNCTION = 0
EXIT FUNCTION
END IF
currentNode = Node_FindChildByName(currentNode, objectKey)
IF currentNode = 0 THEN
' Error already set by Node_FindChildByName or not found
IF gLastJSONError = %JSON_ERR_NONE THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Key not found: " + objectKey
END IF
FUNCTION = 0
EXIT FUNCTION
END IF
END IF
' Now currentNode should be an array
IF gNodeType(currentNode) <> %JSON_TYPE_ARRAY THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Trying to index a non-array node."
FUNCTION = 0
EXIT FUNCTION
END IF
' Get children of array
elementTotal = Node_GetChildIDs(currentNode, childArray())
IF elementTotal = -1 THEN
' Error already set
FUNCTION = 0
EXIT FUNCTION
END IF
' Check range
IF arrayIndexNum < 0 OR arrayIndexNum >= elementTotal THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Array index out of range."
FUNCTION = 0
EXIT FUNCTION
END IF
' arrayIndexNum is zero-based, children array is 1-based
currentNode = childArray(arrayIndexNum + 1)
ELSE
' Simple key navigation without array indexing
' currentNode must be object
IF gNodeType(currentNode) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Trying to access object key on non-object node."
FUNCTION = 0
EXIT FUNCTION
END IF
currentNode = Node_FindChildByName(currentNode, segment)
IF currentNode = 0 THEN
IF gLastJSONError = %JSON_ERR_NONE THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Key not found: " + segment
END IF
FUNCTION = 0
EXIT FUNCTION
END IF
END IF
NEXT stepIndex
FUNCTION = currentNode
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetValueTypeByPath
'
' PURPOSE:
' Given a docHandle and a path, returns the type of the JSON node at that path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - One of %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY, %JSON_TYPE_STRING,
' %JSON_TYPE_NUMBER, %JSON_TYPE_BOOL, %JSON_TYPE_NULL, or 0 on error.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType().
' Sets gLastJSONError and gLastJSONErrorMsg if error occurs.
'
' LOGIC:
' 1. Use Node_GetNodeByPath to get nodeID.
' 2. If nodeID=0, error is already set.
' 3. Return gNodeType(nodeID).
'------------------------------------------------------------------------------
FUNCTION JSON_GetValueTypeByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL nodeID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
' Error already set by Node_GetNodeByPath
FUNCTION = 0
EXIT FUNCTION
END IF
FUNCTION = gNodeType(nodeID)
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetStringByPath
'
' PURPOSE:
' Returns the value at the given path as a string. If the node is a string, return it.
' If number, convert to string. If bool, "true"/"false". If null, "".
' If object/array, returns "" and sets error.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' STRING - The string representation of the node. Empty if error or incompatible type.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, gNodeValue.
' Sets gLastJSONError/gLastJSONErrorMsg if error.
'
' LOGIC:
' 1. Get nodeID.
' 2. Check gNodeType(nodeID).
' 3. Convert as needed:
' - STRING: return gNodeValue(nodeID)
' - NUMBER: return gNodeValue(nodeID)
' - BOOL: return "true" or "false"
' - NULL: return ""
' - OBJECT/ARRAY: error out.
'------------------------------------------------------------------------------
FUNCTION JSON_GetStringByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS STRING
LOCAL nodeID AS LONG
LOCAL t AS LONG
LOCAL resultStr AS STRING
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
' Error already set
FUNCTION = ""
EXIT FUNCTION
END IF
t = gNodeType(nodeID)
SELECT CASE t
CASE %JSON_TYPE_STRING
resultStr = gNodeValue(nodeID)
CASE %JSON_TYPE_NUMBER
resultStr = gNodeValue(nodeID)
CASE %JSON_TYPE_BOOL
' gNodeValue(nodeID) should be "true" or "false"
resultStr = gNodeValue(nodeID)
CASE %JSON_TYPE_NULL
resultStr = ""
CASE %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Cannot return object/array as string."
resultStr = ""
CASE ELSE
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Unknown node type."
resultStr = ""
END SELECT
FUNCTION = resultStr
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetNumberByPath
'
' PURPOSE:
' Returns the node at path as a DOUBLE. If it's a number, return it directly.
' If it's a string that can be converted, do so. If bool: true=1, false=0.
' If null=0, if object/array error out.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' DOUBLE - The numeric value, or 0.0 if error or not convertible.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, gNodeValue.
' Sets gLastJSONError/gLastJSONErrorMsg if error.
'
' LOGIC:
' 1. Get nodeID.
' 2. If number: VAL(gNodeValue).
' 3. If bool: "true"=1, "false"=0.
' 4. If string: try VAL().
' 5. If null=0.0
' 6. If object/array error.
'------------------------------------------------------------------------------
FUNCTION JSON_GetNumberByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS DOUBLE
LOCAL nodeID AS LONG
LOCAL t AS LONG
LOCAL numericVal AS DOUBLE
LOCAL valStr AS STRING
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
FUNCTION = 0.0
EXIT FUNCTION
END IF
t = gNodeType(nodeID)
SELECT CASE t
CASE %JSON_TYPE_NUMBER
numericVal = VAL(gNodeValue(nodeID))
CASE %JSON_TYPE_BOOL
IF UCASE$(gNodeValue(nodeID)) = "TRUE" THEN
numericVal = 1.0
ELSE
numericVal = 0.0
END IF
CASE %JSON_TYPE_STRING
valStr = TRIM$(gNodeValue(nodeID))
numericVal = VAL(valStr)
' VAL returns 0 if not a valid number, we may not set error here,
' but could if we consider non-numerics an error.
CASE %JSON_TYPE_NULL
numericVal = 0.0
CASE %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Cannot convert object/array to number."
numericVal = 0.0
CASE ELSE
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Unknown node type in JSON_GetNumberByPath."
numericVal = 0.0
END SELECT
FUNCTION = numericVal
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetBooleanByPath
'
' PURPOSE:
' Returns the node at path as a boolean. If it's a bool, true=1, false=0.
' If it's number>0 then true, else false.
' If string non-empty then true, else false.
' If null=0 (false).
' If object/array error out.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - 1=true,0=false, -1 if error.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, gNodeValue.
' Sets gLastJSONError/gLastJSONErrorMsg if error.
'
' LOGIC:
' 1. Get nodeID.
' 2. Convert based on type:
' - BOOL: if "true" then 1 else 0.
' - NUMBER: if VAL(...)>0 then 1 else 0.
' - STRING: if not empty then 1 else 0.
' - NULL: return 0.
' - OBJECT/ARRAY: error.
'------------------------------------------------------------------------------
FUNCTION JSON_GetBooleanByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL nodeID AS LONG
LOCAL t AS LONG
LOCAL valStr AS STRING
LOCAL numericVal AS DOUBLE
LOCAL boolVal AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
FUNCTION = -1
EXIT FUNCTION
END IF
t = gNodeType(nodeID)
SELECT CASE t
CASE %JSON_TYPE_BOOL
IF UCASE$(gNodeValue(nodeID)) = "TRUE" THEN
boolVal = 1
ELSE
boolVal = 0
END IF
CASE %JSON_TYPE_NUMBER
numericVal = VAL(gNodeValue(nodeID))
IF numericVal > 0 THEN boolVal = 1 ELSE boolVal = 0
CASE %JSON_TYPE_STRING
valStr = TRIM$(gNodeValue(nodeID))
IF valStr <> "" THEN boolVal = 1 ELSE boolVal = 0
CASE %JSON_TYPE_NULL
boolVal = 0
CASE %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Cannot convert object/array to boolean."
FUNCTION = -1
EXIT FUNCTION
CASE ELSE
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Unknown node type in JSON_GetBooleanByPath."
FUNCTION = -1
EXIT FUNCTION
END SELECT
FUNCTION = boolVal
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_GetNullByPath
'
' PURPOSE:
' Checks if the node at the given path is null.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - 1 if the node is null, 0 otherwise. Returns 0 and sets error if path not found.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType.
' Sets gLastJSONError and gLastJSONErrorMsg if error occurs.
'
' LOGIC:
' 1. Get nodeID from Node_GetNodeByPath.
' 2. If nodeID=0, error already set, return 0.
' 3. If gNodeType(nodeID) = %JSON_TYPE_NULL, return 1, else return 0.
'------------------------------------------------------------------------------
FUNCTION JSON_GetNullByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL nodeID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
' Error set by Node_GetNodeByPath
FUNCTION = 0
EXIT FUNCTION
END IF
IF gNodeType(nodeID) = %JSON_TYPE_NULL THEN
FUNCTION = 1
ELSE
FUNCTION = 0
END IF
END FUNCTION
'-------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectGetKeysCount
'
' PURPOSE:
' Returns the number of keys in the object at the given path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - The number of keys in the object, or -1 if error (not found or not an object).
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, Node_GetChildIDs.
' Sets gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Get nodeID from Node_GetNodeByPath.
' 2. Check if node is object. If not, set error and return -1.
' 3. Use Node_GetChildIDs to get the children.
' 4. Return the number of children (each child corresponds to a key).
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectGetKeysCount (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL nodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalKeys AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
' Error set
FUNCTION = -1
EXIT FUNCTION
END IF
IF gNodeType(nodeID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Node at path is not an object."
FUNCTION = -1
EXIT FUNCTION
END IF
totalKeys = Node_GetChildIDs(nodeID, childArray())
' If totalKeys=-1, error already set by Node_GetChildIDs
FUNCTION = totalKeys
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectGetKeyNameByIndex
'
' PURPOSE:
' Returns the name of the key in the object at the given path by its numeric index.
' The index is 0-based.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' keyIndex AS LONG - 0-based index of the key
'
' RETURN VALUE:
' STRING - The key name, or "" if error (not found, not object, or out of range).
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, Node_GetChildIDs, gNodeName.
' Sets gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Get nodeID from path.
' 2. Check if object.
' 3. Get children via Node_GetChildIDs.
' 4. If keyIndex out of range, error.
' 5. Return gNodeName of the child at that index.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectGetKeyNameByIndex (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL keyIndex AS LONG) AS STRING
LOCAL nodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalKeys AS LONG
LOCAL keyID AS LONG
LOCAL resultStr AS STRING
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
FUNCTION = ""
EXIT FUNCTION
END IF
IF gNodeType(nodeID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Node at path is not an object."
FUNCTION = ""
EXIT FUNCTION
END IF
totalKeys = Node_GetChildIDs(nodeID, childArray())
IF totalKeys = -1 THEN
' Error set by Node_GetChildIDs
FUNCTION = ""
EXIT FUNCTION
END IF
IF (keyIndex < 0) OR (keyIndex >= totalKeys) THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Key index out of range."
FUNCTION = ""
EXIT FUNCTION
END IF
' keyIndex is zero-based, childArray is 1-based
keyID = childArray(keyIndex + 1)
resultStr = gNodeName(keyID)
FUNCTION = resultStr
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ArrayGetCount
'
' PURPOSE:
' Returns the number of elements in the array at the given path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - Number of elements, or -1 if error (not an array or not found).
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath, gNodeType, Node_GetChildIDs.
' Sets gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Get nodeID.
' 2. Check if array.
' 3. Node_GetChildIDs to get children count.
' 4. Return count.
'------------------------------------------------------------------------------
FUNCTION JSON_ArrayGetCount (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL nodeID AS LONG
LOCAL childArray() AS LONG
LOCAL elementTotal AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
FUNCTION = -1
EXIT FUNCTION
END IF
IF gNodeType(nodeID) <> %JSON_TYPE_ARRAY THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Node at path is not an array."
FUNCTION = -1
EXIT FUNCTION
END IF
elementTotal = Node_GetChildIDs(nodeID, childArray())
' If elementTotal=-1, error set by Node_GetChildIDs
FUNCTION = elementTotal
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ArrayGetStringElement
'
' PURPOSE:
' Returns the array element at the given index as a STRING. If it's a number,
' convert to string, if bool return "true"/"false", if null return "".
' If object/array error out.
' The index is 0-based.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' elementIndex AS LONG - 0-based index of the element in the array.
'
' RETURN VALUE:
' STRING - The string representation of the element, or "" if error.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath (to get array node), Node_GetChildIDs, gNodeType, gNodeValue.
' Sets gLastJSONError and gLastJSONErrorMsg on error.
'
' LOGIC:
' 1. Get the array node via Node_GetNodeByPath.
' 2. Check if array.
' 3. Get child IDs via Node_GetChildIDs.
' 4. Check if elementIndex in range.
' 5. Get the child's nodeID and convert to string (similar logic to JSON_GetStringByPath internals).
'------------------------------------------------------------------------------
FUNCTION JSON_ArrayGetStringElement (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL elementIndex AS LONG) AS STRING
LOCAL nodeID AS LONG
LOCAL childArray() AS LONG
LOCAL elementTotal AS LONG
LOCAL elementNodeID AS LONG
LOCAL t AS LONG
LOCAL resultStr AS STRING
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Get the array node
nodeID = Node_GetNodeByPath(docHandle, PATH)
IF nodeID = 0 THEN
FUNCTION = ""
EXIT FUNCTION
END IF
IF gNodeType(nodeID) <> %JSON_TYPE_ARRAY THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Node at path is not an array."
FUNCTION = ""
EXIT FUNCTION
END IF
elementTotal = Node_GetChildIDs(nodeID, childArray())
IF elementTotal = -1 THEN
' Error from Node_GetChildIDs
FUNCTION = ""
EXIT FUNCTION
END IF
IF (elementIndex < 0) OR (elementIndex >= elementTotal) THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Array index out of range."
FUNCTION = ""
EXIT FUNCTION
END IF
' Get the element node
elementNodeID = childArray(elementIndex + 1)
t = gNodeType(elementNodeID)
SELECT CASE t
CASE %JSON_TYPE_STRING
resultStr = gNodeValue(elementNodeID)
CASE %JSON_TYPE_NUMBER
resultStr = gNodeValue(elementNodeID)
CASE %JSON_TYPE_BOOL
resultStr = gNodeValue(elementNodeID) ' "true" or "false"
CASE %JSON_TYPE_NULL
resultStr = ""
CASE %JSON_TYPE_OBJECT, %JSON_TYPE_ARRAY
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Cannot return object/array as string."
resultStr = ""
CASE ELSE
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Unknown node type in JSON_ArrayGetStringElement."
resultStr = ""
END SELECT
FUNCTION = resultStr
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_CreateObject
'
' PURPOSE:
' Creates a new empty JSON object and returns a document handle referencing it.
'
' PARAMETERS:
' None
'
' RETURN VALUE:
' LONG - A new docHandle (>=1) if successful, or 0 if error occurred.
'
' GLOBAL VARIABLES:
' Uses gDocCount, gDocRoot(), gDocInUse(), Node_Create.
' Can set gLastJSONError/gLastJSONErrorMsg if memory issues arise.
'
' LOGIC:
' 1. Create a new object node by calling Node_Create with nodeType=%JSON_TYPE_OBJECT and parentID=-1.
' 2. If node creation fails, return 0.
' 3. Increment gDocCount, record the root node in gDocRoot(gDocCount) and mark in gDocInUse(gDocCount)=1.
' 4. Return gDocCount as the docHandle.
'------------------------------------------------------------------------------
FUNCTION JSON_CreateObject AS LONG
LOCAL rootNodeID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
rootNodeID = Node_Create(%JSON_TYPE_OBJECT, -1, "", "")
IF rootNodeID = 0 THEN
' Error already set by Node_Create
FUNCTION = 0
EXIT FUNCTION
END IF
' Allocate doc handle
INCR gDocCount
IF gDocCount > UBOUND(gDocRoot) THEN
' Need to expand doc arrays
LOCAL oldUbound AS LONG
oldUbound = UBOUND(gDocRoot)
LOCAL newSize AS LONG
newSize = oldUbound * 2
IF newSize < (oldUbound + 10) THEN
newSize = oldUbound + 10
END IF
ON ERROR GOTO MemError
REDIM PRESERVE gDocRoot(1 TO newSize)
REDIM PRESERVE gDocInUse(1 TO newSize)
ON ERROR GOTO 0
END IF
gDocRoot(gDocCount) = rootNodeID
gDocInUse(gDocCount) = 1
FUNCTION = gDocCount
EXIT FUNCTION
MemError:
gLastJSONError = %JSON_ERR_MEMORY
gLastJSONErrorMsg = "Failed to allocate memory for new document handle in JSON_CreateObject."
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_CreateArray
'
' PURPOSE:
' Creates a new empty JSON array and returns a document handle referencing it.
'
' PARAMETERS:
' None
'
' RETURN VALUE:
' LONG - A new docHandle (>=1) if successful, or 0 if error.
'
' GLOBAL VARIABLES:
' Similar to JSON_CreateObject, but creates an array root node.
'
' LOGIC:
' 1. Node_Create(%JSON_TYPE_ARRAY, -1, "", "").
' 2. Allocate doc handle similarly to JSON_CreateObject.
'------------------------------------------------------------------------------
FUNCTION JSON_CreateArray AS LONG
LOCAL rootNodeID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
rootNodeID = Node_Create(%JSON_TYPE_ARRAY, -1, "", "")
IF rootNodeID = 0 THEN
FUNCTION = 0
EXIT FUNCTION
END IF
INCR gDocCount
IF gDocCount > UBOUND(gDocRoot) THEN
' Expand doc arrays
LOCAL oldUbound AS LONG
LOCAL newSize AS LONG
oldUbound = UBOUND(gDocRoot)
newSize = oldUbound * 2
IF newSize < (oldUbound + 10) THEN
newSize = oldUbound + 10
END IF
ON ERROR GOTO MemError
REDIM PRESERVE gDocRoot(1 TO newSize)
REDIM PRESERVE gDocInUse(1 TO newSize)
ON ERROR GOTO 0
END IF
gDocRoot(gDocCount) = rootNodeID
gDocInUse(gDocCount) = 1
FUNCTION = gDocCount
EXIT FUNCTION
MemError:
gLastJSONError = %JSON_ERR_MEMORY
gLastJSONErrorMsg = "Failed to allocate memory for new document handle in JSON_CreateArray."
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectSetStringByPath
'
' PURPOSE:
' Sets or updates a string value in an object at the specified path. If the key
' does not exist, it creates it. If the node at path is not an object (except for
' the last segment which is a key), it sets an error.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING - The path to the object where the key is set (e.g. "root.person")
' nodeValue AS STRING - The string value to set
'
' RETURN VALUE:
' LONG - 0=success, non-zero indicates error.
'
' GLOBAL VARIABLES:
' Uses Node_GetNodeByPath for parent object, Node_FindChildByName, Node_Create.
' Sets gLastJSONError/gLastJSONErrorMsg if error.
'
' LOGIC:
' 1. Find the parent object node by using everything except the last segment as path.
' The last segment after '.' is the key to set. If path is empty, parent is root object.
' 2. Extract the last key from the path. If no '.' in path, the entire path is the object name.
' 3. If key exists, update its type/value.
' 4. If not, create a new node of type string and Node_AddChild to the object.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectSetStringByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeValue AS STRING) AS LONG
LOCAL parentPath AS STRING
LOCAL keyName AS STRING
LOCAL parentNodeID AS LONG
LOCAL keyNodeID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
' Extract parent path and key
LOCAL dotPos AS LONG
dotPos = INSTR(-1, PATH, ".") ' Find last occurrence of '.'
IF dotPos > 0 THEN
parentPath = LEFT$(PATH, dotPos-1)
keyName = MID$(PATH, dotPos+1)
ELSE
' No dot, entire path is the object itself
parentPath = ""
keyName = PATH
END IF
parentNodeID = Node_GetNodeByPath(docHandle, parentPath)
IF parentNodeID = 0 THEN
' Error set
FUNCTION = 1
EXIT FUNCTION
END IF
' Must be object
IF gNodeType(parentNodeID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent node is not an object in JSON_ObjectSetStringByPath."
FUNCTION = 2
EXIT FUNCTION
END IF
' Find existing key
keyNodeID = Node_FindChildByName(parentNodeID, keyName)
IF keyNodeID = 0 THEN
' Key not found, create new string node
gLastJSONError = %JSON_ERR_NONE ' Clear any not found error from Node_FindChildByName
keyNodeID = Node_Create(%JSON_TYPE_STRING, parentNodeID, keyName, nodeValue)
IF keyNodeID = 0 THEN
' Error set by Node_Create
FUNCTION = 3
EXIT FUNCTION
END IF
CALL Node_AddChild(parentNodeID, keyNodeID)
IF gLastJSONError <> %JSON_ERR_NONE THEN
FUNCTION = 4
EXIT FUNCTION
END IF
ELSE
' Key exists, update it
' Check if allowed to change type
gNodeType(keyNodeID) = %JSON_TYPE_STRING
gNodeValue(keyNodeID) = nodeValue
END IF
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectSetNumberByPath
'
' PURPOSE:
' Sets or updates a numeric value in an object at the specified path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' nodeNumber AS DOUBLE
'
' RETURN VALUE:
' LONG - 0=success, else error code
'
' LOGIC:
' Similar to JSON_ObjectSetStringByPath but creates/updates a %JSON_TYPE_NUMBER node.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectSetNumberByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeNumber AS DOUBLE) AS LONG
LOCAL parentPath AS STRING
LOCAL keyName AS STRING
LOCAL parentNodeID AS LONG
LOCAL keyNodeID AS LONG
LOCAL dotPos AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
dotPos = INSTR(-1, PATH, ".")
IF dotPos > 0 THEN
parentPath = LEFT$(PATH, dotPos-1)
keyName = MID$(PATH, dotPos+1)
ELSE
parentPath = ""
keyName = PATH
END IF
parentNodeID = Node_GetNodeByPath(docHandle, parentPath)
IF parentNodeID = 0 THEN
FUNCTION = 1
EXIT FUNCTION
END IF
IF gNodeType(parentNodeID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent node is not an object in JSON_ObjectSetNumberByPath."
FUNCTION = 2
EXIT FUNCTION
END IF
keyNodeID = Node_FindChildByName(parentNodeID, keyName)
IF keyNodeID = 0 THEN
' Create new number node
gLastJSONError = %JSON_ERR_NONE
keyNodeID = Node_Create(%JSON_TYPE_NUMBER, parentNodeID, keyName, STR$(nodeNumber))
IF keyNodeID = 0 THEN
FUNCTION = 3
EXIT FUNCTION
END IF
CALL Node_AddChild(parentNodeID, keyNodeID)
IF gLastJSONError <> %JSON_ERR_NONE THEN
FUNCTION = 4
EXIT FUNCTION
END IF
ELSE
' Update existing
gNodeType(keyNodeID) = %JSON_TYPE_NUMBER
gNodeValue(keyNodeID) = STR$(nodeNumber)
END IF
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectSetBooleanByPath
'
' PURPOSE:
' Sets or updates a boolean value in an object at the specified path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' nodeBool AS LONG (0=false, 1=true)
'
' RETURN VALUE:
' LONG - 0=success, else error
'
' LOGIC:
' Similar to JSON_ObjectSetStringByPath but creates/updates a %JSON_TYPE_BOOL node.
' Converts the boolean to "true" or "false" string.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectSetBooleanByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeBool AS LONG) AS LONG
LOCAL parentPath AS STRING
LOCAL keyName AS STRING
LOCAL parentNodeID AS LONG
LOCAL keyNodeID AS LONG
LOCAL boolStr AS STRING
LOCAL dotPos AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
IF nodeBool = 0 THEN
boolStr = "false"
ELSE
boolStr = "true"
END IF
dotPos = INSTR(-1, PATH, ".")
IF dotPos > 0 THEN
parentPath = LEFT$(PATH, dotPos-1)
keyName = MID$(PATH, dotPos+1)
ELSE
parentPath = ""
keyName = PATH
END IF
parentNodeID = Node_GetNodeByPath(docHandle, parentPath)
IF parentNodeID = 0 THEN
FUNCTION = 1
EXIT FUNCTION
END IF
IF gNodeType(parentNodeID) <> %JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent node is not an object in JSON_ObjectSetBooleanByPath."
FUNCTION = 2
EXIT FUNCTION
END IF
keyNodeID = Node_FindChildByName(parentNodeID, keyName)
IF keyNodeID = 0 THEN
' Create new bool node
gLastJSONError = %JSON_ERR_NONE
keyNodeID = Node_Create(%JSON_TYPE_BOOL, parentNodeID, keyName, boolStr)
IF keyNodeID = 0 THEN
FUNCTION = 3
EXIT FUNCTION
END IF
CALL Node_AddChild(parentNodeID, keyNodeID)
IF gLastJSONError <> %JSON_ERR_NONE THEN
FUNCTION = 4
EXIT FUNCTION
END IF
ELSE
' Update existing bool
gNodeType(keyNodeID) = %JSON_TYPE_BOOL
gNodeValue(keyNodeID) = boolStr
END IF
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' SUB NAME: Node_FreeSubtree
'
' PURPOSE:
' Frees a node and all its descendant nodes. Marks their gNodeType(nodeID)=0.
' Removes them from global arrays by logically clearing fields.
' Since we are not implementing memory compaction, we just mark freed nodes
' for re-use or ignore them. If needed, we can keep them permanently zeroed out.
'
' PARAMETERS:
' nodeID AS LONG - The ID of the node to free.
'
' RETURN VALUE:
' None
'
' GLOBAL VARIABLES:
' Modifies gNodeType, gNodeValue, gNodeName, gNodeChildren.
' No error set, as freeing should always succeed if node is valid.
'
' LOGIC:
' 1. If nodeID invalid or type=0, just return.
' 2. If object/array, free all children recursively.
' 3. Set gNodeType(nodeID)=0 and clear fields.
'------------------------------------------------------------------------------
SUB Node_FreeSubtree (BYVAL nodeID AS LONG)
LOCAL childArray() AS LONG
LOCAL totalChildren AS LONG
LOCAL childIndex AS LONG
IF (nodeID < 1) OR (nodeID > gNodeCount) OR (gNodeType(nodeID)=0) THEN
EXIT SUB
END IF
' If object or array, free children first
IF gNodeType(nodeID)=%JSON_TYPE_OBJECT OR gNodeType(nodeID)=%JSON_TYPE_ARRAY THEN
totalChildren = Node_GetChildIDs(nodeID, childArray())
IF totalChildren > 0 THEN
FOR childIndex = 1 TO totalChildren
CALL Node_FreeSubtree(childArray(childIndex))
NEXT
END IF
END IF
' Free this node
gNodeType(nodeID) = 0
gNodeParent(nodeID) = 0
gNodeName(nodeID) = ""
gNodeValue(nodeID) = ""
gNodeChildren(nodeID) = ""
END SUB
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_DuplicateSubtree
'
' PURPOSE:
' Creates a full copy of a node and all its descendants, returning the new root ID.
'
' PARAMETERS:
' sourceNodeID AS LONG - The ID of the node to copy
' parentID AS LONG - The parent of the new node (or -1 if root)
'
' RETURN VALUE:
' LONG - The new node ID for the copied subtree root.
' 0 if error (memory issues).
'
' LOGIC:
' 1. Create a new node with same type, name, value.
' 2. If object/array, recursively duplicate children and call Node_AddChild for each.
' 3. Return the new node's ID.
'------------------------------------------------------------------------------
FUNCTION Node_DuplicateSubtree (BYVAL sourceNodeID AS LONG, BYVAL parentID AS LONG) AS LONG
LOCAL newNodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalChildren AS LONG
LOCAL childIndex AS LONG
LOCAL cID AS LONG
LOCAL childCopyID AS LONG
IF (sourceNodeID < 1) OR (sourceNodeID > gNodeCount) OR (gNodeType(sourceNodeID)=0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid source node in Node_DuplicateSubtree."
FUNCTION = 0
EXIT FUNCTION
END IF
newNodeID = Node_Create(gNodeType(sourceNodeID), parentID, gNodeName(sourceNodeID), gNodeValue(sourceNodeID))
IF newNodeID = 0 THEN
' Error set by Node_Create
FUNCTION = 0
EXIT FUNCTION
END IF
' If object/array, duplicate children
IF gNodeType(sourceNodeID)=%JSON_TYPE_OBJECT OR gNodeType(sourceNodeID)=%JSON_TYPE_ARRAY THEN
totalChildren = Node_GetChildIDs(sourceNodeID, childArray())
IF totalChildren = -1 THEN
' Error from Node_GetChildIDs
FUNCTION = 0
EXIT FUNCTION
END IF
FOR childIndex = 1 TO totalChildren
cID = childArray(childIndex)
childCopyID = Node_DuplicateSubtree(cID, newNodeID)
IF childCopyID=0 THEN
' Error set during recursion
FUNCTION = 0
EXIT FUNCTION
END IF
CALL Node_AddChild(newNodeID, childCopyID)
IF gLastJSONError <> %JSON_ERR_NONE THEN
FUNCTION = 0
EXIT FUNCTION
END IF
NEXT
END IF
FUNCTION = newNodeID
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: Node_ToString
'
' PURPOSE:
' Serializes a node and its children to a JSON string. Supports pretty printing.
'
' PARAMETERS:
' nodeID AS LONG
' prettyPrint AS LONG (0=no, 1=yes)
' indentLevel AS LONG (current indentation level)
'
' RETURN VALUE:
' STRING - The JSON representation of this node.
'
' LOGIC:
' 1. Based on node type:
' - OBJECT: { "key":value, ... }
' - ARRAY: [ value, ... ]
' - STRING: "value" (escape if needed, assume value already properly escaped)
' - NUMBER: raw numeric string
' - BOOL: "true"/"false"
' - NULL: "null"
' 2. If object/array, recursively call Node_ToString for children.
' 3. If prettyPrint=1, add newlines and spaces.
'------------------------------------------------------------------------------
FUNCTION Node_ToString (BYVAL nodeID AS LONG, BYVAL prettyPrint AS LONG, BYVAL indentLevel AS LONG) AS STRING
LOCAL t AS LONG
LOCAL resultStr AS STRING
LOCAL childArray() AS LONG
LOCAL totalChildren AS LONG
LOCAL childIndex AS LONG
LOCAL childNodeID AS LONG
LOCAL spaceStr AS STRING
LOCAL lineBreak AS STRING
LOCAL colonSpace AS STRING
LOCAL commaSpace AS STRING
IF (nodeID < 1) OR (nodeID > gNodeCount) OR (gNodeType(nodeID)=0) THEN
' Invalid node, return empty (or set error?)
FUNCTION = ""
EXIT FUNCTION
END IF
t = gNodeType(nodeID)
IF prettyPrint=1 THEN
spaceStr = STRING$(indentLevel*2, " ")
lineBreak = $CRLF
colonSpace = ": "
commaSpace = ", "
ELSE
spaceStr = ""
lineBreak = ""
colonSpace = ":"
commaSpace = ","
END IF
SELECT CASE t
CASE %JSON_TYPE_OBJECT
totalChildren = Node_GetChildIDs(nodeID, childArray())
IF totalChildren = -1 THEN
FUNCTION = ""
EXIT FUNCTION
END IF
resultStr = "{" + IIF$(prettyPrint=1, lineBreak, "")
FOR childIndex = 1 TO totalChildren
childNodeID = childArray(childIndex)
' key
resultStr = resultStr + spaceStr + IIF$(prettyPrint=1, " ", "") + CHR$(34) + gNodeName(childNodeID) + CHR$(34) + colonSpace
' value
resultStr = resultStr + Node_ToString(childNodeID, prettyPrint, indentLevel+1)
IF childIndex < totalChildren THEN
resultStr = resultStr + commaSpace + IIF$(prettyPrint=1, lineBreak, "")
ELSE
resultStr = resultStr + IIF$(prettyPrint=1, lineBreak, "")
END IF
NEXT
resultStr = resultStr + spaceStr + "}"
CASE %JSON_TYPE_ARRAY
totalChildren = Node_GetChildIDs(nodeID, childArray())
IF totalChildren = -1 THEN
FUNCTION = ""
EXIT FUNCTION
END IF
resultStr = "[" + IIF$(prettyPrint=1 AND totalChildren>0, lineBreak, "")
FOR childIndex = 1 TO totalChildren
childNodeID = childArray(childIndex)
resultStr = resultStr + spaceStr + IIF$(prettyPrint=1, " ", "") + Node_ToString(childNodeID, prettyPrint, indentLevel+1)
IF childIndex < totalChildren THEN
resultStr = resultStr + commaSpace + IIF$(prettyPrint=1, lineBreak, "")
ELSE
resultStr = resultStr + IIF$(prettyPrint=1 AND totalChildren>0, lineBreak, "")
END IF
NEXT
resultStr = resultStr + spaceStr + "]"
CASE %JSON_TYPE_STRING
resultStr = CHR$(34) + gNodeValue(nodeID) + CHR$(34)
CASE %JSON_TYPE_NUMBER
resultStr = gNodeValue(nodeID)
CASE %JSON_TYPE_BOOL
resultStr = gNodeValue(nodeID) ' "true" or "false"
CASE %JSON_TYPE_NULL
resultStr = "null"
CASE ELSE
' Unknown type
resultStr = ""
END SELECT
FUNCTION = resultStr
END FUNCTION
'------------------------------------------------------------------------------
' SUB NAME: JSON_Shutdown
'
' PURPOSE:
' Frees all global resources by clearing arrays and resetting counts.
'
' PARAMETERS:
' None
'
' RETURN VALUE:
' LONG (0=success)
'
' LOGIC:
' 1. Free all nodes (Node_FreeSubtree for each doc, or just clear arrays).
' 2. REDIM arrays back to initial size, set counters to 0.
'------------------------------------------------------------------------------
FUNCTION JSON_Shutdown AS LONG
' Just reset everything
gNodeCount = 0
REDIM gNodeType(1 TO 100)
REDIM gNodeParent(1 TO 100)
REDIM gNodeName(1 TO 100)
REDIM gNodeValue(1 TO 100)
REDIM gNodeChildren(1 TO 100)
gDocCount = 0
REDIM gDocRoot(1 TO 10)
REDIM gDocInUse(1 TO 10)
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_FreeHandle
'
' PURPOSE:
' Frees all nodes associated with a given docHandle.
'
' PARAMETERS:
' docHandle AS LONG
'
' RETURN VALUE:
' LONG (0=success, else error)
'
' LOGIC:
' 1. Validate docHandle.
' 2. Call Node_FreeSubtree(gDocRoot(docHandle)).
' 3. Set gDocInUse(docHandle)=0 and gDocRoot(docHandle)=0.
'------------------------------------------------------------------------------
FUNCTION JSON_FreeHandle (BYVAL docHandle AS LONG) AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
IF (docHandle < 1) OR (docHandle > gDocCount) OR (gDocInUse(docHandle)=0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid docHandle in JSON_FreeHandle."
FUNCTION = 1
EXIT FUNCTION
END IF
CALL Node_FreeSubtree(gDocRoot(docHandle))
gDocRoot(docHandle)=0
gDocInUse(docHandle)=0
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_DuplicateHandle
'
' PURPOSE:
' Duplicates an entire JSON document, returning a new handle.
'
' PARAMETERS:
' docHandle AS LONG
'
' RETURN VALUE:
' LONG - New doc handle, or 0 if error.
'
' LOGIC:
' 1. Validate docHandle.
' 2. Use Node_DuplicateSubtree on the root node.
' 3. Create a new doc handle and assign this new root.
'------------------------------------------------------------------------------
FUNCTION JSON_DuplicateHandle (BYVAL docHandle AS LONG) AS LONG
LOCAL newRootID AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
IF (docHandle < 1) OR (docHandle > gDocCount) OR (gDocInUse(docHandle)=0) THEN
gLastJSONError = %JSON_ERR_INVALID
gLastJSONErrorMsg = "Invalid docHandle in JSON_DuplicateHandle."
FUNCTION = 0
EXIT FUNCTION
END IF
newRootID = Node_DuplicateSubtree(gDocRoot(docHandle), -1)
IF newRootID = 0 THEN
' Error set
FUNCTION = 0
EXIT FUNCTION
END IF
INCR gDocCount
IF gDocCount > UBOUND(gDocRoot) THEN
LOCAL oldUbound AS LONG
LOCAL newSize AS LONG
oldUbound = UBOUND(gDocRoot)
newSize = oldUbound * 2
IF newSize < oldUbound + 10 THEN
newSize = oldUbound + 10
END IF
ON ERROR GOTO MemError
REDIM PRESERVE gDocRoot(1 TO newSize)
REDIM PRESERVE gDocInUse(1 TO newSize)
ON ERROR GOTO 0
END IF
gDocRoot(gDocCount) = newRootID
gDocInUse(gDocCount)=1
FUNCTION = gDocCount
EXIT FUNCTION
MemError:
gLastJSONError = %JSON_ERR_MEMORY
gLastJSONErrorMsg = "Memory allocation failed in JSON_DuplicateHandle."
FUNCTION = 0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectSetNullByPath
'
' PURPOSE:
' Sets a null value at the specified object path key.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
'
' RETURN VALUE:
' LONG - 0=success, else error
'
' LOGIC:
' Similar to JSON_ObjectSetStringByPath but sets a %JSON_TYPE_NULL.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectSetNullByPath (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL parentPath AS STRING
LOCAL keyName AS STRING
LOCAL parentNodeID AS LONG
LOCAL keyNodeID AS LONG
LOCAL dotPos AS LONG
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
dotPos = INSTR(-1, PATH, ".")
IF dotPos > 0 THEN
parentPath = LEFT$(PATH, dotPos-1)
keyName = MID$(PATH, dotPos+1)
ELSE
parentPath = ""
keyName = PATH
END IF
parentNodeID = Node_GetNodeByPath(docHandle, parentPath)
IF parentNodeID=0 THEN
FUNCTION = 1
EXIT FUNCTION
END IF
IF gNodeType(parentNodeID)<>%JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent node is not an object in JSON_ObjectSetNullByPath."
FUNCTION = 2
EXIT FUNCTION
END IF
keyNodeID = Node_FindChildByName(parentNodeID, keyName)
IF keyNodeID = 0 THEN
' Create new null node
gLastJSONError = %JSON_ERR_NONE
keyNodeID = Node_Create(%JSON_TYPE_NULL, parentNodeID, keyName, "")
IF keyNodeID=0 THEN FUNCTION=3:EXIT FUNCTION
CALL Node_AddChild(parentNodeID, keyNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN FUNCTION=4:EXIT FUNCTION
ELSE
' Update existing
gNodeType(keyNodeID) = %JSON_TYPE_NULL
gNodeValue(keyNodeID) = ""
END IF
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ObjectRemoveKey
'
' PURPOSE:
' Removes a key from an object at the given path.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING - The path including the key to remove.
'
' RETURN VALUE:
' LONG - 0=success, else error
'
' LOGIC:
' 1. Resolve parent object and key.
' 2. Find child node by name.
' 3. If found, remove from gNodeChildren(parent), free the subtree.
'------------------------------------------------------------------------------
FUNCTION JSON_ObjectRemoveKey (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL parentPath AS STRING
LOCAL keyName AS STRING
LOCAL parentNodeID AS LONG
LOCAL keyNodeID AS LONG
LOCAL dotPos AS LONG
LOCAL childList AS STRING
LOCAL childArray() AS LONG
LOCAL totalChildren AS LONG
LOCAL childIndex AS LONG
LOCAL newList AS STRING
gLastJSONError = %JSON_ERR_NONE
gLastJSONErrorMsg = ""
dotPos = INSTR(-1, PATH, ".")
IF dotPos > 0 THEN
parentPath = LEFT$(PATH, dotPos-1)
keyName = MID$(PATH, dotPos+1)
ELSE
parentPath = ""
keyName = PATH
END IF
parentNodeID = Node_GetNodeByPath(docHandle, parentPath)
IF parentNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(parentNodeID)<>%JSON_TYPE_OBJECT THEN
gLastJSONError = %JSON_ERR_TYPE
gLastJSONErrorMsg = "Parent node is not object in JSON_ObjectRemoveKey."
FUNCTION=2
EXIT FUNCTION
END IF
keyNodeID = Node_FindChildByName(parentNodeID, keyName)
IF keyNodeID=0 THEN
IF gLastJSONError=%JSON_ERR_NONE THEN
gLastJSONError = %JSON_ERR_NOTFOUND
gLastJSONErrorMsg = "Key not found."
END IF
FUNCTION=3
EXIT FUNCTION
END IF
totalChildren = Node_GetChildIDs(parentNodeID, childArray())
IF totalChildren=-1 THEN FUNCTION=4:EXIT FUNCTION
' Remove keyNodeID from parent's children list
childList = gNodeChildren(parentNodeID)
' Rebuild childList without keyNodeID
FOR childIndex=1 TO totalChildren
IF childArray(childIndex)<>keyNodeID THEN
IF newList="" THEN
newList=STR$(childArray(childIndex))
ELSE
newList=newList+","+STR$(childArray(childIndex))
END IF
END IF
NEXT
gNodeChildren(parentNodeID)=newList
' Free the subtree
CALL Node_FreeSubtree(keyNodeID)
FUNCTION=0
END FUNCTION
'-------------------------------------------------------------------------------
'
'-------------------------------------------------------------------------------
FUNCTION JSON_ArrayAppendString (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeValue AS STRING) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childNodeID AS LONG
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID = Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
childNodeID=Node_Create(%JSON_TYPE_STRING, arrayNodeID, "", nodeValue)
IF childNodeID=0 THEN FUNCTION=3:EXIT FUNCTION
CALL Node_AddChild(arrayNodeID, childNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN FUNCTION=4:EXIT FUNCTION
FUNCTION=0
END FUNCTION
'-------------------------------------------------------------------------------
FUNCTION JSON_ArrayAppendNumber (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeNumber AS DOUBLE) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childNodeID AS LONG
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID=Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
childNodeID=Node_Create(%JSON_TYPE_NUMBER, arrayNodeID, "", STR$(nodeNumber))
IF childNodeID=0 THEN FUNCTION=3:EXIT FUNCTION
CALL Node_AddChild(arrayNodeID, childNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN FUNCTION=4:EXIT FUNCTION
FUNCTION=0
END FUNCTION
'-------------------------------------------------------------------------------
FUNCTION JSON_ArrayAppendBoolean (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL nodeBool AS LONG) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childNodeID AS LONG
LOCAL boolStr AS STRING
IF nodeBool=0 THEN boolStr="false" ELSE boolStr="true"
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID=Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
childNodeID=Node_Create(%JSON_TYPE_BOOL, arrayNodeID, "", boolStr)
IF childNodeID=0 THEN FUNCTION=3:EXIT FUNCTION
CALL Node_AddChild(arrayNodeID, childNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN FUNCTION=4:EXIT FUNCTION
FUNCTION=0
END FUNCTION
'-------------------------------------------------------------------------------
FUNCTION JSON_ArrayAppendNull (BYVAL docHandle AS LONG, BYVAL PATH AS STRING) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childNodeID AS LONG
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID=Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
childNodeID=Node_Create(%JSON_TYPE_NULL, arrayNodeID, "", "")
IF childNodeID=0 THEN FUNCTION=3:EXIT FUNCTION
CALL Node_AddChild(arrayNodeID, childNodeID)
IF gLastJSONError<>%JSON_ERR_NONE THEN FUNCTION=4:EXIT FUNCTION
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ArrayInsertElement
'
' PURPOSE:
' Inserts an existing node (elementHandle) into the array at a specific 0-based index.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' elementIndex AS LONG
' elementHandle AS LONG (handle to a node)
'
' RETURN VALUE:
' LONG - 0=success, else error
'
' LOGIC:
' 1. Get array node.
' 2. Get child list, insert elementHandle at elementIndex.
' 3. Update gNodeChildren.
'------------------------------------------------------------------------------
' Simpler approach:
' Step 1: If elementIndex <= totalElements:
' Build newList by adding children until elementIndex, then add elementHandle, then continue.
FUNCTION JSON_ArrayInsertElement (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL elementIndex AS LONG, BYVAL elementHandle AS LONG) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalElements AS LONG
LOCAL i AS LONG
LOCAL newList AS STRING
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID=Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
totalElements=Node_GetChildIDs(arrayNodeID, childArray())
IF totalElements=-1 THEN FUNCTION=3:EXIT FUNCTION
IF (elementIndex<0) OR (elementIndex>totalElements) THEN
gLastJSONError=%JSON_ERR_NOTFOUND
gLastJSONErrorMsg="Index out of range."
FUNCTION=4
EXIT FUNCTION
END IF
' Build new list
FOR i=1 TO totalElements
IF (i-1)=elementIndex THEN
' Insert here
IF newList="" THEN
newList=STR$(elementHandle)+","+STR$(childArray(i))
ELSE
newList=newList+","+STR$(elementHandle)+","+STR$(childArray(i))
END IF
ELSE
IF newList="" THEN
newList=STR$(childArray(i))
ELSE
newList=newList+","+STR$(childArray(i))
END IF
END IF
NEXT i
' If inserting at the very end
IF elementIndex=totalElements THEN
IF newList="" THEN
newList=STR$(elementHandle)
ELSE
newList=newList+","+STR$(elementHandle)
END IF
END IF
gNodeChildren(arrayNodeID)=newList
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ArrayRemoveElement
'
' PURPOSE:
' Removes the element at the given 0-based index from the array.
'
' PARAMETERS:
' docHandle AS LONG
' path AS STRING
' elementIndex AS LONG
'
' RETURN VALUE:
' LONG - 0=success, else error
'
' LOGIC:
' 1. Get array node.
' 2. Get children, check index.
' 3. Remove that child from the list, free subtree.
'------------------------------------------------------------------------------
FUNCTION JSON_ArrayRemoveElement (BYVAL docHandle AS LONG, BYVAL PATH AS STRING, BYVAL elementIndex AS LONG) AS LONG
LOCAL arrayNodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalElements AS LONG
LOCAL i AS LONG
LOCAL removeNodeID AS LONG
LOCAL newList AS STRING
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
arrayNodeID=Node_GetNodeByPath(docHandle, PATH)
IF arrayNodeID=0 THEN FUNCTION=1:EXIT FUNCTION
IF gNodeType(arrayNodeID)<>%JSON_TYPE_ARRAY THEN
gLastJSONError=%JSON_ERR_TYPE
gLastJSONErrorMsg="Not an array."
FUNCTION=2
EXIT FUNCTION
END IF
totalElements=Node_GetChildIDs(arrayNodeID, childArray())
IF totalElements=-1 THEN FUNCTION=3:EXIT FUNCTION
IF (elementIndex<0) OR (elementIndex>=totalElements) THEN
gLastJSONError=%JSON_ERR_NOTFOUND
gLastJSONErrorMsg="Index out of range."
FUNCTION=4
EXIT FUNCTION
END IF
removeNodeID=childArray(elementIndex+1)
' Rebuild list without this child
FOR i=1 TO totalElements
IF i<>(elementIndex+1) THEN
IF newList="" THEN
newList=STR$(childArray(i))
ELSE
newList=newList+","+STR$(childArray(i))
END IF
END IF
NEXT
gNodeChildren(arrayNodeID)=newList
' Free removed element
CALL Node_FreeSubtree(removeNodeID)
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_Validate
'
' PURPOSE:
' Validates the JSON structure. Basic checks only: ensure no invalid references,
' object keys have unique names, arrays/objects well-formed.
'
' PARAMETERS:
' docHandle AS LONG
'
' RETURN VALUE:
' LONG - 0=valid, else error code.
'
' LOGIC:
' For brevity, we assume it's valid if docHandle is correct and nodes are consistent.
' A real validator would be more complex.
'------------------------------------------------------------------------------
FUNCTION JSON_Validate (BYVAL docHandle AS LONG) AS LONG
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
IF (docHandle<1) OR (docHandle>gDocCount) OR (gDocInUse(docHandle)=0) THEN
gLastJSONError=%JSON_ERR_INVALID
gLastJSONErrorMsg="Invalid docHandle in JSON_Validate."
FUNCTION=1
EXIT FUNCTION
END IF
' Minimal check: root node must not be 0
IF gDocRoot(docHandle)=0 THEN
gLastJSONError=%JSON_ERR_INVALID
gLastJSONErrorMsg="Empty document."
FUNCTION=2
EXIT FUNCTION
END IF
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION IsDigit(BYVAL ch AS STRING) AS LONG
REGISTER R01 AS LONG,R02 AS LONG
' VERIFY returns 0 if all chars in "ch" are found in the list "0123456789".
' Since "ch" should be a single character, if verify returns 0, it's a digit.
R01=VERIFY(ch, "0123456789")
IF R01=0 THEN R02=1 ELSE R02=0
FUNCTION = R02
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ConvertEuropeanNumberToJson(numStr AS STRING) AS STRING
numStr = TRIM$(numStr)
' If there's a comma, assume European decimal or thousand separator.
IF INSTR(numStr, ",") THEN
' Check if format is like "1.234,56" (European: thousand dot, decimal comma)
' Steps:
' 1. Remove thousand separators: These typically appear as dots in sequences like "1.234"
' If there's a dot followed by exactly 3 digits before a comma, assume it's a thousand sep.
' Simple heuristic:
LOCAL i AS LONG
LOCAL cleaned AS STRING
FOR i=1 TO LEN(numStr)
LOCAL c AS STRING
c=MID$(numStr,i,1)
' If c=".", check surroundings
IF c="." THEN
' Check if it's a thousand separator: a dot between digits and before the decimal comma
' For simplicity: if followed and preceded by digits and there's a comma later
IF i>1 AND i<LEN(numStr) THEN
IF IsDigit(MID$(numStr, i-1, 1))=1 AND IsDigit(MID$(numStr, i+1, 1))=1 THEN
' Likely thousand sep, skip it
' Don't append to cleaned
ELSE
cleaned = cleaned + c
END IF
ELSE
cleaned = cleaned + c
END IF
ELSE
cleaned = cleaned + c
END IF
NEXT
numStr=cleaned
' Now we should have something like "1234,56"
' Replace the comma with a dot
LOCAL commaPos AS LONG
commaPos = INSTR(numStr, ",")
IF commaPos THEN
' Make sure there's only one comma. If multiple commas, handle more complex logic.
' For simplicity, assume only one decimal comma:
numStr = LEFT$(numStr, commaPos-1) + "." + MID$(numStr, commaPos+1)
END IF
END IF
' After this, numStr should be closer to a standard JSON number like "1234.56"
FUNCTION = numStr
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_Repair
'
' PURPOSE:
' Attempts to fix common issues. For now, this is a stub that does nothing.
'
' PARAMETERS:
' docHandle AS LONG
'
' RETURN VALUE:
' LONG - 0=success
'
' LOGIC:
' In a real implementation, we'd fix trailing commas, unescaped chars, etc.
' Here we just return success.
'------------------------------------------------------------------------------
SUB Repair_CheckOrphanedNodes (BYVAL docHandle AS LONG)
LOCAL nodeID AS LONG
' For each node, ensure parent is valid or node is root of docHandle
' If parent invalid and not root, free the node
FOR nodeID = 1 TO gNodeCount
IF gNodeType(nodeID) <> 0 THEN
LOCAL parentID AS LONG
parentID = gNodeParent(nodeID)
IF parentID <> -1 AND parentID <> 0 THEN
IF (parentID < 1) OR (parentID > gNodeCount) OR (gNodeType(parentID)=0) THEN
' Orphan node, free it
Node_FreeSubtree(nodeID)
END IF
ELSE
' parentID=-1 means root node, ensure it matches docHandle
IF gDocRoot(docHandle)=nodeID THEN
' valid root
ELSE
' node claims to be root but not doc root, orphan?
' If we have multiple roots for some reason, keep the doc root, free others
IF nodeID <> gDocRoot(docHandle) THEN
Node_FreeSubtree(nodeID)
END IF
END IF
END IF
END IF
NEXT
END SUB
'------------------------------------------------------------------------------
SUB Repair_RemoveDuplicateKeys (BYVAL docHandle AS LONG)
LOCAL nodeID AS LONG
LOCAL childArray() AS LONG
LOCAL totalChildren AS LONG
' For each object node, check for duplicate keys
FOR nodeID = 1 TO gNodeCount
IF gNodeType(nodeID) = %JSON_TYPE_OBJECT THEN
totalChildren = Node_GetChildIDs(nodeID, childArray())
IF totalChildren > 0 THEN
DIM keyMap() AS STRING
REDIM keyMap(1 TO totalChildren)
LOCAL i AS LONG, j AS LONG
LOCAL kName AS STRING
' We'll store keys in an array and check duplicates
FOR i=1 TO totalChildren
kName = UCASE$(gNodeName(childArray(i)))
FOR j=1 TO i-1
IF keyMap(j)=kName THEN
' Duplicate found, remove this child
JSON_ObjectRemoveKey docHandle, BuildKeyPath(docHandle,nodeID,gNodeName(childArray(i)))
EXIT FOR
END IF
NEXT
IF j=i THEN
keyMap(i)=kName
END IF
NEXT
END IF
END IF
NEXT
END SUB
'------------------------------------------------------------------------------
' Helper function to build a path for a key in an object:
' (We assume we have a way to build paths, or we just remove directly by node)
FUNCTION BuildKeyPath(BYVAL docHandle AS LONG, BYVAL objectNodeID AS LONG, BYVAL keyName AS STRING) AS STRING
' If objectNodeID is root:
IF gDocRoot(docHandle)=objectNodeID THEN
FUNCTION = keyName
ELSE
' Recursively build path up to root
LOCAL p AS LONG
p=gNodeParent(objectNodeID)
LOCAL parentPath AS STRING
IF p = -1 OR p=0 THEN
parentPath=""
ELSE
parentPath=BuildKeyPath(docHandle,p,"")
END IF
IF parentPath="" THEN
FUNCTION=keyName
ELSE
FUNCTION=parentPath+"."+keyName
END IF
END IF
END FUNCTION
'------------------------------------------------------------------------------
SUB Repair_NormalizeNodeValues (BYVAL docHandle AS LONG)
LOCAL nodeID AS LONG
FOR nodeID=1 TO gNodeCount
IF gNodeType(nodeID)<>0 THEN
SELECT CASE gNodeType(nodeID)
CASE %JSON_TYPE_BOOL
' Ensure "true"/"false"
IF UCASE$(gNodeValue(nodeID))="TRUE" THEN
gNodeValue(nodeID)="true"
ELSEIF UCASE$(gNodeValue(nodeID))="FALSE" THEN
gNodeValue(nodeID)="false"
ELSE
' Invalid bool, set default to "false"
gNodeValue(nodeID)="false"
END IF
CASE %JSON_TYPE_NUMBER
' Validate number
IF IsValidNumber(gNodeValue(nodeID))=0 THEN
' Try European format fix
gNodeValue(nodeID)=ConvertEuropeanNumberToJson(gNodeValue(nodeID))
' Try to fix it, e.g. remove leading zeros
gNodeValue(nodeID)=FixNumber(gNodeValue(nodeID))
IF IsValidNumber(gNodeValue(nodeID))=0 THEN
' If still invalid, turn into 0
gNodeValue(nodeID)="0"
END IF
END IF
CASE %JSON_TYPE_NULL
' Ensure empty value
gNodeValue(nodeID)=""
CASE %JSON_TYPE_STRING
' Possibly unescape invalid sequences
gNodeValue(nodeID)=RepairString(gNodeValue(nodeID))
END SELECT
END IF
NEXT
END SUB
'------------------------------------------------------------------------------
SUB Repair_FixObjectKeys (BYVAL docHandle AS LONG)
LOCAL nodeID AS LONG, childArray() AS LONG, totalChildren AS LONG, i AS LONG
FOR nodeID=1 TO gNodeCount
IF gNodeType(nodeID)=%JSON_TYPE_OBJECT THEN
totalChildren=Node_GetChildIDs(nodeID,childArray())
IF totalChildren>0 THEN
FOR i=1 TO totalChildren
IF gNodeName(childArray(i))="" THEN
gNodeName(childArray(i))="fixedKey_"+STR$(childArray(i))
ELSEIF NOT IsValidJsonKey(gNodeName(childArray(i))) THEN
' If invalid chars present, try to fix or remove
gNodeName(childArray(i))=MakeValidKey(gNodeName(childArray(i)))
END IF
NEXT
END IF
END IF
NEXT
END SUB
'------------------------------------------------------------------------------
' Dummy helper functions for demonstration:
FUNCTION IsValidNumber(s AS STRING) AS LONG
' Check if s is a valid JSON number according to some basic rules
LOCAL d AS DOUBLE
d=VAL(s)
' If VAL fails, it returns 0 even for invalid
' As a simple check, if STR$(d)=TRIM$(s) except maybe leading zeros, consider valid
s=TRIM$(s)
IF s="" THEN FUNCTION=0:EXIT FUNCTION
' Check characters: numbers, sign, decimal
' This is a simplistic check:
LOCAL i AS LONG
FOR i=1 TO LEN(s)
SELECT CASE MID$(s,i,1)
CASE "0" TO "9","-","."
' ok
CASE ELSE
FUNCTION=0
EXIT FUNCTION
END SELECT
NEXT
' More robust checks could be applied.
FUNCTION=1
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION FixNumber(s AS STRING) AS STRING
' Simple fix: remove leading zeros except if number is zero
s=TRIM$(s)
WHILE LEFT$(s,1)="0" AND LEN(s)>1 AND MID$(s,2,1)<>"."
s=MID$(s,2)
WEND
FUNCTION=s
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION RepairString(s AS STRING) AS STRING
' Check for invalid escape sequences and remove them or fix them
' For demo, we just TRIM it:
s=TRIM$(s)
' In a real scenario, parse and fix escapes: \uXXXX, etc.
FUNCTION=s
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION IsValidJsonKey(k AS STRING) AS LONG
' For demo: keys should not be empty and no control chars
IF k="" THEN FUNCTION=0:EXIT FUNCTION
' Check no control chars
LOCAL i AS LONG
FOR i=1 TO LEN(k)
IF ASC(MID$(k,i,1))<32 THEN FUNCTION=0:EXIT FUNCTION
NEXT
FUNCTION=1
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION MakeValidKey(k AS STRING) AS STRING
' Replace invalid chars with '_'
LOCAL i AS LONG, c AS STRING, RES AS STRING
FOR i=1 TO LEN(k)
c=MID$(k,i,1)
IF ASC(c)<32 THEN
c="_"
END IF
RES=RES+c
NEXT
IF RES="" THEN RES="fixedKey"
FUNCTION=RES
END FUNCTION
'------------------------------------------------------------------------------
$AllowedKeyChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"
SUB Repair_MissingQuotesAndBraces (BYVAL docHandle AS LONG)
LOCAL jsonText AS STRING
LOCAL openCurlyCount AS LONG, closeCurlyCount AS LONG
REGISTER openSquareCount AS LONG, closeSquareCount AS LONG
LOCAL TempStr AS STRING
jsonText = gDocOriginalText(docHandle)
' 1. Fix missing quotes around keys:
' A simplistic approach: find sequences like: (\w+): that are not quoted
' This is a rough heuristic:
LOCAL PS AS LONG
PS = 1
DO
' Find a pattern like: name:
' For simplicity, we might do a rough search and then decide if we need quotes.
' A real solution might require a regex or a more advanced parser.
LOCAL colonPos AS LONG
colonPos = INSTR(PS, jsonText, ":")
IF colonPos=0 THEN EXIT DO
' Check backward for quotes
LOCAL keyEndPos AS LONG, keyStartPos AS LONG
keyEndPos=colonPos-1
' Move backward until a non-blank char:
WHILE keyEndPos>0 AND (MID$(jsonText,keyEndPos,1)=" " OR MID$(jsonText,keyEndPos,1)=CHR$(9))
DECR keyEndPos
WEND
IF keyEndPos<=0 THEN EXIT DO
' Find start of key (non-JSON syntax: no quotes)
keyStartPos=keyEndPos
' Extract the character into TempStr for clarity
' Find start of key (we're moving backwards until we hit a character not allowed in a key)
keyStartPos = keyEndPos
WHILE keyStartPos > 1
TempStr = MID$(jsonText, keyStartPos-1, 1)
IF INSTR(1, TempStr, ANY $AllowedKeyChars) > 0 THEN
DECR keyStartPos
ELSE
' As soon as we find a character not in AllowedKeyChars$, we stop
EXIT LOOP
END IF
WEND
' Extract potential key
LOCAL potentialKey AS STRING
potentialKey=MID$(jsonText,keyStartPos,keyEndPos-keyStartPos+1)
' Check if already quoted:
IF LEFT$(potentialKey,1)<>CHR$(34) AND RIGHT$(potentialKey,1)<>CHR$(34) THEN
' Insert quotes
jsonText=LEFT$(jsonText,keyStartPos-1)+CHR$(34)+potentialKey+CHR$(34)+MID$(jsonText,colonPos)
' Adjust positions (we inserted 2 chars)
ps=colonPos+2
ELSE
ps=colonPos+1
END IF
LOOP
' 2. Check braces/brackets balance
LOCAL i AS LONG
FOR i=1 TO LEN(jsonText)
SELECT CASE MID$(jsonText,i,1)
CASE "{": INCR openCurlyCount
CASE "}": INCR closeCurlyCount
CASE "[": INCR openSquareCount
CASE "]": INCR closeSquareCount
END SELECT
NEXT
' If more opens than closes, append missing
WHILE openCurlyCount>closeCurlyCount
jsonText=jsonText+"}"
INCR closeCurlyCount
WEND
WHILE openSquareCount>closeSquareCount
jsonText=jsonText+"]"
INCR closeSquareCount
WEND
' Update the original text
gDocOriginalText(docHandle)=jsonText
END SUB
'------------------------------------------------------------------------------
FUNCTION JSON_Repair (BYVAL docHandle AS LONG) AS LONG
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
' Try textual repairs first:
CALL Repair_MissingQuotesAndBraces(docHandle)
' Re-parse the JSON to see if the textual fixes helped
LOCAL newDocHandle AS LONG
LOCAL oldRootID AS LONG
oldRootID = gDocRoot(docHandle)
' Free the old structure:
CALL Node_FreeSubtree(oldRootID)
gDocRoot(docHandle)=0
gDocInUse(docHandle)=0
newDocHandle=JSON_ParseString(gDocOriginalText(docHandle))
IF newDocHandle=docHandle THEN
' Parsing succeeded with repaired text, now docHandle is valid again
ELSEIF newDocHandle<>0 THEN
' Parsing created a new handle, we can transfer it to docHandle or just use newDocHandle
' Simpler: free old docHandle arrays and move newDocHandle structure into docHandle?
' For simplicity, assume docHandle remain the same as original:
' Actually, if we must keep docHandle stable, we would need a different approach.
' Let's just say we return success if we got a new handle:
FUNCTION=0
EXIT FUNCTION
ELSE
' Still failed
FUNCTION=1
gLastJSONErrorMsg="Unable to repair JSON text."
EXIT FUNCTION
END IF
' If we are here, we have a parsed structure, now do structural repairs:
CALL Repair_CheckOrphanedNodes(docHandle)
CALL Repair_RemoveDuplicateKeys(docHandle)
CALL Repair_FixObjectKeys(docHandle)
CALL Repair_NormalizeNodeValues(docHandle)
FUNCTION=0
END FUNCTION
'------------------------------------------------------------------------------
' FUNCTION NAME: JSON_ToString
'
' PURPOSE:
' Serializes the document into a JSON string.
'
' PARAMETERS:
' docHandle AS LONG
' prettyPrint AS LONG (0=no, 1=yes)
'
' RETURN VALUE:
' STRING - The JSON text, or "" if error.
'
' LOGIC:
' 1. Validate docHandle.
' 2. Call Node_ToString(gDocRoot(docHandle), prettyPrint, 0).
'------------------------------------------------------------------------------
FUNCTION JSON_ToString (BYVAL docHandle AS LONG, BYVAL prettyPrint AS LONG) AS STRING
LOCAL rootID AS LONG
LOCAL resultStr AS STRING
gLastJSONError=%JSON_ERR_NONE
gLastJSONErrorMsg=""
IF (docHandle<1) OR (docHandle>gDocCount) OR (gDocInUse(docHandle)=0) THEN
gLastJSONError=%JSON_ERR_INVALID
gLastJSONErrorMsg="Invalid docHandle in JSON_ToString."
FUNCTION=""
EXIT FUNCTION
END IF
rootID=gDocRoot(docHandle)
IF rootID=0 THEN
gLastJSONError=%JSON_ERR_INVALID
gLastJSONErrorMsg="Document empty in JSON_ToString."
FUNCTION=""
EXIT FUNCTION
END IF
resultStr=Node_ToString(rootID, prettyPrint, 0)
FUNCTION=resultStr
END FUNCTION
'-------------------------------------------------------------------------------
' FUNCTION: EscapeJSONString
'
' PURPOSE:
' Converts a given string into a JSON-safe string by escaping special
' characters and encoding control or non-ASCII characters into Unicode
' escape sequences (\uXXXX).
'
' PARAMETERS:
' Unescaped (BYREF STRING):
' - The input string to be escaped for JSON usage.
' - Passed by reference for efficiency, though it is not modified.
'
' RETURNS:
' STRING:
' - A new string that is safe for JSON, with all escape sequences
' applied as necessary.
'
' ESCAPE RULES:
' The following characters are escaped in the resulting string:
' - Double quote (") -> \"
' - Backslash (\) -> \\
' - Backspace -> \b
' - Form feed -> \f
' - Newline -> \n
' - Carriage return -> \r
' - Tab -> \t
'
' Characters with ASCII values < 32 or > 126 are converted to Unicode
' escape sequences of the form: \uXXXX
' - Example: CHR$(10) (line feed) -> \u000A
'
' All other characters are appended to the output string unchanged.
'
' USAGE:
' DIM original AS STRING
' DIM escaped AS STRING
'
' original = "Example with \"special\" chars: \ and Ü"
' escaped = EscapeJSONString(original)
' PRINT escaped
'
' NOTES:
' - The function ensures compatibility with JSON syntax and formats.
' - Handles Unicode and control characters reliably.
' - Optimized for readability and correctness.
'
'-------------------------------------------------------------------------------
FUNCTION EscapeJSONString(BYREF Unescaped AS STRING) AS STRING
LOCAL Escaped AS STRING
REGISTER i AS LONG
LOCAL Ch AS STRING
REGISTER cVal AS LONG
LOCAL hexVal AS STRING
FOR i = 1 TO LEN(Unescaped)
Ch = MID$(Unescaped, i, 1)
cVal = ASC(Ch)
SELECT CASE AS LONG cVal
CASE 34 ' Double quote (")
Escaped = Escaped + "\"""
CASE 92 ' Backslash (\)
Escaped = Escaped + "\\"
CASE 8 ' Backspace
Escaped = Escaped + "\b"
CASE 12 ' Form feed
Escaped = Escaped + "\f"
CASE 10 ' New line
Escaped = Escaped + "\n"
CASE 13 ' Carriage return
Escaped = Escaped + "\r"
CASE 9 ' Tab
Escaped = Escaped + "\t"
CASE ELSE
' For control chars (<32) or non-ASCII (>126), encode as \uXXXX
IF cVal < 32 OR cVal > 126 THEN
hexVal = HEX$(cVal)
hexVal = RIGHT$("0000" + hexVal, 4)
Escaped = Escaped + "\u" + hexVal
ELSE
Escaped = Escaped + Ch
END IF
END SELECT
NEXT
FUNCTION = Escaped
END FUNCTION
'--------------------------------------------------------------------
' UnescapeJSONString
'
' Converts a JSON escaped string into its unescaped form.
' Handles escape sequences such as \" \\ \/ \b \f \n \r \t \uXXXX
'--------------------------------------------------------------------
'
FUNCTION UnescapeJSONString (BYVAL Est AS STRING) AS STRING
DIM Une AS STRING, i AS LONG
DIM Ch AS STRING, nc AS STRING, Hx AS STRING, Uc AS STRING
i = 1
DO WHILE i <= LEN(Est)
Ch = MID$(Est, i, 1)
IF Ch = "\" THEN
' We found an escape character, look at the next char
IF i < LEN(Est) THEN
nc = MID$(Est, i + 1, 1)
ELSE
' No next char (string ended with a backslash)
nc = ""
END IF
SELECT CASE nc
CASE "\"
Une = Une & "\"
i = i + 2
CASE CHR$(34) ' "
Une = Une & CHR$(34)
i = i + 2
CASE "/"
Une = Une & "/"
i = i + 2
CASE "b"
Une = Une & CHR$(8)
i = i + 2
CASE "f"
Une = Une & CHR$(12)
i = i + 2
CASE "n"
Une = Une & CHR$(10)
i = i + 2
CASE "r"
Une = Une & CHR$(13)
i = i + 2
CASE "t"
Une = Une & CHR$(9)
i = i + 2
CASE "u"
' Handle Unicode escape, next 4 chars should be hex digits
IF (i + 5) <= LEN(Est) THEN
Hx = MID$(Est, i + 2, 4)
Uc = CHR$(VAL("&H" & Hx))
Une = Une & Uc
i = i + 6
ELSE
' Incomplete Unicode escape, treat as literal
Une = Une & "\u"
i = i + 2
END IF
CASE ELSE
' Unknown escape sequence, output as-is
Une = Une & "\" & nc
i = i + 2
END SELECT
ELSE
' Normal character
Une = Une & Ch
i = i + 1
END IF
LOOP
FUNCTION = Une
END FUNCTION
'#################################################################################