*=================================================================== * Package: CWBASE * Class: CWJSN * Source: Implementation * Version: 01.00.00 * * Dependencies: * * CTBASE Version 01.00.00 * * -------------------------------------------------------------------------- * Copyright 2014 Clarasoft I.T. Solutions Inc. *=========================================================================== HDatEdit(*YMD) HNoMain /Include QINCSRC,CWBASE DJSON_TOK_LBRACE... D C Const(1) DJSON_TOK_RBRACE... D C Const(2) DJSON_TOK_LBRACKET... D C Const(3) DJSON_TOK_RBRACKET... D C Const(4) DJSON_TOK_COLON... D C Const(5) DJSON_TOK_COMMA... D C Const(6) DJSON_TOK_STRING... D C Const(7) DJSON_TOK_LITTERAL... D C Const(8) DCPAVL_PRIVATE_Clear... D PR 10I 0 D#This * DCPAVL_PRIVATE_Constructor... D PR 10I 0 D#This * DCPAVL_PRIVATE_Destructor... D PR 10I 0 D#This * DCPAVL_PRIVATE_DoubleLeftRotation... D PR * D@This * Value DCPAVL_PRIVATE_DoubleRightRotation... D PR * D@This * Value DCPAVL_PRIVATE_Find... D PR 10I 0 D@This * Value D@Key 255A Value DCPAVL_PRIVATE_Height... D PR 10I 0 D@This * Value DCPAVL_PRIVATE_Insert... D PR * D@This * Value D@Key 255A Value D@Value * Value D@Bytes 10I 0 Value DCPAVL_PRIVATE_Keys... D PR 10I 0 D@This * Value D@List * Value DCPAVL_PRIVATE_Retrieve... D PR 10I 0 D@This * Value D@Key 255A Value D@Value * Value D@Bytes 10I 0 DCPAVL_PRIVATE_RetrieveSize... D PR 10I 0 D#This * Value D#Key 255A Value DCPAVL_PRIVATE_SingleLeftRotation... D PR * D@This * Value DCPAVL_PRIVATE_SingleRightRotation... D PR * D@This * Value DCPAVL_PRIVATE_MemCpy... D PR ExtProc('memcpy') D@To * Value D@From * Value D@Len 10I 0 Value DCTMAP_Clear... D PR 10I 0 D@This * DCTMAP_Constructor... D PR * DCTMAP_Destructor... D PR 10I 0 D@This * DCTMAP_Insert... D PR 10I 0 D@This * D@Key 255A Value D@Value * Value D@Bytes 10I 0 Value DCTMAP_ItemSize... D PR 10I 0 D#This * D#Key 255A Value DCTMAP_IterNext... D PR 10I 0 D@This * D@Key 255A D@Value * Value D@Size 10I 0 DCTMAP_IterNextSize... D PR 10I 0 D@This * DCTMAP_IterStart... D PR 10I 0 D@This * DCTMAP_LookUp... D PR 10I 0 D@This * D@Key 255A Value D@Value * Value D@Size 10I 0 DCTMAP_Map DS D#AvlTree * D#KeyList * D#IterCurrent 10I 0 D CPAVL_Tree DS Qualified D#Left * D#Right * D#Height 10I 0 D#Key 255A D#Value * D#Bytes 10I 0 DCWJSN_PRIVATE_A... D PR 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value DCWJSN_PRIVATE_ArrayValue... D PR 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value D@ItemIndex 10I 0 Value DCWJSN_PRIVATE_ClearResources... D PR 10I 0 D@This * Value DCWJSN_PRIVATE_IsNumeric... D PR 10I 0 D@This * Value D@Value 255A DCWJSN_PRIVATE_Ls... D PR 10I 0 D@This * Value D@DirPath 255A Value D@DirEntry LikeDS(CWJSN_PRV_DirEntry) DCWJSN_PRIVATE_MaterializeObject... D PR 10I 0 D@This * Value DCWJSN_PRIVATE_MemCpy... D PR ExtProc('memcpy') D@To * Value D@From * Value D@Len 10I 0 Value DCWJSN_PRIVATE_O... D PR 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value DCWJSN_PRIVATE_Serialize... D PR 10I 0 D@This * Value D@Path 255A Value D@Type 10I 0 Value D@pStr * Value DCWJSN_PRIVATE_Tokenize... D PR 10I 0 D@This * Value D@JsonStr * Value DCWJSN_PRIVATE_VV... D PR 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value D@Listing * Value DCWJSN_PRV_DirEntry... D DS Qualified DPath 255A DType 10I 0 DNumItems 10I 0 DListing * DCWJSN_Instance DS Qualified DpTokens * DpTemp * DpTokTypes * DpValTypes * DpObject * DpDirectory * DpValues * DpValuePaths * *------------------------------------------------------------------------------- PCWJSN_Constructor... P B Export D PI * DThis S * DInstance DS LikeDs(CWJSN_Instance) Based(This) /Free This = %Alloc(%Size(CWJSN_Instance)); Instance.pTokens = CTBUFFLST_Constructor(); Instance.pValues = CTBUFFLST_Constructor(); Instance.pTemp = CTBUFF_Constructor(); Instance.pTokTypes = CTLST_Constructor(); Instance.pValTypes = CTLST_Constructor(); Instance.pValuePaths = CTBUFFLST_Constructor(); Instance.pObject = CTMAP_Constructor(); Instance.pDirectory = CTMAP_Constructor(); Return This; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Destructor... P B Export D PI 10I 0 D@This * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) /Free CWJSN_PRIVATE_ClearResources(@This); CTBUFFLST_Destructor(Instance.pTokens); CTBUFFLST_Destructor(Instance.pValues); CTBUFF_Destructor(Instance.pTemp); CTLST_Destructor(Instance.pTokTypes); CTLST_Destructor(Instance.pValTypes); CTBUFFLST_Destructor(Instance.pValuePaths); CTMAP_Destructor(Instance.pObject); CTMAP_Destructor(Instance.pDirectory); Dealloc @This; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Init... P B Export D PI 10I 0 D@This * Value D@Type 10I 0 Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DKey S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DJsonNode DS LikeDS(CWJSN_Node) DValueNode DS LikeDS(CWJSN_Node) /Free CWJSN_PRIVATE_ClearResources(@This); CTLST_Clear(Instance.pValTypes); CTMAP_Clear(Instance.pObject); CTMAP_Clear(Instance.pDirectory); If @Type = JSON_TYPE_ARRAY Or @Type = JSON_TYPE_OBJECT; DirEntry.Path = '/'; DirEntry.Type = @Type; DirEntry.NumItems = 0; DirEntry.Listing = CTMAP_Constructor(); Key = '/'; CTMAP_Insert(Instance.pDirectory: Key: %Addr(DirEntry): %Size(DirEntry)); JsonNode.Type = @Type; JsonNode.Size = 1; JsonNode.Path = '/'; JsonNode.pValue = *Null; CTMAP_Insert(Instance.pObject: Key: %Addr(JsonNode): %Size(JsonNode)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_InsertBool... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Label 255A Value D@Value N Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 DKey S 255A DTrue S 4A Inz('true') DFalse S 5A Inz('false') DJsonNode DS LikeDS(CWJSN_Node) DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DListEntry DS LikeDS(CWJSN_ListEntry) /Free Rc = CWJSN_TypeOf(@This: @Path: -1); Select; When Rc = JSON_TYPE_ARRAY; JsonNode.Type = JSON_TYPE_BOOL; If @Value = *On; JsonNode.Size = 4; JsonNode.pValue = %Alloc(4); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(True): 4); Else; JsonNode.Size = 5; JsonNode.pValue = %Alloc(5); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(False): 5); EndIf; CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); If @Path = '/'; JsonNode.Path = '/' + %Char(DirEntry.NumItems); Else; JsonNode.Path = %Trim(@Path) + '/' + %Char(DirEntry.NumItems); EndIf; CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; When Rc = JSON_TYPE_OBJECT; If @Path = '/'; Key = '/' + @Label; Else; Key = %Trim(@Path) + '/' + @Label; EndIf; // Key must not already exist Bytes = %Size(JsonNode); Rc = CTMAP_Lookup(Instance.pObject: Key: %Addr(JsonNode): Bytes); If Rc = CS_FAILURE; // Value does not already exist JsonNode.Path = Key; JsonNode.Type = JSON_TYPE_BOOL; If @Value = *On; JsonNode.Size = 4; JsonNode.pValue = %Alloc(4); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(True): 4); Else; JsonNode.Size = 5; JsonNode.pValue = %Alloc(5); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(False): 5); EndIf; CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); ListEntry.Value = @Label; ListEntry.Type = JSON_TYPE_BOOL; CTMAP_Insert(DirEntry.Listing: ListEntry.Value: %Addr(ListEntry): %Size(ListEntry)); // Update directory item count DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Other; Rc = CS_FAILURE; EndSl; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_InsertNull... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Label 255A Value DListEntry DS LikeDS(CWJSN_ListEntry) DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 DKey S 255A DNull S 4A Inz('null') DJsonNode DS LikeDS(CWJSN_Node) DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) /Free Rc = CWJSN_TypeOf(@This: @Path: -1); Select; When Rc = JSON_TYPE_ARRAY; JsonNode.Type = JSON_TYPE_NULL; JsonNode.Size = 4; CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); If @Path = '/'; JsonNode.Path = '/' + %Char(DirEntry.NumItems); Else; JsonNode.Path = %Trim(@Path) + '/' + %Char(DirEntry.NumItems); EndIf; JsonNode.pValue = %Alloc(4); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(Null): 4); CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; When Rc = JSON_TYPE_OBJECT; If @Path = '/'; Key = '/' + @Label; Else; Key = %Trim(@Path) + '/' + @Label; EndIf; // Key must not already exist Bytes = %Size(JsonNode); Rc = CTMAP_Lookup(Instance.pObject: Key: %Addr(JsonNode): Bytes); If Rc = CS_FAILURE; // Value does not already exist JsonNode.Path = Key; JsonNode.Type = JSON_TYPE_NULL; JsonNode.Size = 4; JsonNode.pValue = %Alloc(4); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(Null): 4); CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); ListEntry.Type = JSON_TYPE_NULL; ListEntry.Value = @Label; CTMAP_Insert(DirEntry.Listing: ListEntry.Value: %Addr(ListEntry): %Size(ListEntry)); // Update directory item count DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Other; Rc = CS_FAILURE; EndSl; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_InsertNumeric... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Label 255A Value D@Value 32A Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 DKey S 255A DJsonNode DS LikeDS(CWJSN_Node) DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DListEntry DS LikeDS(CWJSN_ListEntry) /Free Rc = CWJSN_TypeOf(@This: @Path: -1); Select; When Rc = JSON_TYPE_ARRAY; JsonNode.Type = JSON_TYPE_NUMERIC; JsonNode.Size = %Len(%Trim(@Value)); CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); If @Path = '/'; JsonNode.Path = '/' + %Char(DirEntry.NumItems); Else; JsonNode.Path = %Trim(@Path) + '/' + %Char(DirEntry.NumItems); EndIf; JsonNode.pValue = %Alloc(JsonNode.Size); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(@Value): JsonNode.Size); CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; When Rc = JSON_TYPE_OBJECT; If @Path = '/'; Key = '/' + @Label; Else; Key = %Trim(@Path) + '/' + @Label; EndIf; // Key must not already exist Bytes = %Size(JsonNode); Rc = CTMAP_Lookup(Instance.pObject: Key: %Addr(JsonNode): Bytes); If Rc = CS_FAILURE; // Value does not already exist JsonNode.Path = Key; JsonNode.Type = JSON_TYPE_NUMERIC; JsonNode.Size = %Len(%Trim(@Value)); JsonNode.pValue = %Alloc(255); CWJSN_PRIVATE_MemCpy(JsonNode.pValue: %Addr(@Value): 255); CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); ListEntry.Value = @Label; ListEntry.Type = JSON_TYPE_NUMERIC; CTMAP_Insert(DirEntry.Listing: ListEntry.Value: %Addr(ListEntry): %Size(ListEntry)); // Update directory item count DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Other; Rc = CS_FAILURE; EndSl; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_InsertString... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Label 255A Value D@Value * Value D@Size 10I 0 Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DpInString S * DpOutString S * DRc S 10I 0 Dn S 10I 0 DBytes S 10I 0 DKey S 255A DJsonNode DS LikeDS(CWJSN_Node) DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DListEntry DS LikeDS(CWJSN_ListEntry) DCurChar DS Qualified DCode 3U 0 DGlyph 1A Overlay(Code) DBackSlash S 1A Inz('\') /Free Rc = CWJSN_TypeOf(@This: @Path: -1); Select; When Rc = JSON_TYPE_ARRAY; ExSr SrEscapeQuotes; JsonNode.Type = JSON_TYPE_STRING; JsonNode.Size = @Size; CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); If @Path = '/'; JsonNode.Path = '/' + %Char(DirEntry.NumItems); Else; JsonNode.Path = %Trim(@Path) + '/' + %Char(DirEntry.NumItems); EndIf; Rc = CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); If Rc = CS_SUCCESS; // Update parent directory DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; When Rc = JSON_TYPE_OBJECT; If @Path = '/'; Key = '/' + @Label; Else; Key = %Trim(@Path) + '/' + @Label; EndIf; // Key must not already exist Bytes = %Size(JsonNode); Rc = CTMAP_Lookup(Instance.pObject: Key: %Addr(JsonNode): Bytes); If Rc = CS_FAILURE; // Value does not already exist ExSr SrEscapeQuotes; JsonNode.Path = Key; JsonNode.Type = JSON_TYPE_STRING; JsonNode.Size = @Size; CTMAP_Insert(Instance.pObject: JsonNode.Path: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); ListEntry.Value = @Label; ListEntry.Type = JSON_TYPE_STRING; CTMAP_Insert(DirEntry.Listing: ListEntry.Value: %Addr(ListEntry): %Size(ListEntry)); // Update directory item count DirEntry.NumItems = DirEntry.NumItems + 1; CTMAP_Insert(Instance.pDirectory: @Path: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Other; Rc = CS_FAILURE; EndSl; Return Rc; BegSr SrEscapeQuotes; // We must escape double quotes pInString = CTBUFF_Constructor(); pOutString = CTBUFF_Constructor(); CTBUFF_Set(pInString: @Value: @Size); CTBUFF_Set(pOutString: *Null: 0); For n=1 To @Size By 1; CurChar.Code = CTBUFF_ByteAt(pInString: n); If CurChar.Glyph = '"'; CTBUFF_Cat(pOutString: %Addr(BackSlash): 1); EndIf; CTBUFF_Cat(pOutString: %Addr(CurChar.Glyph): 1); EndFor; Bytes = CTBUFF_Length(pOutString); If Bytes > 0; JsonNode.pValue = %Alloc(Bytes); CTBUFF_Get(pOutString: JsonNode.pValue: 1: Bytes); Else; JsonNode.pValue = *Null; EndIf; @Size = Bytes; CTBUFF_Destructor(pInString); CTBUFF_Destructor(pOutString); EndSr; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Lookup... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Index 10I 0 Value D@JsonNode LikeDS(CWJSN_Node) DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 DpTempBuff S * DKey S 255A DOutNode DS LikeDS(CWJSN_Node) /Free If @JsonNode.pValue <> *Null; pTempBuff = @JsonNode.pValue; CTBUFF_Set(pTempBuff: *Null: 0); EndIf; Bytes = %Size(CWJSN_Node); Rc = CTMAP_Lookup(Instance.pObject: @Path: %Addr(OutNode): Bytes); If Rc = CS_SUCCESS; If OutNode.Type = JSON_TYPE_ARRAY; If @Index >= 0; If %Trim(@Path) <> '/'; Key = %Trim(@Path) + '/' + %Char(@Index); Else; Key = %Trim(@Path) + %Char(@Index); EndIf; Bytes = %Size(CWJSN_Node); Rc = CTMAP_Lookup(instance.pObject: Key: %Addr(OutNode): Bytes); If Rc = CS_SUCCESS; If pTempBuff <> *Null; Bytes = OutNode.Size; CTBUFF_Set(pTempBuff: OutNode.pValue: Bytes); EndIf; OutNode.pValue = pTempBuff; @JsonNode = OutNode; Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Else; // We want the root object description only OutNode.pValue = pTempBuff; @JsonNode = OutNode; Rc = CS_SUCCESS; EndIf; Else; Rc = CS_SUCCESS; If OutNode.Type = JSON_TYPE_OBJECT; OutNode.pValue = pTempBuff; @JsonNode = OutNode; Else; If pTempBuff <> *Null; CTBUFF_Set(pTempBuff: OutNode.pValue: OutNode.Size); EndIf; OutNode.pValue = pTempBuff; @JsonNode = OutNode; EndIf; EndIf; Else; Rc = CS_FAILURE; EndIf; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Ls... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@PathDesc LikeDS(CWJSN_DirEntry) D@Listing * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 Dn S 10I 0 DBytes S 10I 0 DKey S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DNodeEntry DS LikeDS(CWJSN_Node) DListEntry DS LikeDS(CWJSN_ListEntry) /Free Clear DirEntry; Clear @PathDesc; Bytes = %Size(CWJSN_PRV_DirEntry); Rc = CTMAP_Lookup(Instance.pDirectory: @Path: %Addr(DirEntry): Bytes); If RC = CS_SUCCESS; Rc = CS_SUCCESS; Clear @PathDesc; @PathDesc.Type = DirEntry.Type; @PathDesc.Path = DirEntry.Path; // redundant @PathDesc.NumItems = DirEntry.NumItems; If @Listing <> *Null; CTLST_Clear(@Listing); EndIf; If DirEntry.Type = JSON_TYPE_ARRAY; If @Listing <> *Null; For n=0 To @PathDesc.NumItems-1 By 1; Clear ListEntry; ListEntry.Value = %Char(n); Bytes = %Size(NodeEntry); Rc = CWJSN_Lookup(@This: @Path: n: NodeEntry); ListEntry.Type = NodeEntry.Type; Bytes = %Size(CWJSN_ListEntry); CTLST_Insert(@Listing: %Addr(ListEntry): Bytes: CTLST_BOTTOM); EndFor; EndIf; Else; If DirEntry.Type = JSON_TYPE_OBJECT; If @Listing <> *Null; Bytes = %Size(CWJSN_ListEntry); Clear ListEntry; CTMAP_IterStart(DirEntry.Listing); Dow (CTMAP_IterNext(DirEntry.Listing: Key: %Addr(ListEntry): Bytes) = CS_SUCCESS); CTLST_Insert(@Listing: %Addr(ListEntry): Bytes: CTLST_BOTTOM); Bytes = %Size(CWJSN_ListEntry); Clear ListEntry; EndDo; EndIf; Else; Rc = CS_FAILURE; EndIf; EndIf; Else; Rc = CS_FAILURE; EndIF; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_MkDir... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Label 255A Value D@Type 10I 0 Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DIndex S 10I 0 DKey S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DNewDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DJsonNode DS LikeDS(CWJSN_Node) DListEntry DS LikeDS(CWJSN_ListEntry) /Free // Specified parent directory must exist Rc = CWJSN_TypeOf(@This: @Path: -1); Select; When Rc = JSON_TYPE_ARRAY; // Since this is an array, a new index branch is created CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); Index = DirEntry.NumItems; If @Path = '/'; NewDirEntry.Path = '/' + %Char(Index); Else; NewDirEntry.Path = %Trim(@Path) + '/' + %Char(Index); EndIf; Key = NewDirEntry.Path; NewDirEntry.Type = @Type; NewDirEntry.NumItems = 0; If @Type = JSON_TYPE_OBJECT; NewDirEntry.Listing = CTMAP_Constructor(); Else; NewDirEntry.Listing = *Null; EndIf; CTMAP_Insert(Instance.pDirectory: Key: %Addr(NewDirEntry): %Size(NewDirEntry)); JsonNode.Type = @Type; JsonNode.Size = 1; JsonNode.Path = Key; JsonNode.pValue = *Null; CTMAP_Insert(Instance.pObject: Key: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory DirEntry.NumItems = Index + 1; Key = @Path; CTMAP_Insert(Instance.pDirectory: Key: %Addr(DirEntry): %Size(DirEntry)); Rc = CS_SUCCESS; When Rc = JSON_TYPE_OBJECT; If @Path = '/'; NewDirEntry.Path = '/' + @Label; Else; NewDirEntry.Path = %Trim(@Path) + '/' + @Label; EndIf; // New Directory must not exist Rc = CWJSN_TypeOf(@This: NewDirEntry.Path: -1); If Rc = JSON_TYPE_UNKNOWN; CWJSN_PRIVATE_Ls(@This: @Path: DirEntry); Index = DirEntry.NumItems; Key = NewDirEntry.Path; NewDirEntry.Type = @Type; NewDirEntry.NumItems = 0; If @Type = JSON_TYPE_OBJECT; NewDirEntry.Listing = CTMAP_Constructor(); Else; NewDirEntry.Listing = *Null; EndIf; CTMAP_Insert(Instance.pDirectory: Key: %Addr(NewDirEntry): %Size(NewDirEntry)); JsonNode.Type = @Type; JsonNode.Size = 1; JsonNode.Path = Key; JsonNode.pValue = *Null; CTMAP_Insert(Instance.pObject: Key: %Addr(JsonNode): %Size(JsonNode)); // Update parent directory DirEntry.NumItems = Index + 1; Key = @Path; CTMAP_Insert(Instance.pDirectory: Key: %Addr(DirEntry): %Size(DirEntry)); // This parent dir has a listing (since it is an object) // Add label to listing ListEntry.Value = @Label; ListEntry.Type = @Type; Key = @Label; CTMAP_Insert(DirEntry.Listing: Key: %Addr(ListEntry): %Size(ListEntry)); Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Other; Rc = CS_FAILURE; EndSl; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Parse... P B Export D PI 10I 0 D@This * Value D@pJsonStr * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DIndex S 10I 0 DpPath S * DBytes S 10I 0 DKey S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) /Free pPath = CTBUFF_Constructor(); Rc = CWJSN_PRIVATE_Tokenize(@This: @pJsonStr); If Rc = CS_SUCCESS; CWJSN_PRIVATE_ClearResources(@This); CTLST_Clear(Instance.pValTypes); CTMAP_Clear(Instance.pDirectory); CTMAP_Clear(Instance.pObject); Index = 1; Rc = CWJSN_PRIVATE_O(@This: Index: pPath); If Rc = CS_FAILURE; Rc = CWJSN_PRIVATE_A(@This: Index: pPath); EndIf; If Rc = CS_SUCCESS; Rc = CWJSN_PRIVATE_MaterializeObject(@This); EndIf; EndIf; CTBUFF_Destructor(pPath); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_Serialize... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@pStr * Value DType S 10I 0 /Free //////////////////////////////////////////////////////// // This is just a wrapper to allow the // initialization of the buffer // passed as a parameter. The actual // serialization is recursive and we must // not clear the buffer with each call // since the point is to concatenate recusrsively. //////////////////////////////////////////////////////// CTBUFF_Set(@pStr: *null: 0); Type = CWJSN_TypeOf(@This: @Path: -1); Return CWJSN_PRIVATE_Serialize(@This: @Path: Type: @pStr); /End-Free P E *------------------------------------------------------------------------------- PCWJSN_TypeOf... P B Export D PI 10I 0 D@This * Value D@Path 255A Value D@Index 10I 0 Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 DJsonNode DS LikeDS(CWJSN_Node) /Free Clear JsonNode; Bytes = %Size(CWJSN_Node); Rc = CTMAP_Lookup(Instance.pObject: @Path: %Addr(JsonNode): Bytes); If RC = CS_SUCCESS; Rc = JsonNode.Type; Else; Rc = JSON_TYPE_UNKNOWN; EndIF; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_A... P B D PI 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DpNewPath S * DpNewObjPath S * DBuffer S * DSlash S 1A Inz('/') DType S 10I 0 DBytes S 10I 0 DStart S 10I 0 DCurIndex S 10I 0 DcommaFlag S 10I 0 DszCurIndex S 10A DValue S 255A DDirectory S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) /Free pNewPath = CTBUFF_Constructor(); pNewObjPath = CTBUFF_Constructor(); Rc = CS_SUCCESS; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type = JSON_TOK_LBRACKET; @Index += 1; If (CTBUFF_Length(@pPath) > 0); Buffer = %Alloc(CTBUFF_Length(@pPath)); Bytes = CTBUFF_Length(@pPath); CTBUFF_Get(@pPath: Buffer: 1: Bytes); CTBUFF_Set(pNewPath: Buffer: Bytes); Dealloc Buffer; Else; CTBUFF_Set(pNewPath: %Addr(Slash): 1); EndIf; Start = @Index; CurIndex = 0; commaFlag = 0; Rc = CS_SUCCESS; Dow (Rc = CS_SUCCESS); If (CTBUFF_Length(pNewPath) > 1); // we are not at root Buffer = %Alloc(CTBUFF_Length(pNewPath)); Bytes = CTBUFF_Length(pNewPath); CTBUFF_Get(pNewPath: Buffer: 1: Bytes); CTBUFF_Set(pNewObjPath: Buffer: Bytes); CTBUFF_Cat(pNewObjPath: %Addr(Slash): 1); Dealloc Buffer; Else; CTBUFF_Set(pNewObjPath: %Addr(Slash): 1); EndIf; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: Start); Select; When Type = JSON_TOK_LBRACE; commaFlag = 0; szCurIndex = %Char(curIndex); CTBUFF_Cat(pNewObjPath: %Addr(szCurIndex): %Len(%Trim(szCurIndex))); Rc = CWJSN_PRIVATE_O(@This: Start: pNewObjPath); curIndex += 1; When Type = JSON_TOK_LBRACKET; commaFlag = 0; szCurIndex = %Char(curIndex); CTBUFF_Cat(pNewObjPath: %Addr(szCurIndex): %Len(%Trim(szCurIndex))); Rc = CWJSN_PRIVATE_A(@This: Start: pNewObjPath); curIndex += 1; When Type = JSON_TOK_COMMA; commaFlag = 1; Start += 1; Rc = CS_SUCCESS; When Type = JSON_TOK_RBRACKET; If commaFlag = 0; Value = *Blanks; Directory = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); Directory = Value; CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); Value = *Blanks; Bytes = %Size(Value); CTBUFFLST_InsertValue(Instance.pValues: %Addr(Value): %Size(Value): CTLST_BOTTOM); Type = JSON_TYPE_ARRAY; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); DirEntry.Path = Directory; DirEntry.Type = JSON_TYPE_ARRAY; DirEntry.NumItems = curIndex; DirEntry.Listing = CTMAP_Constructor(); CTMAP_Insert(Instance.pDirectory: Directory: %Addr(DirEntry): %Size(DirEntry)); @Index = Start+1; Rc = CS_SUCCESS; Leave; Else; Rc = CS_FAILURE; EndIf; Other; commaFlag = 0; Rc = CWJSN_PRIVATE_ArrayValue(@This: Start: pNewObjPath: CurIndex); curIndex += 1; EndSl; If Rc = CS_SUCCESS; Else; Leave; EndIf; EndDo; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; CTBUFF_Destructor(pNewPath); CTBUFF_Destructor(pNewObjPath); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_ArrayValue... P B D PI 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value D@ItemIndex 10I 0 Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DValue S 255A DType S 10I 0 DBytes S 10I 0 DpNewPath S * DpValue S * DBuffer S * DszItemIndex S 10A /Free pNewPath = CTBUFF_Constructor(); Rc = CS_SUCCESS; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type = JSON_TOK_STRING Or Type = JSON_TOK_LITTERAL; // Type If Type = JSON_TOK_LITTERAL; Value = *Blanks; Bytes = %Size(Value); Rc = CTBUFFLST_GetValue(Instance.pTokens: %Addr(Value): Bytes: @Index); Select; When Value = 'true'; Type = JSON_TYPE_BOOL; Rc = CS_SUCCESS; When Value = 'false'; Type = JSON_TYPE_BOOL; Rc = CS_SUCCESS; When Value = 'null'; Type = JSON_TYPE_NULL; Rc = CS_SUCCESS; Other; Type = JSON_TYPE_NUMERIC; Rc = CWJSN_PRIVATE_IsNumeric(@This: Value); EndSl; Else; Type = JSON_TYPE_STRING; Rc = CS_SUCCESS; EndIf; If Rc = CS_SUCCESS; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); If (CTBUFF_Length(@pPath) > 0); Buffer = %Alloc(CTBUFF_Length(@pPath)); Bytes = CTBUFF_Length(@pPath); CTBUFF_Get(@pPath: Buffer: 1: Bytes); CTBUFF_Set(pNewPath: Buffer: Bytes); Dealloc Buffer; EndIf; szItemIndex = %Char(@ItemIndex); CTBUFF_Cat(pNewPath: %Addr(szItemIndex): %Len(%Trim(szItemIndex))); // Cle Value = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); // Valeur Bytes = CTBUFFLST_BuffLength(Instance.pTokens: @Index); pValue = %Alloc(Bytes); CTBUFFLST_GetValue(Instance.pTokens: pValue: Bytes: @Index); CTBUFFLST_InsertValue(Instance.pValues: pValue: Bytes: CTLST_BOTTOM); Dealloc pValue; @Index += 1; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; CTBUFF_Destructor(pNewPath); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_ClearResources... P B D PI 10I 0 D@This * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DBytes S 10I 0 DKey S 255A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) DValueNode DS LikeDS(CWJSN_Node) /Free CTMAP_IterStart(Instance.pObject); Bytes = %Size(ValueNode); Clear ValueNode; Dow (CTMAP_IterNext(Instance.pObject: Key: %Addr(ValueNode): Bytes) = CS_SUCCESS); If ValueNode.pValue <> *Null; Dealloc ValueNode.pValue; EndIf; Bytes = %Size(ValueNode); Clear ValueNode; EndDo; CTMAP_IterStart(Instance.pDirectory); Bytes = %Size(DirEntry); Clear DirEntry; Dow (CTMAP_IterNext(Instance.pDirectory: Key: %Addr(DirEntry): Bytes) = CS_SUCCESS); If DirEntry.Listing <> *Null; CTMAP_Destructor(DirEntry.Listing); EndIf; Bytes = %Size(DirEntry); Clear DirEntry; EndDo; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_IsNumeric... P B D PI 10I 0 D@This * Value D@Value 255A DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 Dn S 10I 0 DLen S 10I 0 DdotFlag S 10I 0 DBuffer S 255A DpStr S * DChar DS Qualified DCode 3U 0 DGlyph 1A Overlay(Code) /Free Rc = CS_SUCCESS; pStr = CTBUFF_Constructor(); Buffer = @Value; Len = %Len(%TRim(Buffer)); CTBUFF_Set(pStr: %Addr(Buffer): Len); n = 1; // Check first char Char.Code = CTBUFF_ByteAt(pStr: n); If Char.Glyph = '-'; // We can ignore the minus sign at the \ // beginning of the value n += 1; If n <= Len; Char.Code = CTBUFF_ByteAt(pStr: n); Else; Rc = CS_FAILURE; EndIf; EndIf; If Rc = CS_SUCCESS; If Char.Glyph = '0'; // Next character must be dot or else it's // an invalid numerical value n += 1; If n <= Len; Char.Code = CTBUFF_ByteAt(pStr: n); If Char.Glyph = '.'; n += 1; If n <= Len; Char.Code = CTBUFF_ByteAt(pStr: n); Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; // This means that the number is simply zero Rc = CS_SUCCESS; EndIf; EndIf; EndIf; If Rc = CS_SUCCESS And n <= Len; dotFlag = 0; Dow 1=1; // Must be a digit from 1 to 9 If Char.Code >= 240 And Char.Code <= 249 ; n += 1; Else; If Char.Glyph = '.'; If dotFlag = 0; dotFlag = 1; n += 1; Else; Rc = CS_FAILURE; Leave; EndIf; Else; Rc = CS_FAILURE; Leave; EndIf; EndIf; If n <= Len; Char.Code = CTBUFF_ByteAt(pStr: n); Else; Leave; EndIf; EndDo; // Make sure litteral does not end with a period and no // decimal positions If Rc = CS_SUCCESS; If Char.Glyph = '.'; Rc = CS_FAILURE; EndIf; EndIf; EndIf; CTBUFF_Destructor(pStr); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_Ls... P B D PI 10I 0 D@This * Value D@Path 255A Value D@DirEntry LikeDS(CWJSN_PRV_DirEntry) DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DBytes S 10I 0 /Free Clear @DirEntry; Bytes = %Size(CWJSN_PRV_DirEntry); Rc = CTMAP_Lookup(Instance.pDirectory: @Path: %Addr(@DirEntry): Bytes); If Rc = CS_SUCCESS; Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_MaterializeObject... P B D PI 10I 0 D@This * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 Dn S 10I 0 DBytes S 10I 0 DNumValues S 10I 0 DpMap S * DBuffer S 255A DKey S 255A DValueNode DS LikeDS(CWJSN_Node) /Free NumValues = CTBUFFLST_Count(Instance.pValues); For n=1 To NumValues By 1; Clear ValueNode; Bytes = 255; CTBUFFLST_GetValue(Instance.pValuePaths: %Addr(ValueNode.Path): Bytes: n); Bytes = %Size(ValueNode.Type); CTLST_Get(Instance.pValTypes: %Addr(ValueNode.Type): Bytes: n); // No size limit value Bytes = CTBUFFLST_BuffLength(Instance.pValues: n); ValueNode.pValue = %Alloc(Bytes); CTBUFFLST_GetValue(Instance.pValues: ValueNode.pValue: Bytes: n); ValueNode.Size = Bytes; CTMAP_Insert(Instance.pObject: ValueNode.Path: %Addr(ValueNode): %Size(ValueNode)); EndFor; // Release resources CTBUFFLST_Clear(Instance.pValues); CTBUFFLST_Clear(Instance.pValuePaths); CTBUFFLST_Clear(Instance.pTokens); CTLST_Clear(Instance.pValTypes); CTLST_Clear(Instance.pTokTypes); Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_O... P B D PI 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DType S 10I 0 DBytes S 10I 0 Dvv S 10I 0 DpNewPath S * DBuffer S * DListing S * DValue S 255A DDirectory S 255A DSlash S 1A DDirEntry DS LikeDS(CWJSN_PRV_DirEntry) /Free pNewPath = CTBUFF_Constructor(); vv = 0; Rc = CS_SUCCESS; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If (CTBUFF_Length(@pPath) > 0); Buffer = %Alloc(CTBUFF_Length(@pPath)); Bytes = CTBUFF_Length(@pPath); CTBUFF_Get(@pPath: Buffer: 1: Bytes); CTBUFF_Set(pNewPath: Buffer: Bytes); Dealloc Buffer; Else; Slash = '/'; CTBUFF_Set(pNewPath: %Addr(Slash): 1); EndIf; If Rc = CS_SUCCESS; If Type = JSON_TOK_LBRACE; @Index += 1; Listing = CTMAP_Constructor(); Dow CWJSN_PRIVATE_VV(@This: @Index: @pPath: Listing) = CS_SUCCESS; vv += 1; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type <> JSON_TOK_COMMA; Leave; Else; @Index += 1; EndIf; Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; Leave; EndIf; EndDo; If Rc = CS_SUCCESS; // We have a directory entry (and a number of items) Buffer = %Alloc(CTBUFF_Length(pNewPath)); Directory = *Blanks; Bytes = 255; CTBUFF_Get(pNewPath: %Addr(Directory): 1: Bytes); DirEntry.Path = Directory; DirEntry.Type = JSON_TYPE_OBJECT; DirEntry.NumItems = vv; DirEntry.Listing = Listing; CTMAP_Insert(Instance.pDirectory: Directory: %Addr(DirEntry): %Size(DirEntry)); Dealloc Buffer; If vv > 0; If Type = JSON_TOK_RBRACE; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index-1); If Rc = CS_SUCCESS; If Type = JSON_TOK_COMMA; Rc = CS_FAILURE; Else; // Dummy value, just to keep array indices in synch Value = *Blanks; Bytes = %Size(Value); CTBUFFLST_InsertValue(Instance.pValues: %Addr(Value): %Size(Value): CTLST_BOTTOM); // Type Type = JSON_TYPE_OBJECT; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); Value = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); @Index += 1; Rc = CS_SUCCESS; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type = JSON_TOK_RBRACE; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index-1); If Rc = CS_SUCCESS; If Type = JSON_TOK_COMMA; Rc = CS_FAILURE; Else; // Dummy value, just to keep array indices in synch Value = *Blanks; Bytes = %Size(Value); CTBUFFLST_InsertValue(Instance.pValues: %Addr(Value): %Size(Value): CTLST_BOTTOM); // Type Type = JSON_TYPE_OBJECT; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); Value = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); @Index += 1; Rc = CS_SUCCESS; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; EndIf; Else; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type = JSON_TOK_RBRACE; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index-1); If Type = JSON_TOK_COMMA; Rc = CS_FAILURE; Else; // Dummy value, just to keep array indices in synch Value = *Blanks; Bytes = %Size(Value); CTBUFFLST_InsertValue(Instance.pValues: %Addr(Value): %Size(Value): CTLST_BOTTOM); // Type Type = JSON_TYPE_OBJECT; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM) ; Value = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); @Index += 1; Rc = CS_SUCCESS; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; CTBUFF_Destructor(pNewPath); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_Serialize... P B D PI 10I 0 D@This * Value D@Path 255A Value D@Type 10I 0 Value D@pStr * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DpListing S * DRc S 10I 0 Dn S 10I 0 Dk S 10I 0 DBytes S 10I 0 DDoubleQuote S 1A Inz('"') DColon S 1A Inz(':') DComma S 1A Inz(',') DOpenToken S 1A DCloseToken S 1A DValue S 255A DszPath S 255A DpSource S * DpTarget S * DpBufferFrom S * DpBufferTo S * DValueBuff S * DCharAtFrom S 1A Based(pBufferFrom) DCharAtTo S 1A Based(pBufferTo) DDirEntry DS LikeDS(CWJSN_DirEntry) DListEntry DS LikeDS(CWJSN_ListEntry) DJsonNode DS LikeDS(CWJSN_Node) /Free pListing = CTLST_Constructor(); If @Type = JSON_TYPE_OBJECT; OpenToken = '{'; CTBUFF_Cat(@pStr: %Addr(OpenToken): 1); CWJSN_Ls(@This: @Path: DirEntry: pListing); For n=1 To DirEntry.NumItems By 1; Bytes = %Size(ListEntry); CTLST_Get(pListing: %Addr(ListEntry): Bytes: n); CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); //Clear Value; Value = ListEntry.Value; Bytes = %Len(%Trim(Value)); CTBUFF_Cat(@pStr: %Addr(Value): Bytes); CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); CTBUFF_Cat(@pStr: %Addr(Colon): 1); If (@Path = '/'); szPath = %Trim(@Path) + Value; Else; szPath = %Trim(@Path) + '/' + Value; EndIf; Select; When ListEntry.Type = JSON_TYPE_ARRAY; Rc = CWJSN_PRIVATE_Serialize(@This: szPath: ListEntry.Type: @pStr); When ListEntry.Type = JSON_TYPE_OBJECT; Rc = CWJSN_PRIVATE_Serialize(@This: szPath: ListEntry.Type: @pStr); Other; ValueBuff = CTBUFF_Constructor(); JsonNode.pValue = ValueBuff; CWJSN_Lookup(@This: szPath: -1: JsonNode); Bytes = CTBUFF_Length(ValueBuff); If ListEntry.Type = JSON_TYPE_STRING; CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); // Escape all double quotes If Bytes > 0; pSource = %Alloc(Bytes); pBufferFrom = pSource; pTarget = %Alloc(2 * Bytes); pBufferTo = pTarget; CTBUFF_Get(ValueBuff: pSource: 1: Bytes); Bytes = 0; For k=1 To JsonNode.Size By 1; If CharAtFrom = '"'; CharAtTo = '\'; pBufferTo +=1; Bytes += 1; EndIf; CharAtTo = CharAtFrom; pBufferFrom += 1; pBufferTo +=1; Bytes += 1; EndFor; Dealloc pSource; CTBUFF_Cat(@pStr: pTarget: Bytes); Dealloc pTarget; EndIf; CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); Else; CTBUFF_BuffCat(@pStr: ValueBuff); EndIf; CTBUFF_Destructor(ValueBuff); Rc = CS_SUCCESS; EndSl; If Rc = CS_FAILURE; Leave; Else; If n < DirEntry.NumItems; CTBUFF_Cat(@pStr: %Addr(Comma): 1); EndIf; EndIf; EndFor; CloseToken = '}'; CTBUFF_Cat(@pStr: %Addr(CloseToken): 1); Else; If @Type = JSON_TYPE_ARRAY; OpenToken = '['; CTBUFF_Cat(@pStr: %Addr(OpenToken): 1); CWJSN_Ls(@This: @Path: DirEntry: pListing); For n=1 To DirEntry.NumItems By 1; Bytes = %Size(ListEntry); CTLST_Get(pListing: %Addr(ListEntry): Bytes: n); //Clear Value; Value = ListEntry.Value; Bytes = %Len(%Trim(Value)); If (@Path = '/'); szPath = %Trim(@Path) + Value; Else; szPath = %Trim(@Path) + '/' + Value; EndIf; Select; When ListEntry.Type = JSON_TYPE_ARRAY; Rc = CWJSN_PRIVATE_Serialize(@This: szPath: ListEntry.Type: @pStr); When ListEntry.Type = JSON_TYPE_OBJECT; Rc = CWJSN_PRIVATE_Serialize(@This: szPath: ListEntry.Type: @pStr); Other; ValueBuff = CTBUFF_Constructor(); JsonNode.pValue = ValueBuff; CWJSN_Lookup(@This: @Path: n-1: JsonNode); Bytes = CTBUFF_Length(ValueBuff); If ListEntry.Type = JSON_TYPE_STRING; CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); // Escape all double quotes If Bytes > 0; pSource = %Alloc(Bytes); pBufferFrom = pSource; pTarget = %Alloc(2 * Bytes); pBufferTo = pTarget; CTBUFF_Get(ValueBuff: pSource: 1: Bytes); Bytes = 0; For k=1 To JsonNode.Size By 1; If CharAtFrom = '"'; CharAtTo = '\'; pBufferTo +=1; Bytes += 1; EndIf; CharAtTo = CharAtFrom; pBufferFrom += 1; pBufferTo +=1; Bytes += 1; EndFor; Dealloc pSource; CTBUFF_Cat(@pStr: pTarget: Bytes); Dealloc pTarget; EndIf; CTBUFF_Cat(@pStr: %Addr(DoubleQuote): 1); Else; CTBUFF_BuffCat(@pStr: ValueBuff); EndIf; CTBUFF_Destructor(ValueBuff); Rc = CS_SUCCESS; EndSl; If Rc = CS_FAILURE; Leave; Else; If n < DirEntry.NumItems; CTBUFF_Cat(@pStr: %Addr(Comma): 1); EndIf; EndIf; EndFor; CloseToken = ']'; CTBUFF_Cat(@pStr: %Addr(CloseToken): 1); Else; Rc = CS_FAILURE; EndIf; EndIf; CTLST_Destructor(pListing); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_Tokenize... P B D PI 10I 0 D@This * Value D@pJsonStr * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) Dn S 10I 0 DType S 10I 0 DLen S 10I 0 DRc S 10I 0 DChar DS Qualified DCode 3U 0 DGlyph 1A Overlay(Code) DCurChar DS Qualified DCode 3U 0 DGlyph 1A Overlay(Code) /Free CTBUFFLST_Clear(Instance.pTokens); CTLST_Clear(Instance.pTokTypes); Rc = CS_SUCCESS; // until proven otherwise Len = CTBUFF_Length(@pJsonStr); n=1; Dow n <= Len; Char.Code = CTBUFF_ByteAt(@pJsonStr: n); Select; When Char.Glyph = ','; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_COMMA; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = '{'; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_LBRACE; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = '}'; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_RBRACE; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = '['; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_LBRACKET; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = ']'; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_RBRACKET; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = ':'; CTBUFFLST_InsertValue(Instance.pTokens: %Addr(Char.Glyph): 1: CTLST_BOTTOM); Type = JSON_TOK_COLON; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); When Char.Glyph = '"'; ExSr SrPrcString; If Rc = CS_SUCCESS; CTBUFFLST_InsertBuffer(Instance.pTokens: Instance.pTemp: CTLST_BOTTOM); Type = JSON_TOK_STRING; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); Else; Leave; EndIf; Other; If (Char.Code >= 240 And Char.Code <= 249) Or // Digits (Char.Glyph = 'f') Or // false ? (Char.Glyph = 't') Or // true ? (Char.Glyph = 'n') Or // null ? (Char.Glyph = '-'); // number starting with minus sign ExSr SrPrcLitteral; If Rc = CS_SUCCESS; CTBUFFLST_InsertBuffer(Instance.pTokens: Instance.pTemp: CTLST_BOTTOM); Type = JSON_TOK_LITTERAL; CTLST_Insert(Instance.pTokTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); Else; Leave; EndIf; EndIf; EndSl; n += 1; EndDo; Return Rc; BegSr SrPrcString; CurChar.Code = 0; CTBUFF_Set(Instance.pTemp: *Null: 0); n += 1; Char.Code = CTBUFF_ByteAt(@pJsonStr: n); Dow n <= Len; Select; When Char.Glyph = '\'; If CurChar.Glyph = '\'; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); CurChar.Code = 0; Else; CurChar = Char; EndIf; When Char.Glyph = 't'; If CurChar.Glyph = '\'; CTBUFF_Cat(Instance.pTemp: %Addr(CurChar): 1); CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); CurChar.Code = 0; Else; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); EndIf; When Char.Glyph = 'r'; If CurChar.Glyph = '\'; CTBUFF_Cat(Instance.pTemp: %Addr(CurChar): 1); CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); CurChar.Code = 0; Else; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); EndIf; When Char.Glyph = 'n'; If CurChar.Glyph = '\'; CTBUFF_Cat(Instance.pTemp: %Addr(CurChar): 1); CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); CurChar.Code = 0; Else; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); EndIf; When Char.Glyph = '"'; If CurChar.Glyph = '\'; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); CurChar.Code = 0; Else; Leave; EndIf; Other; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); EndSl; n += 1; Char.Code = CTBUFF_ByteAt(@pJsonStr: n); EndDo; If Char.Glyph = '"'; Rc = CS_SUCCESS; Else; Rc = CS_FAILURE; EndIf; EndSr; BegSr SrPrcLitteral; CTBUFF_Set(Instance.pTemp: %Addr(Char): 1); n += 1; Char.Code = CTBUFF_ByteAt(@pJsonStr: n); Dow n <= Len; Select; When Char.Glyph = ' '; Leave; When Char.Glyph = ','; n -= 1; Leave; When Char.Glyph = ':'; n -= 1; Leave; When Char.Glyph = ']'; n -= 1; Leave; When Char.Glyph = '['; n -= 1; Leave; When Char.Glyph = '{'; n -= 1; Leave; When Char.Glyph = '}'; n -= 1; Leave; Other; CTBUFF_Cat(Instance.pTemp: %Addr(Char): 1); n += 1; Char.Code = CTBUFF_ByteAt(@pJsonStr: n); EndSl; EndDo; EndSr; /End-Free P E *------------------------------------------------------------------------------- PCWJSN_PRIVATE_VV... P B D PI 10I 0 D@This * Value D@Index 10I 0 D@pPath * Value D@Listing * Value DInstance DS LikeDs(CWJSN_Instance) Based(@This) DRc S 10I 0 DValue S 255A DLabel S 255A DKey S 255A DType S 10I 0 DBytes S 10I 0 DpNewPath S * DBuffer S * DSlash S 1A Inz('/') DListEntry DS LikeDS(CWJSN_ListEntry) /Free pNewPath = CTBUFF_Constructor(); Rc = CS_SUCCESS; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Rc = CS_SUCCESS; If Type = JSON_TOK_STRING; If (CTBUFF_Length(@pPath) > 0); Buffer = %Alloc(CTBUFF_Length(@pPath)); Bytes = CTBUFF_Length(@pPath); CTBUFF_Get(@pPath: Buffer: 1: Bytes); CTBUFF_Set(pNewPath: Buffer: Bytes); Dealloc Buffer; EndIf; CTBUFF_Cat(pNewPath: %Addr(Slash): 1); Value = *Blanks; Bytes = %Size(Label); CTBUFFLST_GetValue(Instance.pTokens: %Addr(Label): Bytes: @Index); Bytes = %Len(%Trim(Label)); CTBUFF_Cat(pNewPath: %Addr(Label): Bytes); @Index += 1; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); If Type = JSON_TOK_COLON; @Index += 1; Bytes = %Size(Type); Rc = CTLST_Get(Instance.pTokTypes: %Addr(Type): Bytes: @Index); Select; When Type = JSON_TOK_LBRACE; Rc = CWJSN_PRIVATE_O(@This: @Index: pNewPath); If (Rc = CS_SUCCESS); Key = %Trim(Label); ListEntry.Value = %Trim(Label); ListEntry.Type = JSON_TYPE_OBJECT; Bytes = %Size(ListEntry); CTMAP_Insert(@Listing: Key: %Addr(ListEntry): Bytes); EndIf; When Type = JSON_TOK_LBRACKET; Rc = CWJSN_PRIVATE_A(@This: @Index: pNewPath); If (Rc = CS_SUCCESS); Key = %Trim(Label); ListEntry.Value = %Trim(Label); ListEntry.Type = JSON_TYPE_ARRAY; Bytes = %Size(ListEntry); CTMAP_Insert(@Listing: Key: %Addr(ListEntry): Bytes); EndIf; When Type = JSON_TOK_STRING Or Type = JSON_TOK_LITTERAL; // Cle Value = *Blanks; Bytes = %Size(Value); CTBUFF_Get(pNewPath: %Addr(Value): 1: Bytes); CTBUFFLST_InsertValue(Instance.pValuePaths: %Addr(Value): %Size(Value): CTLST_BOTTOM); //Value = *Blanks; //Bytes = %Size(Value); Bytes = CTBUFFLST_BuffLength(Instance.pTokens: @Index); Buffer = %Alloc(Bytes); CTBUFFLST_GetValue(Instance.pTokens: Buffer: Bytes: @Index); CTBUFFLST_InsertValue(Instance.pValues: Buffer: Bytes: CTLST_BOTTOM); If Type = JSON_TOK_STRING; Type = JSON_TYPE_STRING; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); @Index += 1; Rc = CS_SUCCESS; Else; Value = *Blanks; CWJSN_PRIVATE_MemCpy(%Addr(Value): Buffer: Bytes); Select; When Value = 'true'; Type = JSON_TYPE_BOOL; Rc = CS_SUCCESS; When Value = 'false'; Type = JSON_TYPE_BOOL; Rc = CS_SUCCESS; When Value = 'null'; Type = JSON_TYPE_NULL; Rc = CS_SUCCESS; Other; Type = JSON_TYPE_NUMERIC; Rc = CWJSN_PRIVATE_IsNumeric(@This: Value); EndSl; If Rc = CS_SUCCESS; CTLST_Insert(Instance.pValTypes: %Addr(Type): %Size(Type): CTLST_BOTTOM); Bytes = %Size(Value); @Index += 1; EndIf; EndIf; Dealloc Buffer; If Rc = CS_SUCCESS; Key = %Trim(Label); ListEntry.Value = %Trim(Label); ListEntry.Type = Type; Bytes = %Size(ListEntry); CTMAP_Insert(@Listing: Key: %Addr(ListEntry): Bytes); EndIf; Other; Rc = CS_FAILURE; EndSl; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; Else; Rc = CS_FAILURE; EndIf; CTBUFF_Destructor(pNewPath); Return Rc; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_Clear... P B EXPORT D PI 10I 0 D#This * D#Map DS LikeDs(CTMAP_Map) D Based(#This) /Free If (#This <> *Null); CPAVL_PRIVATE_Clear(#Map.#AvlTree); EndIf; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_Constructor... P B EXPORT D PI * D#Instance S * D#Map DS LikeDs(CTMAP_Map) D Based(#Instance) /Free #Instance = %Alloc(%Size(CTMAP_Map)); CPAVL_PRIVATE_Constructor(#Map.#AvlTree); #Map.#KeyList = CTLST_Constructor(); Return #Instance; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_Destructor... P B EXPORT D PI 10I 0 D#This * D#Map DS LikeDs(CTMAP_Map) D Based(#This) /Free If (#This <> *Null); CPAVL_PRIVATE_Destructor(#Map.#AvlTree); CTLST_Destructor(#Map.#KeyList); Dealloc #This; #This = *Null; EndIf; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_Insert... P B EXPORT D PI 10I 0 D#This * D#Key 255A Value D#Value * Value D#Bytes 10I 0 Value D#Map DS LikeDs(CTMAP_Map) D Based(#This) /Free #Map.#AvlTree = CPAVL_PRIVATE_Insert(#Map.#AvlTree: #Key: #Value: #Bytes); If (#Map.#AvlTree <> *Null); Return CS_SUCCESS; EndIf; Return CS_FAILURE; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_ItemSize... P B EXPORT D PI 10I 0 D#This * D#Key 255A Value D#Map DS LikeDs(CTMAP_Map) D Based(#This) /Free If (#This <> *Null); Return CPAVL_PRIVATE_RetrieveSize(#Map.#AvlTree: #Key); Else; Return -1; EndIf; /End-Free P E *------------------------------------------------------------------------------- PCTMAP_IterNext... P B EXPORT D PI 10I 0 D#This * D#Key 255A D#Value * Value D#Bytes 10I 0 D#Map DS LikeDs(CTMAP_Map) D Based(#This) D#Rc S 10I 0 D#pKey S * D#TheKey S 255A /Free #pKey = %Addr(#TheKey); #Rc = CTLST_Get(#Map.#KeyList: #pKey: #Bytes: #Map.#IterCurrent); If (#Rc = CS_SUCCESS); #Map.#IterCurrent += 1; #Key = #TheKey; CPAVL_PRIVATE_Retrieve(#Map.#AvlTree: #Key: #Value: #Bytes); EndIf; Return #Rc; /End-free P E *------------------------------------------------------------------------------- PCTMAP_IterNextSize... P B EXPORT D PI 10I 0 D#This * D#Map DS LikeDs(CTMAP_Map) D Based(#This) /Free Return CTLST_ItemSize(#Map.#KeyList: #Map.#IterCurrent); /End-free P E *------------------------------------------------------------------------------- PCTMAP_IterStart... P B EXPORT D PI 10I 0 D#This * D#Map DS LikeDs(CTMAP_Map) D Based(#This) D#Rc S 10I 0 D#Count S 10I 0 /Free #Map.#IterCurrent = 1; CTLST_Clear(#Map.#KeyList); CPAVL_PRIVATE_Keys(#Map.#AvlTree: #Map.#KeyList); #Count = CTLST_Count(#Map.#KeyList); Return #Count; /End-free P E *------------------------------------------------------------------------------- PCTMAP_LookUp B EXPORT D PI 10I 0 D#This * D#Key 255A Value D#Value * Value D#Bytes 10I 0 D#Map DS LikeDs(CTMAP_Map) D Based(#This) D#Rc S 10I 0 /Free #Rc = CPAVL_PRIVATE_Retrieve(#Map.#AvlTree: #Key: #Value: #Bytes); If (#Rc = CS_SUCCESS); Return CS_SUCCESS; Else; Return CS_FAILURE; EndIf; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Clear... P B D PI 10I 0 D#This * D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This <> *Null); CPAVL_PRIVATE_Clear(#Tree.#Left); CPAVL_PRIVATE_Clear(#Tree.#Right); Dealloc #Tree.#Value; Dealloc #This; #This = *Null; EndIf; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Constructor... P B D PI 10I 0 D#This * D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free #This = *Null; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Destructor... P B D PI 10I 0 D#This * D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This <> *Null); CPAVL_PRIVATE_Clear(#Tree.#Left); CPAVL_PRIVATE_Clear(#Tree.#Right); Dealloc #Tree.#Value; Dealloc #This; #This = *Null; EndIf; Return CS_SUCCESS; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_DoubleLeftRotation... P B D PI * D#This * Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free #Tree.#Left = CPAVL_PRIVATE_SingleRightRotation(#Tree.#Left); Return CPAVL_PRIVATE_SingleLeftRotation(#This); /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_DoubleRightRotation... P B D PI * D#This * Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free #Tree.#Right = CPAVL_PRIVATE_SingleLeftRotation(#Tree.#Right); Return CPAVL_PRIVATE_SingleRightRotation(#This); /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Find... P B D PI 10I 0 D#This * Value D#Key 255A Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This = *Null); Return CS_FAILURE; Else; If (#Key = #Tree.#Key); Return CS_SUCCESS; Else; If (#Key < #Tree.#Key); Return CPAVL_PRIVATE_Find(#Tree.#Left: #Key); Else; Return CPAVL_PRIVATE_Find(#Tree.#Right: #Key); EndIf; EndIf; EndIf; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Height... P B D PI 10I 0 D#This * Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This = *Null); Return -1; EndIf; Return #Tree.#Height; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Insert... P B D PI * D#This * Value D#Key 255A Value D#Value * Value D#Bytes 10I 0 Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) D#pNewTree S * D#NewTree DS LikeDs(CPAVL_Tree) Based(#pNewTree) D#pLeftTree S * D#LeftTree DS LikeDs(CPAVL_Tree) Based(#pLeftTree) D#pRightTree S * D#RightTree DS LikeDs(CPAVL_Tree) Based(#pRightTree) D#LeftHeight S 10I 0 D#RightHeight S 10I 0 D#BalanceFactor S 10I 0 D#i S 10I 0 /Free if (#This = *Null); #pNewTree = %Alloc(%Size(CPAVL_Tree)); If (#Value <> *Null And #Bytes > 0); #NewTree.#Value = %Alloc(#Bytes); CPAVL_PRIVATE_MemCpy(#NewTree.#Value: #Value: #Bytes); Else; #NewTree.#Value = *Null; #Bytes = 0; EndIf; #NewTree.#Key = #Key; #NewTree.#Bytes = #Bytes; #NewTree.#Left = *Null; #NewTree.#Right = *Null; #NewTree.#Height = 0; Else; If (#Tree.#Key = #Key); If (#Tree.#Value <> *Null); Dealloc #Tree.#Value; EndIf; If (#Value <> *Null And #Bytes > 0); #Tree.#Value = %Alloc(#Bytes); CPAVL_PRIVATE_MemCpy(#Tree.#Value: #Value: #Bytes); Else; #Tree.#Value = *Null; #Bytes = 0; EndIf; #Tree.#Bytes = #Bytes; Return #This; Else; If (#Tree.#Key > #Key); #Tree.#Left = CPAVL_PRIVATE_Insert(#Tree.#Left: #Key: #Value: #Bytes); #LeftHeight = CPAVL_PRIVATE_Height(#Tree.#Left); #RightHeight = CPAVL_PRIVATE_Height(#Tree.#Right); If (#LeftHeight > #RightHeight); #Tree.#Height = #LeftHeight + 1; #BalanceFactor = #LeftHeight - #RightHeight; Else; #Tree.#Height = #RightHeight + 1; #BalanceFactor = #RightHeight - #LeftHeight; EndIf; If (#BalanceFactor > 1); #pLeftTree = #Tree.#Left; If (#Key < #LeftTree.#Key); #pNewTree = CPAVL_PRIVATE_SingleLeftRotation(#This); Else; #pNewTree = CPAVL_PRIVATE_DoubleLeftRotation(#This); EndIf; Else; #pNewTree = #This; EndIf; Else; #Tree.#Right = CPAVL_PRIVATE_Insert(#Tree.#Right: #Key: #Value: #Bytes); #LeftHeight = CPAVL_PRIVATE_Height(#Tree.#Left); #RightHeight = CPAVL_PRIVATE_Height(#Tree.#Right); If (#LeftHeight > #RightHeight); #Tree.#Height = #LeftHeight + 1; #BalanceFactor = #LeftHeight - #RightHeight; Else; #Tree.#Height = #RightHeight + 1; #BalanceFactor = #RightHeight - #LeftHeight; EndIf; If (#BalanceFactor > 1); #pRightTree = #Tree.#Right; If (#Key > #RightTree.#Key); #pNewTree = CPAVL_PRIVATE_SingleRightRotation(#This); Else; #pNewTree = CPAVL_PRIVATE_DoubleRightRotation(#This); EndIf; Else; #pNewTree = #This; EndIf; EndIf; EndIf; EndIf; Return #pNewTree; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Keys... P B D PI 10I 0 D#This * Value D#List * Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) D#Size S 10I 0 /Free If (#This = *Null); Return CS_SUCCESS; EndIf; If (#Tree.#Left <> *Null); CPAVL_PRIVATE_Keys(#Tree.#Left: #List); EndIf; #Size = %Size(#Tree.#Key); CTLST_Insert(#List: %Addr(#Tree.#Key): #Size: CTLST_BOTTOM); If (#Tree.#Right <> *Null); CPAVL_PRIVATE_Keys(#Tree.#Right: #List); EndIf; Return CS_SUCCESS; /End-free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_Retrieve... P B D PI 10I 0 D#This * Value D#Key 255A Value D#Value * Value D#Bytes 10I 0 D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This = *Null); #Bytes = 0; Return CS_FAILURE; EndIf; If (#Tree.#Key = #Key); If (#Tree.#Value <> *Null); CPAVL_PRIVATE_MemCpy(#Value: #Tree.#Value: #Tree.#Bytes); #Bytes = #Tree.#Bytes; Else; #Bytes = 0; EndIf; Return CS_SUCCESS; Else; If (#Tree.#Key > #Key); Return CPAVL_PRIVATE_Retrieve(#Tree.#Left: #Key: #Value: #Bytes); Else; Return CPAVL_PRIVATE_Retrieve(#Tree.#Right: #Key: #Value: #Bytes); EndIf; EndIf; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_RetrieveSize... P B D PI 10I 0 D#This * Value D#Key 255A Value D#Tree DS LikeDs(CPAVL_Tree) Based(#This) /Free If (#This = *Null); Return -1; EndIf; If (#Tree.#Key = #Key); Return #Tree.#Bytes; Else; If (#Tree.#Key > #Key); Return CPAVL_PRIVATE_RetrieveSize(#Tree.#Left: #Key); Else; Return CPAVL_PRIVATE_RetrieveSize(#Tree.#Right: #Key); EndIf; EndIf; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_SingleLeftRotation... P B D PI * D#This * Value D#pOriginalTree S * D#OriginalTree DS LikeDs(CPAVL_Tree) Based(#This) D#pTempTree S * D#TempTree DS LikeDs(CPAVL_Tree) Based(#pTempTree) D#pNewTree S * D#NewTree DS LikeDs(CPAVL_Tree) Based(#pNewTree) D#OriginalLeftHeight... D S 10I 0 D#OriginalRightHeight... D S 10I 0 D#NewLeftHeight... D S 10I 0 D#NewRightHeight... D S 10I 0 /Free #pOriginalTree = #This; #pNewTree = #OriginalTree.#Left; #pTempTree = #NewTree.#Right; #NewTree.#Right = #pOriginalTree; #OriginalTree.#Left = #pTempTree; #OriginalLeftHeight = CPAVL_PRIVATE_Height(#OriginalTree.#Left); #OriginalRightHeight = CPAVL_PRIVATE_Height(#OriginalTree.#Right); If (#OriginalLeftHeight > #OriginalRightHeight); #OriginalTree.#Height = #OriginalLeftHeight + 1; Else; #OriginalTree.#Height = #OriginalRightHeight + 1; EndIf; #NewLeftHeight = CPAVL_PRIVATE_Height(#NewTree.#Left); #NewRightHeight = CPAVL_PRIVATE_Height(#NewTree.#Right); If (#NewLeftHeight > #NewRightHeight); #NewTree.#Height = #NewLeftHeight + 1; Else; #NewTree.#Height = #NewRightHeight + 1; EndIf; Return #pNewTree; /End-Free P E *------------------------------------------------------------------------------- PCPAVL_PRIVATE_SingleRightRotation... P B D PI * D#This * Value D#pOriginalTree S * D#OriginalTree DS LikeDs(CPAVL_Tree) Based(#This) D#pTempTree S * D#TempTree DS LikeDs(CPAVL_Tree) Based(#pTempTree) D#pNewTree S * D#NewTree DS LikeDs(CPAVL_Tree) Based(#pNewTree) D#OriginalLeftHeight... D S 10I 0 D#OriginalRightHeight... D S 10I 0 D#NewLeftHeight... D S 10I 0 D#NewRightHeight... D S 10I 0 /Free #pOriginalTree = #This; #pNewTree = #OriginalTree.#Right; #pTempTree = #NewTree.#Left; #NewTree.#Left = #pOriginalTree; #OriginalTree.#Right = #pTempTree; #OriginalLeftHeight = CPAVL_PRIVATE_Height(#OriginalTree.#Left); #OriginalRightHeight = CPAVL_PRIVATE_Height(#OriginalTree.#Right); If (#OriginalLeftHeight > #OriginalRightHeight); #OriginalTree.#Height = #OriginalLeftHeight + 1; Else; #OriginalTree.#Height = #OriginalRightHeight + 1; EndIf; #NewLeftHeight = CPAVL_PRIVATE_Height(#NewTree.#Left); #NewRightHeight = CPAVL_PRIVATE_Height(#NewTree.#Right); If (#NewLeftHeight > #NewRightHeight); #NewTree.#Height = #NewLeftHeight + 1; Else; #NewTree.#Height = #NewRightHeight + 1; EndIf; Return #pNewTree; /End-Free P E