%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 ]]>