// cJSONDictionary class v1.17:
// Created by Erik Svensson and published on eriksven.com in April 2013
// License: MIT
Define cJSONDICTIONARY_INCLUDED for 1
#IFNDEF cHASHTABLE_INCLUDED
Use cHashTable.pkg
#ENDIF
#IFNDEF cREGEX_INCLUDED
Use cRegex.pkg
#ENDIF
//Data type constants
Define _jsond_type for String
Define _jsond_unspecified for "unspecified"
Define _jsond_null for "null"
Define _jsond_string for "string"
Define _jsond_number for "number"
Define _jsond_object for "object"
Define _jsond_array for "array"
Define _jsond_object_array for "arrayofobjects"
Define _jsond_bool for "boolean"
#IFNDEF Is$WebApp
#IFNDEF ErrorSystem
Use Dferror.pkg
#ENDIF
Class _cJSONDictionaryErrorSystem is an ErrorSystem
Procedure Error_Report Integer ErrNum Integer Err_Line String ErrMsg
//Ignore all errors
End_Procedure
End_Class
#ELSE
#IFNDEF cWebAppError
Use cWebAppError.pkg
#ENDIF
Class _cJSONDictionaryErrorSystem is an cWebAppError
Procedure Error_Report Integer ErrNum Integer Err_Line String ErrMsg
//Ignore all errors
End_Procedure
End_Class
#ENDIF
//Example: _ARRAY_CAST v String to va
#COMMAND _ARRAY_CAST R L "TO" R .
!2[] _arr!2
Move !1 to _arr!2
If (SizeOfArray(_arr!2) > 0) Begin
Move (ResizeArray(!4,0)) to !4
For i from 0 to (SizeOfArray(_arr!2)-1)
#IFSAME !2 Number Decimal Real
Move (Cast(_arr!2[i], Real)) to !4[i]
#ELSE
Move _arr!2[i] to !4[i]
#ENDIF
Loop
End
#ENDCOMMAND
Class cJSONDictionary is a cHashTable
Procedure Construct_Object
Forward Send Construct_Object
End_Procedure
{ Visibility=Public }
Function Is_cJSONDictionary Returns Boolean
Function_Return True
End_Function
Function _ValueKey String sKey Returns String
Function_Return ("__[internal]__[t]*" + sKey)
End_Function
Function _IsValueKey String sKey Returns Boolean
Function_Return (Pos("__[internal]__[t]",sKey))
End_Function
Function _IntToHex Integer iVal Returns String
Integer iRest
String sVal sChar sBase
Move "0123456789ABCDEF" to sBase
Repeat
Move (Mod(iVal,16)) to iRest
Move (mid(sBase,1,iRest+1)) to sChar
Move (sChar+sVal) to sVal
Move (iVal/16) to iVal
Until (iVal=0)
Function_Return sVal
End_Function
Procedure _Escape String ByRef s
Integer i
If (s = NULL_ENTRY) Begin
Move "" to s
Procedure_Return
End
Move (Replaces('\',s,'\\')) to s
Move (Replaces('\\u',s,'\u')) to s
Move (Replaces('/',s,'\/')) to s
Move (Replaces('"',s,'\"')) to s
For i from 1 to 31
If (i <= 15) Begin
Move (Replaces(Character(i), s, ("\u000" + _IntToHex(Self, i)))) to s
End
Else Begin
Move (Replaces(Character(i), s, ("\u00" + _IntToHex(Self, i)))) to s
End
Loop
End_Procedure
Function _ArrayCast Variant v Returns Variant[]
Variant[] va
Integer i
_ARRAY_CAST v Address to va
_ARRAY_CAST v Integer to va
_ARRAY_CAST v BigInt to va
_ARRAY_CAST v Boolean to va
_ARRAY_CAST v Char to va
_ARRAY_CAST v Currency to va
_ARRAY_CAST v Date to va
_ARRAY_CAST v DateTime to va
_ARRAY_CAST v Decimal to va
_ARRAY_CAST v Float to va
_ARRAY_CAST v Number to va
_ARRAY_CAST v Real to va
_ARRAY_CAST v RowID to va
_ARRAY_CAST v Short to va
_ARRAY_CAST v String to va
_ARRAY_CAST v Time to va
_ARRAY_CAST v TimeSpan to va
_ARRAY_CAST v UBigInt to va
_ARRAY_CAST v UChar to va
_ARRAY_CAST v UInteger to va
_ARRAY_CAST v UShort to va
_ARRAY_CAST v Variant to va
Function_Return va
End_Function
Function _ValueTypeCheck Variant v _jsond_type match Returns Boolean
Case Begin
Case (match = _jsond_null)
Function_Return (v = Character(0))
Case Break
Case (match = _jsond_string)
String s
Move (Number(v)) to s
Function_Return (String(v) <> s)
Case Break
Case (match = _jsond_number)
Function_Return (Regex_IsMatch(v, "^(-)?(\d+)((.|,)\d+)?$"))
Case Break
Case End
End_Function
Function _Type String sKey Variant v Returns _jsond_type
Variant[] va
_jsond_type type
Get TypeForValue sKey to type
If (type <> _jsond_unspecified) Function_Return type
Get _ArrayCast v to va
If (SizeOfArray(va) > 0) Function_Return _jsond_array
If (Is_cJSONDictionary(v)) Function_Return _jsond_object
If (_ValueTypeCheck(Self, v, _jsond_string)) Function_Return _jsond_string
If (_ValueTypeCheck(Self, v, _jsond_number)) Function_Return _jsond_number
If (_ValueTypeCheck(Self, v, _jsond_null)) Function_Return _jsond_null
End_Function
Function _JSONNumber String s Returns String
Integer iDSep ITSep
Get_Attribute DF_DECIMAL_SEPARATOR to iDSep
Get_Attribute DF_THOUSANDS_SEPARATOR to ITSep
Function_Return (Replace(Character(ITSep), Replace(Character(iDSep), s, '.'), ''))
End_Function
Procedure _Serialize String[] saKeys String ByRef sJSON
Integer i ii iLastKey iLastElement
Variant v
Boolean b
Variant[] va
String sKey sValue sChildValue
_jsond_type type child_type
Append sJSON '{'
Move (SizeOfArray(saKeys)-1) to iLastKey
For i from 0 to iLastKey
Get Value saKeys[i] to v
Get _Type saKeys[i] v to type
Move saKeys[i] to sKey
Send _Escape (&sKey)
Case Begin
Case (type = _jsond_null)
Move 'null' to sValue
Case Break
Case (type = _jsond_bool)
Move v to b
Move (If(b, "true", "false")) to sValue
Case Break
Case (type = _jsond_string or type = _jsond_unspecified)
Move v to sValue
Send _Escape (&sValue)
Move ('"' + sValue + '"') to sValue
Case Break
Case (type = _jsond_number)
Move (_JSONNumber(Self, v)) to sValue
Case Break
Case (type = _jsond_object)
Get Serialize of v to sValue
Case Break
Case (type = _jsond_array)
Get _ArrayCast v to va
Move (SizeOfArray(va)-1) to iLastElement
Move "[" to sValue
For ii from 0 to iLastElement
Get _Type "" va[ii] to child_type
If (child_type = _jsond_null) Begin
Append sValue ("null" + If(ii < iLastElement,',',''))
End
Else If (child_type = _jsond_bool) Begin
Move va[ii] to b
Append sValue (If(ii < iLastElement,',','') + If(b, "true", "false"))
End
Else If (child_type = _jsond_string or child_type = _jsond_unspecified) Begin
Move va[ii] to sChildValue
Send _Escape (&sChildValue)
Append sValue ('"' + sChildValue + '"' + If(ii < iLastElement,',',''))
End
Else If (child_type = _jsond_number) Begin
Move va[ii] to sChildValue
Append sValue (_JSONNumber(Self, sChildValue) + If(ii < iLastElement,',',''))
End
Else If (child_type = _jsond_object) Begin
Get Serialize of va[ii] to sChildValue
Append sValue (sChildValue + If(ii < iLastElement,',',''))
End
Loop
Append sValue "]"
Case Break
Case (type = _jsond_object_array)
Get _ArrayCast v to va
Move (SizeOfArray(va)-1) to iLastElement
Move "[" to sValue
For ii from 0 to iLastElement
If (va[ii] <= 0) Move "{}" to sChildValue
else Get Serialize of va[ii] to sChildValue
Append sValue (sChildValue + If(ii < iLastElement,',',''))
Loop
Append sValue "]"
Case Break
Case End
Append sJSON ('"' + sKey + '":' + sValue + If(i < iLastKey,',',''))
Loop
Append sJSON '}'
End_Procedure
{ Visibility=Public }
Procedure Set MicrosoftDateValue String sKey DateTime dt
TimeSpan ts
Real ms
DateTime dt1970
If (IsNullDateTime(dt) or DateGetYear(dt) < 1970) Begin
Set Value sKey to "/Date(0)/"
End
Else Begin
Move (DateSetYear(dt1970, 1970)) to dt1970
Move (DateSetMonth(dt1970, 1)) to dt1970
Move (DateSetDay(dt1970, 1)) to dt1970
Move (dt - dt1970) to ts
Move (SpanTotalMilliseconds(ts)) to ms
Set Value sKey to ("/Date(" + String(ms) + ")/")
End
End_Procedure
{ Visibility=Public }
Procedure Set TypedValue String sKey _jsond_type type Variant vValue
String sValueKey
Forward Set Value sKey to vValue
If (type = _jsond_unspecified) Procedure_Return
Get _ValueKey sKey to sValueKey
Set Value sValueKey to type
End_Procedure
{ Visibility=Public }
Procedure Set StringValue String sKey String sValue
Set TypedValue sKey _jsond_string to sValue
End_Procedure
{ Visibility=Public }
Function StringValue String sKey Returns String
String sRetVal
Get Value sKey to sRetVal
Function_Return sRetVal
End_Function
{ Visibility=Public }
Procedure Set NumericValue String sKey Number nValue
Set TypedValue sKey _jsond_number to nValue
End_Procedure
{ Visibility=Public }
Function NumericValue String sKey Returns Number
Number nRetVal
Get Value sKey to nRetVal
Function_Return nRetVal
End_Function
{ Visibility=Public }
Procedure Set BooleanValue String sKey Boolean bValue
Set TypedValue sKey _jsond_bool to bValue
End_Procedure
{ Visibility=Public }
Function BooleanValue String sKey Returns Boolean
Boolean bRetVal
Get Value sKey to bRetVal
Function_Return bRetVal
End_Function
{ Visibility=Public }
Procedure Set ArrayValue String sKey Variant vArray
Set TypedValue sKey _jsond_array to vArray
End_Procedure
{ Visibility=Public }
Function ArrayValue String sKey Returns Variant
Variant vRetVal
Get Value sKey to vRetVal
Function_Return vRetVal
End_Function
{ Visibility=Public }
Procedure Set ObjectValue String sKey Handle hJsonDictionary
Set TypedValue sKey _jsond_object to hJsonDictionary
End_Procedure
{ Visibility=Public }
Function ObjectValue String sKey Returns Handle
Handle hRetVal
Get Value sKey to hRetVal
Function_Return hRetVal
End_Function
{ Visibility=Public }
Procedure Set ObjectArrayValue String sKey Handle[] haJsonDictionaries
Set TypedValue sKey _jsond_object_array to haJsonDictionaries
End_Procedure
{ Visibility=Public }
Function ObjectArrayValue String sKey Returns Handle[]
Handle[] haRetVal
Get Value sKey to haRetVal
Function_Return haRetVal
End_Function
{ Visibility=Public }
Function TypeForValue String sKey Returns _jsond_type
_jsond_type type
Get Value (_ValueKey(Self, sKey)) to type
If (not(Found)) Function_Return _jsond_unspecified
Function_Return type
End_Function
{ Visibility=Public }
Function ValueAtPath String sPath Returns Variant
tRegexMatch[] keys
tRegexMatch key
Integer i iMax iIdx
Variant v
Variant[] va
String sArrKey
Get Regex_Match sPath "[^\.]+(?=(\.|$))" True to keys
Move (Self) to v
Move (SizeOfArray(keys)-1) to iMax
For i from 0 to iMax
Send Ignore_Error of Error_Object_Id DFERR_BAD_SYMBOL_EXPRESSION
Send Ignore_Error of Error_Object_Id DFERR_ILLEGAL_CONVERSION
Send Ignore_Error of Error_Object_Id DFERR_ARRAY_INDEX_OUT_OF_BOUNDS
Move False to Err
Move keys[i] to key
If (Regex_IsMatch(key.Val, "\[\d+\]")) Begin
Move (Regex_Replace(key.Val, "", "\[\d+\]", True)) to sArrKey
Move (Regex_Replace(key.Val, "", ".*\[|\]", True)) to iIdx
Get Value of v sArrKey to v
If (not(Found)) Function_Return NULL_ENTRY
Move v to va
Move va[iIdx] to v
End
Else Begin
Get Value of v key.Val to v
If (not(Found)) Function_Return NULL_ENTRY
End
Send Trap_Error of Error_Object_Id DFERR_BAD_SYMBOL_EXPRESSION
Send Trap_Error of Error_Object_Id DFERR_ILLEGAL_CONVERSION
Send Trap_Error of Error_Object_Id DFERR_ARRAY_INDEX_OUT_OF_BOUNDS
If (Err) Begin
Move False to Found
Function_Return NULL_ENTRY
End
Loop
Move True to Found
Function_Return v
End_Function
Function Keys Returns String[]
String[] sa saFiltered
Integer i iFilteredIdx iLastKey
Forward Get Keys to sa
Move (SizeOfArray(sa)-1) to iLastKey
For i from 0 to iLastKey
If (not(_IsValueKey(Self, sa[i]))) Begin
Move sa[i] to saFiltered[iFilteredIdx]
Increment iFilteredIdx
End
Loop
Function_Return saFiltered
End_Function
{ Visibility=Public }
Function Serialize Returns String
String sJSON
Handle hPreviousErrorSystem
Move Error_Object_Id to hPreviousErrorSystem
Move (Create(Self,U__cJSONDictionaryErrorSystem)) to Error_Object_Id
Move "" to sJSON
Send _Serialize (Keys(Self)) (&sJSON)
Send Destroy of Error_Object_Id
Move hPreviousErrorSystem to Error_Object_Id
Function_Return sJSON
End_Function
End_Class