%ZEN.Auxiliary.jsonProvider 0 1 pJSON:%String,pClass:%String="",*pObject:%RegisteredObject,*pCharsProcessed:%Integer,pLevel:%Integer=1,pFirstChar:%String="" %Status $L(pJSON)) Quit Set ch = $E(pJSON,p) } Set p = p + 1 Set pCharsProcessed = pCharsProcessed + 1 If (tState = 0) { If (ch = "{") { // start of object // we will hold the property values in here until the end Kill tPropValues Set pObject = "" Set tState = 1 } Else { Set tSC = $$$ERROR($$$GeneralError,"Expected { at start of JSON text.") Quit } } ElseIf (tState = 1) { If (ch = "}") { // end of object // create object, stuff properties into it Set tClass = $G(tPropValues("_class"),tClass) Set pObject = $zobjclassmethod(tClass,"%New") Set p = $O(tPropValues("")) While (p'="") { If (p '= "_class") { Set $zobjproperty(pObject,p) = $G(tPropValues(p)) } Set p = $O(tPropValues(p)) } Quit } ElseIf ('$$$WHITESPACE(ch)) { // start of property name Set tToken = ch Set tState = 2 } } ElseIf (tState = 2) { // property If (ch = ":") { Set tProperty = $tr(tToken,"""") Set tToken = "" Set tState = 3 Set tIsString = 0 } ElseIf ('$$$WHITESPACE(ch)) { Set tToken = tToken _ ch } } ElseIf (tState = 3) { // value If (ch = ",") { // end of value If (tIsString || $IsObject(tToken)) { Set tValue = tToken } Else { Set tValue = $Case(tToken,"null":"","true":1,"false":0,:tToken) } If (tProperty '= "") { Set tPropValues(tProperty) = tValue } Set tToken = "" Set tValue = "" Set tState = 1 } ElseIf (ch = "}") { // end of value and object If (tIsString || $IsObject(tToken)) { Set tValue = tToken } Else { Set tValue = $Case(tToken,"null":"","true":1,"false":0,:tToken) } If (tProperty '= "") { Set tPropValues(tProperty) = tValue } // create object, stuff properties into it Set tClass = $G(tPropValues("_class"),tClass) Set pObject = $zobjclassmethod(tClass,"%New") Set p = $O(tPropValues("")) While (p'="") { If (p '= "_class") { Set $zobjproperty(pObject,p) = $G(tPropValues(p)) } Set p = $O(tPropValues(p)) } Set tToken = "" Set tValue = "" Quit } ElseIf (ch = "{") { // start of object-valued property If (pClass="") { Set pClass = $G(tPropValues("_class")) } If (pClass="") { Set tChildClass = "" Set tCollection = "" } Else { // lookup type in meta data Set tChildClass = $$$comMemberKeyGet(pClass,$$$cCLASSproperty,tProperty,$$$cPROPtype) Set tCollection = $$$comMemberKeyGet(pClass,$$$cCLASSproperty,tProperty,$$$cPROPcollection) } If (tCollection = "array") { // start of array-valued property Set tArrayType = "array" Set tArrayKey = "" Set tInArray = 1 Kill tArray Set tToken = "" Set tIsString = 0 Set tState = 5 Set tArrayState = "name" } Else { If ($IsObject(pJSON)) { Set tSubJSON = pJSON Set tPoke = ch // simulate stream unwind } Else { Set tSubJSON = $E(pJSON,p-1,*) Set tPoke = "" } Set tSC = ..ParseJSON(tSubJSON,tChildClass,.tToken,.tChars,pLevel+1,tPoke) If $$$ISERR(tSC) Quit Set p = p + tChars - 1 Set pCharsProcessed = pCharsProcessed + tChars - 1 } } ElseIf (ch = "[") { // start of list/array-valued property Set tInArray = 1 Set tArrayType = "list" Kill tArray Set tArrayIndex = 0 Set tToken = "" Set tIsString = 0 Set tState = 5 Set tArrayState = "value" } ElseIf ((ch = """")||(ch = "'")) { // start of string Set tToken = "" Set tIsString = 1 Set tQuote = ch Set tState = 4 } ElseIf ('$$$WHITESPACE(ch)) { // must be a numeric value, or true,false,or null Set tToken = tToken _ ch } } ElseIf (tState = 4) { // string literal If (ch = tQuote) { // end of string If (tInArray) { Set tState = 5 } Else { Set tState = 3 } } Else { Set tToken = tToken _ ch } } ElseIf (tState = 5) { // array items If (ch = ",") { // end of array item If (tArrayType = "list") { Set tArrayIndex = tArrayIndex + 1 } If (tIsString || $IsObject(tToken)) { Set tValue = tToken } Else { Set tValue = $Case(tToken,"null":"","true":1,"false":0,:tToken) } If (tArrayType = "list") { Set tArray(tArrayIndex) = tValue } ElseIf (tArrayKey'="") { Set tArray(tArrayKey) = tValue } Set tToken = "" Set tArrayKey = "" Set tIsString = 0 If (tArrayType = "list") { Set tArrayState = "value" } Else { Set tArrayState = "name" } } ElseIf ((tArrayType="list")&&(ch = "]")) { // end of list array If (tToken '= "") { Set tArrayIndex = tArrayIndex + 1 If (tIsString || $IsObject(tToken)) { Set tValue = tToken } Else { Set tValue = $Case(tToken,"null":"","true":1,"false":0,:tToken) } Set tArray(tArrayIndex) = tValue } // if array is empty assume objects If (($G(tArray(1))="") || $IsObject($G(tArray(1)))) { Set tListObj = ##class(%ListOfObjects).%New() } Else { Set tListObj = ##class(%ListOfDataTypes).%New() } Set n = $O(tArray("")) While (n'="") { Do tListObj.Insert(tArray(n)) Set n = $O(tArray(n)) } Set tToken = tListObj Set tListObj = "" Set tInArray = 0 Kill tArray Set tArrayIndex = 0 Set tState = 3 } ElseIf ((tArrayType="array")&&(ch = "}")) { // end of array If (tToken '= "") { If (tIsString || $IsObject(tToken)) { Set tValue = tToken } Else { Set tValue = $Case(tToken,"null":"","true":1,"false":0,:tToken) } If (tArrayKey'="") { Set tArray(tArrayKey) = tValue } } // if array is empty assume objects Set tFirstKey = $O(tArray("")) If ((tFirstKey="") || $IsObject($G(tArray(tFirstKey)))) { Set tArrayObj = ##class(%ArrayOfObjects).%New() } Else { Set tArrayObj = ##class(%ArrayOfDataTypes).%New() } Set n = $O(tArray("")) While (n'="") { Do tArrayObj.SetAt(tArray(n),n) Set n = $O(tArray(n)) } Set tToken = tArrayObj Set tArrayObj = "" Set tInArray = 0 Kill tArray Set tArrayIndex = 0 Set tArrayKey = "" Set tState = 3 } ElseIf (ch = "{") { // object-valued item: token is the object If (pClass="") { Set tChildClass = "" } Else { // lookup type in meta data Set tChildClass = $$$comMemberKeyGet(pClass,$$$cCLASSproperty,tProperty,$$$cPROPtype) } If ($IsObject(pJSON)) { Set tSubJSON = pJSON Set tPoke = ch // simulate stream unwind } Else { Set tSubJSON = $E(pJSON,p-1,*) Set tPoke = "" } Set tSC = ..ParseJSON(tSubJSON,tChildClass,.tToken,.tChars,pLevel+1,tPoke) If $$$ISERR(tSC) Quit Set p = p + tChars - 1 Set pCharsProcessed = pCharsProcessed + tChars - 1 } ElseIf ((ch = """")||(ch = "'")) { // start of string Set tToken = "" Set tIsString = 1 Set tQuote = ch Set tState = 4 } ElseIf ((tArrayType="array")&&(ch=":")) { // end of name If (tArrayState = "name") { Set tArrayState = "value" Set tArrayKey = tToken Set tToken = "" } } ElseIf ('$$$WHITESPACE(ch)) { // literal Set tToken = tToken _ ch } } } } Catch(ex) { Set tSC = ex.AsStatus() } Quit tSC ]]> 1 %Status 0 "," If tPropCount>0 { Set JsonStringOutput = JsonStringOutput_"," } Set tPropCount = tPropCount + 1 Write !,?(pLevel*3),tPropName,":" Set JsonStringOutput = JsonStringOutput_" """_tPropName_""":" Set tValue = $zobjproperty(pObject,tPropName) } If (tMultiDim) { } ElseIf (tCollection="list") { // list collection Write "[" Set JsonStringOutput = JsonStringOutput_"[" If $IsObject(tValue) { Set tList = tValue Set tCount = tList.Count() For n = 1:1:tCount { Set tValue = tList.GetAt(n) Write:n>1 "," If n>1 { Set JsonStringOutput = JsonStringOutput_"," } If (tClientType = "HANDLE") { // object If $IsObject(tValue) { Set tSC = ..ObjectToJSON(tValue,.pVisited, pLevel + 1, .Json) If $$$ISERR(tSC) { Do ##class(Tools.Wlip).%New(43).String("handle error top") Quit } Else { Set JsonStringOutput = JsonStringOutput_Json } Set Json = "" } Else { Write "null" Set JsonStringOutput = JsonStringOutput_"null" } } Else { Write $Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) Set JsonStringOutput = JsonStringOutput_$Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) } } } Write "]" Set JsonStringOutput = JsonStringOutput_"]" } ElseIf (tCollection="array") { // array collection (object on client) Write "{" Set JsonStringOutput = JsonStringOutput_"{" If $IsObject(tValue) { Set tArray = tValue Set n = 0 Set tKey = tArray.Next("") While (tKey '= "") { Set n = n + 1 Write:n>1 "," If n>1 { Set JsonStringOutput = JsonStringOutput_"," } Set tValue = tArray.GetAt(tKey) Write $S($zname(tKey):tKey,$IsValidNum(tKey):tKey,1:""""_$ZCVT(tKey,"O","JS")_""""),":" Set JsonStringOutput = JsonStringOutput_""""_$S($zname(tKey):tKey,$IsValidNum(tKey):tKey,1:""""_$ZCVT(tKey,"O","JS")_"""")_""":" If (tClientType = "HANDLE") { // object If $IsObject(tValue) { Set tSC = ..ObjectToJSON(tValue,.pVisited, pLevel + 1, .Json) If $$$ISERR(tSC) { Do ##class(Tools.Wlip).%New(43).String("handle error") Quit } Else { Set JsonStringOutput = JsonStringOutput_Json } Set Json = "" } Else { Write "null" Set JsonStringOutput = JsonStringOutput_"null" } } Else { Write $Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) Set JsonStringOutput = JsonStringOutput_$Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) } Set tKey = tArray.Next(tKey) } } Write "}" Set JsonStringOutput = JsonStringOutput_"}" } ElseIf (tClientType = "HANDLE") { // object If $IsObject(tValue) { Set tSC = ..ObjectToJSON(tValue,.pVisited, pLevel + 1,.Json) If $$$ISERR(tSC) { Quit } Else { Set JsonStringOutput = JsonStringOutput_Json } Set Json = "" } Else { Write "null" Set JsonStringOutput = JsonStringOutput_"null" } } ElseIf (tClientType = "CHARACTERSTREAM") { If $IsObject(tValue) { // turn on io escaping Write """" Set JsonStringOutput = JsonStringOutput_"""" Set io = $$$GETIO $$$SETIO("JSML") Do tValue.Rewind() Do tValue.OutputToDevice() $$$SETIO(io) Write """" Set JsonStringOutput = JsonStringOutput_"""" } Else { Write "null" Set JsonStringOutput = JsonStringOutput_"null" } } ElseIf (tClientType = "BINARYSTREAM") { Write "null" Set JsonStringOutput = JsonStringOutput_"null" } Else { Write $Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) Set JsonStringOutput = JsonStringOutput_$Case(tClientType,"BOOLEAN":$S(tValue:"true",1:"false"),:$S($IsValidNum(tValue):tValue,1:""""_$ZCVT(tValue,"O","JS")_"""")) } } Set tPropName = $$$comMemberNext(tClass,$$$cCLASSproperty,tPropName) } If $$$ISERR(tSC) Quit Write !,?(pLevel*3),"}" Set JsonStringOutput = JsonStringOutput_"}" } Catch(ex) { Set tSC = ex.AsStatus() Write "null" Set JsonStringOutput = "" } Quit tSC ]]>