!mlistjson.bsi [122] - library for parsing JSON with mlist !------------------------------------------------------------------------ !EDIT HISTORY !Version 1.0:- ! [122] 23-Mar-26 / jdm / Add tracing ! [121] 08-Nov-25 / jdm / Set Fn'MLJ'GetNamedValue$() default for flags to MLJF_UNQUOTE ! [120] 30-Oct-25 / jdm / Clear $json() prior to loading ! [119] 22-May-24 / jdm / Fix bug in Fn'MLJ'LoadFromString() truncating input at 260 chars ! [118] 24-Mar-23 / jdm / Add ch to Fn'MLJ'Load() to accept an already open ch; ! minor tweaking/modernization ! [117] 03-Aug-19 / jdm / More functions! Treat path "." as the toplevel node. ! [116] 31-Jul-19 / jdm / Add Fn'MLJ'SetNamedValueX() to insert or replace ! named arrays and named objects; ! Add Fn'MLJ'AppendItemX() ! [115] 10-Jul-19 / jdm / Add Fn'MLJ'MapToObject$($map()) ! [114] 01-Oct-18 / jdm / Rename module (was fnmlistjsn.bsi); adjust module vars ! to avoid s,0 members; add MLJF_UNQUOTE ! [113] 06-Jul-18 / jdm / Rename/reorg module vars into structure to avoid ! problem with case insensitive compile; fix issue ! with trailing "." in search path being ignored ! [112] 06-Jul-18 / jdm / Add Fn'MLJ'TraverseToMap() ! [111] 06-Jul-18 / jdm / Fix bug in Fn'MLJ'Load when file not found ! [110] 04-Jul-18 / jdm / Add Fn'MLJ'Traverse() ! [109] 03-Jun-18 / jdm / Merge name and path into one field, various refinements ! [108] 25-Jun-18 / jdm / Change path notation; revise param lists (see notes) ! [107] 13-Jun-18 / jdm / Add Fn'MLJ'SetNamedValue$() ! [106] 12-Jun-18 / jdm / Add path to Fn'MLJ'GetNamedValue$() ! [105] 05-Jun-18 / jdm / Add types.def ! [104] 05-Mar-17 / jdm / moved to sosfunc:, renamed from mlistjson.bsi ! [103] 17-Nov-16 / jdm / Add Fn'MLJ'GetNamedParam$() ! [102] 07-Nov-16 / jdm / Fix bug in the fn'mlj'next'token$ routine ! where it was confusing quoted terminator ! characters with real terminators (when the field ! was so long that the closing quote was outside ! the current buffer.) (The instr INSTRF_ANYQT ! flag only works with MATCHED sets of quotes.) ! [101] 07-Nov-16 / jdm / Add Fn'MLJ'Serialize() (inverse of MLJ'Load) ! [100] 22-Oct-16 / jdm / Created !------------------------------------------------------------------------ !REQUIREMENTS ! 6.3.1532 (for MLIST) ! 6.3.1534.0 (for EDIT$ enhancements) ! fnexplode.bsi [109]+ !NOTES ! Terminology: in addition to the normal JSON terminology (object, array, ! name, value, name:value pairs, etc., because we are using the MLIST as ! the storage structure, we will also use the term "item" to refer ! to a JSON unit that can be stored in a single MLIST element. (Note: "element" ! would in some ways be preferable to "item", except for the potential confusion ! with JSON array elements (which could be the same as an item, but could also ! consist of many "items", i.e. compound objects, subarrays, etc.). ! ! Each "item" can contain ONE of the following: ! ! {} (unnamed object; sublist contains object) ! [] (unnamed array; sublist contains array) ! "name":{} (named object; value part of pair is object in sublist) ! "name":[] (named array; value part of pair is array in sublist) ! scalar ("string", number, true, false, null) ! "name":"string" (name:value pair with string value) ! "name":scalar (name:value pair with number or special literal value) ! ! Name part of name:value pairs will be quoted (as in normal JSON) ! to eliminate ambiguity over embedded special characters. Similarly, ! string values will be quoted to eliminate ambiguity between the ! string values "true", "false" and "null" vs. the special scalars ! true, false, and null. ! ! All whitespace not contained within quoted strings in the JSON ! document will be removed. ! ! During parsing, the open [ or { will initially terminate the contents ! of that node, until the closing ] or } is encountered. Hence any ! nodes with only an opening [ or { would suggest a syntax error ! (unterminated object or array) in the underlying JSON document. ! ! Input buffering: since processing string data byte-by-byte is relatively ! costly in BASIC (due to the lack of pointers), processing the JSON ! one byte at a time seems unwise. At the opposite extreme, loading the ! entire document into a single string is also inefficent since each ! operation on the string would require pushing the entire thing on to ! the string expression stack. The optimum appears to be somewhere in ! the middle, i.e. to operate on chunks of text at at time. One ! possibility would be to use line terminators to delimite these chunks, ! but we can't count on the JSON being split into logical lines. So ! the compromise plan is to input a fixed block of bytes (512) from the ! file, and then from that buffer, copy logical segments (JSON 'values'?) ! chunks to a working buffer for parsing/manipulation. In the case of ! very large string values (>512 bytes) we may need to expand the ! working buffer (by reading additional 512 byte blocks) until we can ! get a complete value. ! !PATH Syntax ! For the Fn'MLJ'GetNamedValue$() and Fn'MLJ'SetNamedValue$() functions, we ! use a somewhat non-standard PATH syntax (similar in concept to XPATH) to ! identify the location within the document. The PATH is a concatenation of ! names, dots (for objects), and [#] (for arrays). Examples: ! ! . - document root (object or array) ! .name1.name2[3].name4 - name4 within 3rd array element of name2 object within name1 ! e.g."name1":{"aaa":"bbb","name2":[{...},{...},{...,"name4":value ! .name1..name2 - name2 object within unnamed object within name1 object ! e.g. "name":{ {"aaa":"bbb", "name2":"xxx"} ... ! [1].foo[4].bar[6][8] - 8th element within 6th element within array named bar within ! 4th element of array named foo within 1st element of JSON ! top level array. ! ! Technically the name tokens in the paths should be quoted to match the way they are quoted ! in the actual JSON document, but since this is a awkward, and usually unnecessary (unambiguous) ! the quoting is optional except when necessary because named items contain ! special characters. The path you specify in a search will be auto-fully-quoted as needed ! before search begins. ! ! Similarly, when replacing a value, quoting is optional. Quotes will be added automatically ! if and only if the replaced value was itself quoted, except in the case of true, false, and null ! which are assumed to be literal unless explicitly quoted. ! ! Returned paths and values are always quoted as in the source document. ! ! When searching, the requested path can be partial or absolute. It is assumed to be ! absolute if it starts with "." (JSON document is an object) or "[" (array). ! Otherwise it will act as if there was an implicit * wildcard on the ! front of the search path. For example, if you search for "foo" it will find the ! first occurrence of the named item foo in the document. (This is consistent with ! the behavior prior to [106].) Otherwise, if you search for ".foo", it will only find ! the item at the top level. Searching for .bar[3].foo will only find foo within ! the 3rd element of the top level named array bar. Absolute paths are highly recommended, ! not only to eliminate ambiguity but to vastly improve search performance (allowing ! entire branches to be skipped during the search/traverse). ! ! Two weaknesses of the path notation/semantics: ! ! 1) There is no way to search for anywhere for an item relative to an unnamed array, ! since [4].foo would be treated as an absolute path. The workaround ! would be to just search for foo, although you might find it ! outside of an array. The same problem would apply to an unnamed object, i.e. ! .foo is treated as an absolute path, so you couldn't search for foo within ! any unnamed object. (To completely solve this we may need to introduce a special ! wildcard character, i.e. *[4].foo to indicate that the array isn't necessarily ! top level.) ! ! 2) If the path contains an array, you must specify the index value, i.e. you ! can't search for foo[].bar (an item bar within any element of the ! foo[] array). This is probably not a big deal, since the search ! would most likely match on foo[1].bar, and you could always just ! perform a series of searches for foo[1].bar, foo[2].bar, etc. in order ! to find the first array element containing the item named bar. !------------------------------------------------------------------------ !Public Functions ! Fn'MLJ'Load(fspec$, ch, $json()) - load JSON doc into MLIST [118] ! Fn'MLJ'LoadFromString(s$, $json()) - Load JSON doc or object from string [115] ! Fn'MLJ'Serialize($json(), fspec$) - serialize to file ! Fn'MLJ'GetNamedValue$($json(), namepath$, flags) ! - return value of named pair [106][109][114] ! Fn'MLJ'SetNamedValue$($json(), namepath$, value$) ! - find and change value of named pair [106][109] ! Fn'MLJ'SetNamedValueX($json(), namepath$, value$, status) [116] ! - extended version to set/replace arrays, objects and scalars ! Fn'MLJ'AppendItemX($json(), namepath$, value$, status) [116] ! - append value$ to end of namepath$ ! Fn'MLJ'Traverse($json(), namepath$, @fn'callback()) ! - traverse document, calling callback for each item ! Fn'MLJ'TraverseToMap($json(), namepath$, $map(), flags) ! - traverse and copy to ordmap [112] ! Fn'MLJ'Item'Name$(item$) - retrieve item name from pair ! Fn'MLJ'Item'Value$(item$) - return value of item ! Fn'MLJ'MapToObjectString$($jmap()) - convert ordmap into an object ! string consisting of a series name:value pairs ! Fn'MLJ'CreateObject$($jmap()) - create a JSON doc consisting of an empty object {} [117] ! Fn'MLJ'CreateArray$($jmap()) - create a JSON doc consisting of an empty array [] [117] ! Fn'MLJ'AppendNameValue$($jmap(),path$,name$,value$) - append a name:value pair to specified path [117] ! !Private Functions ! mlj'out'item(text$) - output an item; handle indenting ! fn'mlj'next'token$() - return next string token from input stream ! fn'mlj'read'block() - read another block into working buffer ! fn'mlj'serialize($json()) - serializer ! fn'mlj'count'quotes(strbuf$, limit) ! - count quotes in string up to limit pos ! fn'mlj'path'match(curpath$,item$,aryidx) ! - returns .true if paths match ! fn'mlj'name'match(reqname$,item$,barray) [1] ! fn'mlj'parse($json,endtoken$) [3] ! fn'mlj'namedvalue$($json,name$,curpath$,value$,barray) ! - search for name$ within findpath; optional value update ! fn'mlj'val'save'findpath(findpath$) - validate/reformat/save incoming findpath ! fn'mlj'is'json'literal(value$) ! - return TRUE if value is a special JSON literal (true,false,null) ! fn'mlj'item'is'sublist(item$) - determine if item is a sublist ! fn'mlj'fix'array'idx$(path$,item$,aryidx) - fix (assign) aryidx ! fn'mlj'can'skip'descent(parentpath$) ! - determine if we can skip descent during scan ! fn'mlj'is'json'number(value$) - check if qualifies as a JSON number !------------------------------------------------------------------------ ++include'once ashinc:ashell.def ++include'once ashinc:types.def ++include'once sosfunc:fnextch.bsi ++include'once sosfunc:fnminasver.bsi ++include'once sosfunc:fnfilestr.bsi ! [101] for option to return as string ++include'once sosfunc:fnquote.bsi ! [107] Fn'Quote$(), Fn'Unquote$() ++include'once sosfunc:fnexplode.bsi ! [109] note: must be version [109]+ ++include'once sosfunc:fnistype.bsi ! [117] character type tests define JSON_DELIMITERS$ = "{}[]," define JSON_GETONLY_VALUE$ = "*!" ! [107] special value indicating get only define JSON_MAX_NAME = 100 ! [107] max length of item name define JSON_ARYIDX_MARKER$ = "``" ! [108] used to mark location of array idx in path: ! NOTE: IF NOT 2 CHARS, NEED ADJUSTMENT TO REPLACEMENT LOGIC! define JSON_MAX_PATH = 512 ! [114] max length of a path ![112] Fn'MLJ'TraverseToMap flags define MLJF_HORZ = &h001 ! traverse horizontally (one level within branch) define MLJF_VERT = &h002 ! traverse vertically (all levels of branch) define MLJF_PATH = &h004 ! include path in $map key (highly recommended with _VERT!) ![114] Fn'MLJ'GetNamedValue flags define MLJF_UNQUOTE = &h001 ! [114] remove quotes from returned value ![116] error codes define MLJERR_BAD_JSON = -1 ! [116] string does not appear to be JSON define MLJERR_ASH_VER = -2 ! [116] insufficient A-Shell version define MLJERR_BAD_OBJECT = -3 ! [116] invalid object syntax define MLJERR_BAD_ARRAY = -4 ! [116] invalid array syntax define MLJERR_BAD_PATH = -5 ! [116] bad path specified define MLJERR_PATH_NOT_FOUND= -6 ! [116] path not found defstruct ST_MLJ_MODULE_VARS map2 Load'Serialize ! variables related to loading and serializing map3 chin,b,2 ! input channel map3 chout,b,2 ! output channel map3 level,i,2 ! nesting level (mostly for debugging) map3 indent,b,2 ! # spaces to indent per level map3 outbytes,b,4 ! # bytes output when serializing map2 Search ! search-related variables map3 findpath$,s,JSON_MAX_PATH ! [114] path where we are looking for an item map3 findpath'len,b,4 ! length of Findpath$ map3 foundpath$,s,JSON_MAX_PATH ! [114] path where an item found map3 arylvl,b,2 ! current array level map2 Traverse ! traversal-related variables map3 processed,b,4 ! # processed map3 skipped,b,4 ! # skipped map3 traverse'status,i,2 ! 0=not yet found, 1=found, -1=quit map3 flags,b,4 ! MLJF_xxx map3 selection$,s,JSON_MAX_PATH ! [114] selection criteria (not yet defined) map2 Status ! [116] map3 status'code,i,2 ! [116] used by low-level funcs to pass error info back endstruct ++pragma PRIVATE_BEGIN map1 Mlj, ST_MLJ_MODULE_VARS ! [113] map1 MLJ'Dynamic'Strings ! [114] move these out of structure map2 MLJ'Workbuf$,s,0 ! buffer containing unparsed text dimx Aryidx(0),b,4,auto_extend ! array index within levels dimx $mljmap, ordmap(varstr;varstr) ! [112] ! [117] Set a minimum requirement of 6.5. for the entire library ! [117] (this is slightly overkill but allows us to use writeable ! [117] iterators without worrying about the version) if Fn'MinAshVer(6,5,1633,0) < 0 then ? "Warning: the mlistjson.bsi library requires 6.5.1633.0+" trace.print "Warning: the mlistjson.bsi library requires 6.5.1633.0+" ! note that we don't have a means here to force the calling function ! to exit with an error; we'll just rely on the screen and trace message endif ++pragma PRIVATE_END ![117] !--------------------------------------------------------------------- !Function: ! Create a new JSON DOM consisting of an empty object. ! Same as deserializing a JSON string consisting of "{}" !Params: ! $json() (MLIST) [byref] - mlist to return document in !Returns: ! 0 = success (not sure if it's possible to fail) ! !Module vars: !Notes: ! Resets/clears the $json() struct if not empty !--------------------------------------------------------------------- Function Fn'MLJ'CreateObject($json() as mlist(varstr)) as i4 if .extent($json()) > 0 then .clear $json() endif $json(.pushback) = "{}" EndFunction ![117] !--------------------------------------------------------------------- !Function: ! Create a new JSON DOM consisting of an empty array. ! Same as deserializing a JSON string consisting of "[]" !Params: ! $json() (MLIST) [byref] - mlist to return document in !Returns: ! 0 = success (not sure if it's possible to fail) ! !Module vars: !Notes: ! Resets/clears the $json() struct if not empty !--------------------------------------------------------------------- Function Fn'MLJ'CreateArray($json() as mlist(varstr)) as i4 if .extent($json()) > 0 then .clear $json() endif $json(.pushback) = "[]" EndFunction !--------------------------------------------------------------------- !Function: ! Load JSON document from file into MLIST !Params: ! fspec$ (str) [in] - JSON file [118] ignore if blank and ch > 0 ! ch (num) [in] - optional input ch (already opened by caller) [118] ! $json() (MLIST) [byref] - mlist to return document in ([120] cleared at start) !Returns: ! file size in bytes (0 for non-existent, <0 for error) ! -1 = does not appear to be JSON (doesn't start with "[" or "{") ! -2 = Version of A-Shell not sufficient ! !Module vars: ! Mlj.chin - open input channel !Notes: !--------------------------------------------------------------------- Function Fn'MLJ'Load(fspec$="" as T_NATIVEPATH:inputonly, & ch=0 as b2:inputonly, & ! [118] $json() as mlist(varstr)) as i4 map1 locals map2 token$,s,2 map2 status,i,4 .clear $json() ! [120] ! check if A-Shell version sufficent if Fn'MinAshVer(6,3,1534,0) < 0 then ? "Sorry, this routine requires 6.3.1534.0+" .fn = -2 exitfunction endif if fspec$ = "" and ch > 0 then ! [118] Mlj.chin = ch .fn = 1 else xcall SIZE, fspec$, .fn Mlj.chin = 0 endif if .fn > 0 then ! [111] if Mlj.chin = 0 then ! [118] Mlj.chin = Fn'NextCh(50000) open #Mlj.chin, fspec$, input endif token$ = fn'mlj'next'token$() ! get first token trace.print (99,"mlistjson") token$ if token$ # "[" and token$ # "{" then .fn = -1 else $json(.pushback) = token$ token$ = ifelse$(token$="[","]","}") ! expected ending token Mlj.level = 0 status = fn'mlj'parse($json(.back).sublist, token$) if status >= 0 then ! successful completion $json(.back) += token$ ! node now contains {} or [] else $json(.back) += " !!Error: missing terminator; status="+status endif endif if ch = 0 then ! [118] close #Mlj.chin endif Mlj.chin = 0 endif EndFunction !--------------------------------------------------------------------- !Function: ! Load JSON document/object from string into MLIST !Params: ! s$ (str) [in] - JSON string ! $json() (MLIST) [byref] - mlist to return document in [120] (cleared at start) ! allowitem (BOOLEAN) [in] - .TRUE to allow loading of an item (scalar, name:value, etc.) ! rather than requiring an {object} or [array] [116] !Returns: ! # bytes in string (0 for non-existent, <0 for error) ! -1 (MLJERR_BAD_JSON) = does not appear to be JSON (doesn't start with "[" or "{") ! -2 (MLJERR_ASH_VER) = Version of A-Shell not sufficient ! !Module vars: !Notes: !--------------------------------------------------------------------- Function Fn'MLJ'LoadFromString(s$ as s0:inputonly, & ! [119] was T_NATIVEPATH $json() as mlist(varstr), allowitem as BOOLEAN:inputonly) as i4 map1 locals map2 token$,s,0 map2 endtoken$,s,2 map2 status,i,4 .clear $json() ! [120] !>! ! check if A-Shell version sufficent !>! if Fn'MinAshVer(6,3,1534,0) < 0 then !>! ? "Sorry, this routine requires 6.3.1534.0+" !>! .fn = MLJERR_ASH_VER ! (-2) !>! exitfunction !>! endif trace.print (99, "mlistjson") "Fn'MLJ'LoadFromString", allowitem, s$ .fn = len(s$) if .fn > 0 then token$ = fn'mlj'next'token$(s$) ! get first token trace.print (99, "mlistjson") token$, .fn !>![116] !>! if token$ # "[" and token$ # "{" then !>! .fn = MLJERR_BAD_JSON ! (-1} !>! else if (token$ = "[" or token$ ="{") & ! [116][117] or (allowitem and (token$[-1,-1] = "[" or token$[-1,-1] = "{")) then ! [117] $json(.pushback) = token$ token$ = token$[-1,-1] if token$ = "[" then endtoken$ = "]" elseif token$ = "{" then endtoken$ = "}" else endtoken$ = "" ! this would be for allowitem case endif Mlj.level = 0 status = fn'mlj'parse($json(.back).sublist, endtoken$, s$) ! [115][117] if status >= 0 then ! successful completion $json(.back) += endtoken$ ! node now contains {} or [] else $json(.back) += " !!Error: missing terminator; status="+status endif elseif allowitem then ! [116] this should be a name:value or scalar $json(.pushback) = token$ ! [116] (i.e. a single token) else .fn = MLJERR_BAD_JSON ! (-1) endif close #Mlj.chin Mlj.chin = 0 endif EndFunction !--------------------------------------------------------------------- !Function: ! Write JSON data from the MLIST format created by Fn'MLJ'Load back ! to JSON file format (i.e. serialize it to a file) !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! fspec$ (s0) [in/out] - file to output to. If "", data is output ! directly to the string (must be s0) ! indent (num) [in] - spaces to indent per level; 0=compact stream format !Returns: ! # bytes output (0 for no data, <0 for error) ! -1 = does not appear to be JSON (doesn't start with "[" or "{") ! -2 = Version of A-Shell not sufficient ! !Module vars: ! Mlj.chout (output channel) ! Mlj.level ! Mlj.indent ! Mlj.outbytes (updated by lower level output routine) !Notes: !--------------------------------------------------------------------- Function Fn'MLJ'Serialize($json() as mlist(varstr), & fspec$ as s0, indent as b2:inputonly) as i4 map1 locals map2 status,i,4 map2 tempspec$,s,32 ! check if A-Shell version sufficent if Fn'MinAshVer(6,3,1532,0) < 0 then ? "Sorry, this routine requires 6.3.1532.0+" Fn'MLJ'Serialize = -2 exitfunction endif ! if no file specified, generate a temp file name ! (we'll read it back to a string later) if fspec$ = "" then tempspec$ = strip(.JOBNAME) + ".tmp" fspec$ = tempspec$ endif Mlj.chout = Fn'NextCh(50000) open #Mlj.chout, fspec$, output Mlj.indent = indent ! save indent at module level Mlj.level = 0 ! init level Mlj.outbytes = 0 ! init output byte count Fn'MLJ'Serialize = fn'mlj'serialize($json()) close #Mlj.chout if tempspec$ # "" then ! load file back into return var fspec$ = Fn'FileToStr$(tempspec$) xputarg @fspec$ Fn'MLJ'Serialize = len(fspec$) ! return # bytes output kill tempspec$ else Fn'MLJ'Serialize = Mlj.outbytes ! return # bytes output endif Mlj.chout = 0 trace.print (99,"json") Fn'MLJ'Serialize, Mlj.outbytes, tempspec$ EndFunction !--------------------------------------------------------------------- !Function: ! Return value of a name:value pair !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in] - value name to search for, optionally prepended by path ! returns fully qualified current path where found [106] ! flags (num) [in] - optional flags [121] (default MLJF_UNQUOTE) ! MLJF_UNQUOTE - remove quotes from returned value !Returns: ! value in name:value pair ! or "" if not found ! or "[]" or "{}" if value is an array or object !Module Vars ! Sets Mlj.findpath$, Mlj.findpath'len ! Retrieves Mlj.foundpath$ !Notes: ! See notes at top of this file for mlist encoding and path details !--------------------------------------------------------------------- Function Fn'MLJ'GetNamedValue$($json() as mlist(varstr), & namepath$ as s0, & flags=MLJF_UNQUOTE as b4:inputonly) as s0 call fn'mlj'init'module'search'vars(namepath$) ! validate, init, set search params in mod vars Fn'MLJ'GetNamedValue$ = fn'mlj'namedvalue$($json(),"",JSON_GETONLY_VALUE$) if flags and MLJF_UNQUOTE then Fn'MLJ'GetNamedValue$ = Fn'Unquote$(Fn'MLJ'GetNamedValue$) endif if Fn'MLJ'GetNamedValue$ # "" then ! if value returned (found) namepath$ = Mlj.foundpath$ ! also return the Mlj.foundpath$ else namepath$ = "" endif xputarg @namepath$ EndFunction ![106] !--------------------------------------------------------------------- !Function: ! Set the value of item !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in/out] - path of item (see notes) ! value$ (str) [in] - value to set ! .NULL to remove (works for any object) ! or any legal scalar value (only works for scalar-valued items) !Returns: ! original value in name:value pair ! note that in case of "[]" or "{}", new value is NOT SET except in case of .NULL (deleted) !Module Vars ! Mlj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mlj.foundpath$ to be set to path we find the item at. (Should be the same as Mlj.findpath$ ! unless Mlj.findpath$ is partial) !Notes: ! Equivalent to Fn'MLJ'GetNamedValue$ if value$ = JSON_GETONLY_VALUE$ ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Function Fn'MLJ'SetNamedValue$($json() as mlist(varstr), & namepath$ as s0, & value$ as s0:inputonly) as s0 call fn'mlj'init'module'search'vars(namepath$) Fn'MLJ'SetNamedValue$ = fn'mlj'namedvalue$($json(),"",value$) if Fn'MLJ'SetNamedValue$ # "" then ! if value returned (found) namepath$ = Mlj.foundpath$ ! also return the found path else namepath$ = "" endif xputarg @namepath$ EndFunction ![116] !--------------------------------------------------------------------- !Function: ! Set the value of item. Nearly same as Fn'MLJ'SetNamedValue$() except ! intended for setting object and array values (rather than simple ! scalar values). Due to the greater potential for errors (like invalid ! syntax in the object to be set), this version returns a status code ! (0 for success, else error). !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in/out] - path of item (see notes) ! value$ (str) [in] - value to set ! .NULL to remove (works for any object or array) ! { ... } (string representation of an object) ! [ ... ] (string representation of an array) ! or any legal scalar value ! origvalue$ (str) [out] - returns original value !Returns: ! 0 on success, else an MLJERR_xxx code !Module Vars ! Mlj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mlj.foundpath$ to be set to path we find the item at. (Should be the same as Mlj.findpath$ ! unless Mlj.findpath$ is partial) ! Mlj.status'code !Notes: ! See Fn'MLJ'SetNamedValue$() ! See notes at top of this file for mlist encoding details. ! !--------------------------------------------------------------------- Function Fn'MLJ'SetNamedValueX($json() as mlist(varstr), & namepath$ as s0, & value$ as s0:inputonly, & origvalue$ as s0:outputonly) as i2 call fn'mlj'init'module'search'vars(namepath$) origvalue$ = fn'mlj'namedvalue$($json(),"",value$) if origvalue$ # "" then ! if value returned (found) namepath$ = Mlj.foundpath$ ! also return the found path else namepath$ = "" endif xputarg @namepath$ xputarg @origvalue$ .fn = Mlj.status'code EndFunction ![117] !--------------------------------------------------------------------- !Function: ! Append a name:value pair to a branch of the JSON document specified ! by a path !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! path$ (str) [in] - path of array or object to append to ! name$ (str) [in] - name ! value$ (str) [in] - value (use "[]" for an empty array, "{}" for an empty object) !Returns: ! 0 on success, else an MLJERR_xxx code !Module Vars ! Mlj.status'code !Notes: ! See notes at top of this file for mlist encoding and path details. ! value$ will we quoted if not numeric, {}, [], or a special scalar !--------------------------------------------------------------------- Function Fn'MLJ'AppendNameValue($json() as mlist(varstr), & path$ as s0:inputonly, & name$ as s0:inputonly, & value$ as s0:inputonly) as i2 name$ = Fn'Quote$(name$,FNQF_TRIM) if not fn'mlj'is'json'literal(value$) then if not fn'mlj'is'json'number(value$) then value$ = Fn'Quote$(value$,FNQF_TRIM) endif endif call fn'mlj'init'module'search'vars(path$) .fn = fn'mlj'appenditem($json(),"",name$+":"+value$) EndFunction ![116] !--------------------------------------------------------------------- !Function: ! Append a name:value pair, scalar, object or array to end of specified ! namepath$. Similar to Fn'MLJ'SetNamedValueX() except that we are ! appending instead of replacing a value. !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in] - path of array or object to append to ! value$ (str) [in] - value to set ! .NULL to remove (works for any object or array) ! { ... } (string representation of an object) ! [ ... ] (string representation of an array) ! or any legal scalar value !Returns: ! 0 on success, else an MLJERR_xxx code !Module Vars ! Mlj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mlj.foundpath$ to be set to path we find the item at. (Should be the same as Mlj.findpath$ ! unless Mlj.findpath$ is partial) ! Mlj.status'code !Notes: ! See Fn'MLJ'SetNamedValue$() ! See notes at top of this file for mlist encoding details. ! !--------------------------------------------------------------------- Function Fn'MLJ'AppendItemX($json() as mlist(varstr), & namepath$ as s0, & value$ as s0:inputonly) as i2 call fn'mlj'init'module'search'vars(namepath$) .fn = fn'mlj'appenditem($json(),"",value$) EndFunction ![110] !--------------------------------------------------------------------- !Function: ! Traverse the JSON doc from a specified starting point, calling ! a specified callback function for each item !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in/out] - starting path ! @fn'callback() - callback function !Returns: ! # of items scanned (from namepath$ until terminated by callback) !Globals: !Notes: ! Callback routine is called via: ! fn'callback(curpath$, item$) ! Returns: ! 1 if the item was "processed" (whatever that means) ! 0 if if skipped ! -1 to terminate the traverse ! See MLISTJSON2.BP[908,53] for example !--------------------------------------------------------------------- Function Fn'MLJ'Traverse($json() as mlist(varstr), & namepath$ as s0, & @fn'callback() as lblref) as i4 call fn'mlj'init'module'search'vars(namepath$) ! call fn'mlj'traversex($json(), "", @fn'callback(), .FALSE) Fn'MLJ'Traverse = Mlj.processed EndFunction ![112] !--------------------------------------------------------------------- !Function: ! Variation of Fn'MLJ'Traverse that uses a fixed callback to copy ! selected items from JSON document to and ordmap !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! namepath$ (str) [in/out] - starting path ! $map() (ORDMAP) [byref] - {path}name -> value ! flags (num) [in] - See MLJF_xxx flags ! selection$ (str) [in] - item selection criteria to pass to ! callback (nothing yet defined for this) !Returns: ! # of items scanned (from namepath$ until terminated by callback) !Module Vars: ! flags -> Flags and selection -> Selection (for passing to callback) !Notes: ! Callback routine is called via: ! fn'cb'traverse'to'map(curpath$, item$) ! Returns: ! 1 if the item was "processed" (whatever that means) ! 0 if if skipped ! -1 to terminate the traverse !--------------------------------------------------------------------- Function Fn'MLJ'TraverseToMap($json() as mlist(varstr), & namepath$ as s0, & $map() as ordmap(varstr;varstr), & flags as b4:inputonly, & selection$ as s0:inputonly) as i4 call fn'mlj'init'module'search'vars(namepath$, flags=flags, selection$=selection$) .clear $map() call fn'mlj'traversex($json(), "", @fn'cb'traverse'to'map(), .FALSE) ! copy module private map to caller's map ! (this seems somewhat inelegant, but no worse, and probably more efficient, than passing ! the $map to the fn'mlj'traversex() routine (complicating it for the regular ! Fn'MLJ'Traverse() function, and also requiring it to be passed to itself for every ! recursive call) foreach $$i in $mljmap() $map(.key($$i)) = $$i next $$i .clear $mljmap() Fn'MLJ'TraverseToMap = Mlj.processed EndFunction !--------------------------------------------------------------------- !Function: ! extract item name from item !Params: ! item$ (str) [in] - item !Returns: ! "name" ! or "" (for unnamed items) !Globals: !Notes: ! name will be quoted, if there is one. !--------------------------------------------------------------------- Function Fn'MLJ'Item'Name$(item$ as s0:inputonly) as s JSON_MAX_NAME map1 x,i,4 x = instr(1,item$,":",INSTRF_ANYQT) if x then Fn'MLJ'Item'Name$ = item$[1,x-1] if item$[1,1] # """" then Fn'MLJ'Item'Name$ = """" + Fn'MLJ'Item'Name$ + """" ! [116] endif endif EndFunction ![115] !--------------------------------------------------------------------- !Function: ! Convert an ordmap to a JSON object string of format: ! { "name":"value", "name":"value", ... } !Params: ! $map() (ordmap(varstr;varstr)) [byref,in] - map of name->value !Returns: ! { "name":"value", "name":"value", ... } !Globals: !Notes: !--------------------------------------------------------------------- Function Fn'MLJ'MapToObjectString$($map() as ordmap(varstr;varstr)) as s0 map1 locals map2 count,b,4 .fn = "{ " foreach $$i in $map() if count then .fn += ", " endif count += 1 .fn += """" + .key($$i) + """:""" + $$i + """" next $$i .fn += " }" EndFunction !--------------------------------------------------------------------- !Function: ! extract item value from item !Params: ! item$ (str) [in] - item !Returns: ! value portion of item (for sublist, either {} or []) !Globals: !Notes: ! string values are quoted, booleans and numbers, not !--------------------------------------------------------------------- Private Function Fn'MLJ'Item'Value$(item$ as s0:inputonly) as s0 map1 x,i,4 x = instr(1,item$,":",INSTRF_ANYQT) Fn'MLJ'Item'Value$ = item$[x+1,-1] EndFunction !=================================================================== !Private Functions !=================================================================== ![106][116] (enhanced to support object and array values) !--------------------------------------------------------------------- !Function: ! Get and optionally Set value (scalar or object) of a name:value pair (if found) !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! curpath$ (str) [in] - current path [108] ! value$ (str) [in] - value to set ! .NULL to remove item (including sub-objects, sub-arrays) ! JSON_GETONLY_VALUE$ to leave alone, i.e. Get only ! an object of form "{ ... }" [116] ! an array of form "[ ... ]" [116] ! or any legal scalar value ! barray (BOOLEAN) [in] - internal use for recursion only - set to indicate ! we are processing an array !Returns: ! Original value in name:value pair ([116] will be "[]" or "{}" for array/object values) ! [116] this no longer true --- ! Note that when value is a sublist ("[]" or "{}"), ! the new value is NOT SET, except in case of .NULL (in which ! case the item and any attached sublist is deleted) ! [116] instead, the existing value (including any sublist) is deleted, ! and unless the new value is .NULL, it is replaced. !Module Vars ! Mlj.findpath$ contains the {path}name we are looking for ! Mlj.findpath'len is length of Mlj.findpath$ ! Mlj.foundpath$ to be set to the actual path where found ! Mlj.arylvl is current array nesting level ! Mlj.status'code set to 0 on success, else error !Notes: ! Called Recursively!!! ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Private Function fn'mlj'namedvalue$($json() as mlist(varstr), & curpath$ as s0:inputonly, & value$ as s0:inputonly,& barray as BOOLEAN:inputonly) as s0 map1 locals map2 item$,s,0 map2 name$,s,JSON_MAX_NAME map2 x,i,4 map2 y,i,4 map2 subchar$,s,1 map2 bsubarray,BOOLEAN map2 parentpath$,s,0 map2 bsublist,BOOLEAN map2 idx,b,4 map2 status,i,4 map2 token$,s,2 ! [116] map2 save'value$,s,60 ! [116] trace.print (99,"mlistjson") "fn'mlj'namedvalue$",curpath$,value$, Mlj.findpath$ ! traverse the json list to locate the curpath$ ... foreach $$i in $json() item$ = $$i ! slightly more efficient than many refs to iterator if instr(1,item$,"[{",INSTRF_ANYQT) then bsublist = .TRUE else bsublist = .FALSE endif if barray then ! if processing an array, increment item # for each time thru loop Aryidx(Mlj.arylvl) += 1 idx = Aryidx(Mlj.arylvl) else idx = 0 endif ! plan: ! 1) if match, process ! 2) else if sublist and compatible with target path, recurse down ! 3) else just proceed to next item ! 1) check for match if fn'mlj'path'match(curpath$,item$,idx) then ! we have a MATCH!!! fn'mlj'namedvalue$ = Fn'MLJ'Item'Value$(item$) Mlj.foundpath$ = fn'mlj'fix'array'idx$(curpath$, item$, idx) ! replace value if not special JSON_GETONLY_VALUE$ and old value scalar or new value .NULL if value$ # JSON_GETONLY_VALUE$ then Mlj.status'code = 0 ! so far so good if .isnull(value$) then ! any item can be deleted $json(.ref($$i)).sublist = .NULL ! [116] delete sublist if it exists $json(.ref($$i)) = .NULL ! [116] delete item else ! [116] item value replacement if bsublist then ! [116] if item value was a sublist $$i.sublist = .NULL ! [116] delete the sublist first endif ![116] check if the value is an object or array by looking at first char xcall TRIM, value$, 1 ! [116] replacement value is an object/array sublist... if instr(1,"[{",value$[1,1]) then ! check if A-Shell version sufficent if Fn'MinAshVer(6,5,1633,0) < 0 then ? "Sorry, this routine requires 6.5.1633.0+" .fn = MLJERR_ASH_VER exitfunction endif ! We can't just use LoadFromString here because it wants to use .back ! to reference the parent node. So this is a modified version... save'value$ = fn'mlj'next'token$(value$) ! now get first token token$ = ifelse$(save'value$="[","]","}") ! determine end token save'value$ += token$ trace.print (99,"mlistjson") token$,value$ status = fn'mlj'parse($$i.sublist, token$, value$) ! and now parse up to it trace.print (99,"mlistjson") $$i.sublist if status >= 0 then ! success Mlj.status'code = 0 else save'value$ += " !!Error: missing terminator; status="+status Mlj.status'code = status endif value$ = save'value$ endif ! [116] (fall thru to set item value) ![116] elseif not fn'mlj'item'is'sublist(fn'mlj'namedvalue$) then name$ = Fn'MLJ'Item'Name$(item$) if name$ # "" then name$ += ":" endif ! determine quoting based on prior value and whether new value is literal if Fn'IsQuoted(fn'mlj'namedvalue$) & and not fn'mlj'is'json'literal(value$) then ! if old value was quoted and new value not a special literal item$ = name$ + Fn'Quote$(value$) ! then quote the new one else item$ = name$ + value$ endif !trace.print (99,"mlistjson") "replacing "+$$i+" with "+item$ ![116] $json(.ref($$i)) = item$ ! (old fashioned/deprecated version) $$i = item$ ! [116] endif endif exit else !trace.print (99,"mlistjson") "path/curpath mismatch" endif ! 2) if sublist, recurse down if bsublist then ! sublist ! update current path before descending parentpath$ = curpath$ ! use a temp var for current path passed to children if barray then ! if currently in an array, fix the idx for the benefit of the children x = instr(1,parentpath$,JSON_ARYIDX_MARKER$) if x then parentpath$ = parentpath$[1,x-1] + str(Aryidx(Mlj.arylvl)) + parentpath$[x+2,-1] endif endif ! before descending, add the current item to the path to be seen by children ! note multiple cases: ! [] -> [JSON_ARYIDX_MARKER$] ! {} -> . ! name:[] -> name[JSON_ARYIDX_MARKER$] ! name:{} -> name. x = instr(1,item$,":",INSTRF_ANYQT) ! is item named$ if x then ! yes - add name to path parentpath$ += item$[1,x-1] endif ! see if we can skip the descent of this branch if fn'mlj'can'skip'descent(parentpath$) then repeat endif if item$[-1,-1] = "}" then ! if sublist an object parentpath$ += "." ! then add . to curpath (else the object will just be [1]) else parentpath$ += "[" + JSON_ARYIDX_MARKER$ + "]" ! for array, add [JSON_ARYIDX_MARKER$] Mlj.arylvl += 1 Aryidx(Mlj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif fn'mlj'namedvalue$ = fn'mlj'namedvalue$($$i.sublist,parentpath$,value$,bsubarray) ! recurse for sublist [106] !trace.print (99,"mlistjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mlj.arylvl = (Mlj.arylvl - 1) max 0 if Mlj.arylvl = 0 then bsubarray = .FALSE endif endif if fn'mlj'namedvalue$ # "" then ! found at lower level, so we can exit this one !trace.print (99,"mlistjson") "*INHERITED MATCH*" exit endif endif ! 3) else just proceed to next next $$i trace.print (99,"mlistjson") fn'mlj'namedvalue$,Mlj.findpath$,Mlj.foundpath$ EndFunction ![116] append an item to an object or array !--------------------------------------------------------------------- !Function: ! Append an item (to an array or object) !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! curpath$ (str) [in] - current path ! value$ (str) [in] - value to append ! an object of form "{ ... }" ! an array of form "[ ... ]" ! a name:value pair (may be multi-level) ! or any legal scalar value ! barray (BOOLEAN) [in] - internal use for recursion only - set to indicate ! we are processing an array !Returns: ! MLJERR_PATH_NOT_FOUND, 0 (found), other errors !Module Vars ! Mlj.findpath$ contains the {path}name we are looking for ! Mlj.findpath'len is length of Mlj.findpath$ ! Mlj.foundpath$ to be set to the actual path where found ! Mlj.arylvl is current array nesting level ! Mlj.status'code set to 0 on success, else error !Notes: ! Called Recursively!!! ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Private Function fn'mlj'appenditem($json() as mlist(varstr), & curpath$ as s0:inputonly, & value$ as s0:inputonly,& barray as BOOLEAN:inputonly) as i4 map1 locals map2 item$,s,0 map2 name$,s,JSON_MAX_NAME map2 x,i,4 map2 y,i,4 map2 subchar$,s,1 map2 bsubarray,BOOLEAN map2 parentpath$,s,0 map2 bsublist,BOOLEAN map2 idx,b,4 map2 status,i,4 map2 token$,s,2 map2 orig'value$,s,0 trace.print (99,"mlistjson") "fn'mlj'appenditem",curpath$,value$ .fn = MLJERR_PATH_NOT_FOUND ! traverse the json list to locate the curpath$ ... foreach $$i in $json() item$ = $$i ! slightly more efficient than many refs to iterator trace.print (99,"mlistjson") item$ if instr(1,item$,"[{",INSTRF_ANYQT) then bsublist = .TRUE else bsublist = .FALSE endif if barray then ! if processing an array, increment item # for each time thru loop Aryidx(Mlj.arylvl) += 1 idx = Aryidx(Mlj.arylvl) else idx = 0 endif ! plan: ! 1) if match, process ! 2) else if sublist and compatible with target path, recurse down ! 3) else just proceed to next item ! 1) check for match if fn'mlj'path'match(curpath$,item$,idx) then ! we have a MATCH!!! orig'value$ = Fn'MLJ'Item'Value$(item$) Mlj.foundpath$ = fn'mlj'fix'array'idx$(curpath$, item$, idx) ! value must be {} or [] if orig'value$ # "[]" and orig'value$ # "{}" then .fn = MLJERR_BAD_PATH Mlj.status'code = .fn exitfunction endif trace.print (99,"mlistjson") "calling Fn'MLJ'LoadFromString", $$i, $$i.sublist, value$ .fn = Fn'MLJ'LoadFromString(value$, $$i.sublist, allowitem=.TRUE) trace.print (99,"mlistjson") .fn,value$,$$i.sublist if .fn >= 0 then .fn = 0 ! path found endif Mlj.status'code = .fn ! save status globally (probably redundant here) exit endif ! 2) if we hit a sublist, recurse down if bsublist then ! sublist ! update current path before descending parentpath$ = curpath$ ! use a temp var for current path passed to children trace.print (99, "mlistjson") bsublist, parentpath$ if barray then ! if currently in an array, fix the idx for the benefit of the children x = instr(1,parentpath$,JSON_ARYIDX_MARKER$) if x then parentpath$ = parentpath$[1,x-1] + str(Aryidx(Mlj.arylvl)) + parentpath$[x+2,-1] endif endif ! before descending, add the current item to the path to be seen by children ! note multiple cases: ! [] -> [JSON_ARYIDX_MARKER$] ! {} -> . ! name:[] -> name[JSON_ARYIDX_MARKER$] ! name:{} -> name. x = instr(1,item$,":",INSTRF_ANYQT) ! is item named$ if x then ! yes - add name to path parentpath$ += item$[1,x-1] endif ! see if we can skip the descent of this branch if fn'mlj'can'skip'descent(parentpath$) then repeat endif if item$[-1,-1] = "}" then ! if sublist an object parentpath$ += "." ! then add . to curpath (else the object will just be [1]) else parentpath$ += "[" + JSON_ARYIDX_MARKER$ + "]" ! for array, add [JSON_ARYIDX_MARKER$] Mlj.arylvl += 1 Aryidx(Mlj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif .fn = fn'mlj'appenditem($$i.sublist,parentpath$,value$,bsubarray) ! recurse for sublist !trace.print (99,"mlistjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mlj.arylvl = (Mlj.arylvl - 1) max 0 if Mlj.arylvl = 0 then bsubarray = .FALSE endif endif if .fn # MLJERR_PATH_NOT_FOUND then ! found at lower level, so we can exit this one !trace.print (99,"mlistjson") "*INHERITED MATCH*" exit endif endif ! 3) else just proceed to next next $$i EndFunction ![106] !--------------------------------------------------------------------- !Function: ! Variation of fn'mlj'namedvalue$() - same logic to search for the ! specified path, but then instead of returning the found item, or ! changing its value, instead we just keep scanning, calling the callback ! function for each item, until we hit the end or the callback returns -1 !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! curpath$ (str) [in] - current path ! fn'callback() (lblref) - callback function - see Fn'MLJ'Traverse() for details ! barray (BOOLEAN) [in] - internal use for recursion only - set to indicate ! we are processing an array !Returns: ! 0 item not yet found (keep traversing but without callback) ! 1 item found (keep traversing but with callback) ! -1 callback says to quit !Module Vars ! Mlj.findpath$ contains the {path}name we are looking for ! Mlj.findpath'len is length of Mlj.findpath$ ! Mlj.foundpath$ to be set to the actual path where found ! Mlj.arylvl is current array nesting level !Notes: ! Called Recursively!!! ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Private Function fn'mlj'traversex($json() as mlist(varstr), & curpath$ as s0:inputonly, & @fn'callback() as lblref, & barray as BOOLEAN:inputonly) as i2 map1 locals map2 item$,s,0 map2 name$,s,JSON_MAX_NAME map2 x,i,4 map2 y,i,4 map2 subchar$,s,1 map2 bsubarray,BOOLEAN map2 parentpath$,s,0 map2 bsublist,BOOLEAN map2 idx,b,4 foreach $$i in $json() item$ = $$i if instr(1,item$,"[{",INSTRF_ANYQT) then bsublist = .TRUE else bsublist = .FALSE endif if barray then ! if processing an array, increment item # for each time thru loop Aryidx(Mlj.arylvl) += 1 idx = Aryidx(Mlj.arylvl) else idx = 0 endif ! plan: ! 1) if not already found, check for match ! if match, set found flag ! 2) if found, call callback ! 3) if callback returns -1, quit ! 4) if sublist and compatible with target path (or already found), recurse down ! else just proceed to next item ! 1) If not yet found, check for match if Mlj.traverse'status = 0 then ! not yet found ! check for match if fn'mlj'path'match(curpath$,item$,idx) then ! we have a MATCH!!! Mlj.traverse'status = 1 Mlj.foundpath$ = fn'mlj'fix'array'idx$(curpath$, item$, idx) ! set global path (just for kicks) endif endif ! 2) if found, call the callback function if Mlj.traverse'status > 0 then Mlj.traverse'status = fn'callback(fn'mlj'fix'array'idx$(curpath$, "", idx), item$) ! [113] if Mlj.traverse'status > 0 then ! keep track of the processed/skipped totals Mlj.processed += 1 elseif Mlj.traverse'status = 0 then Mlj.skipped += 1 endif endif ! 3) if quit flag returned, quit if Mlj.traverse'status < 0 then exit endif ! 4) if sublist, recurse down if bsublist then ! sublist ! update current path before descending parentpath$ = curpath$ ! use a temp var for current path passed to children if barray then ! if currently in an array, fix the idx for the benefit of the children x = instr(1,parentpath$,JSON_ARYIDX_MARKER$) if x then parentpath$ = parentpath$[1,x-1] + str(Aryidx(Mlj.arylvl)) + parentpath$[x+2,-1] endif endif ! before descending, add the current item to the path to be seen by children ! note multiple cases: ! [] -> [JSON_ARYIDX_MARKER$] ! {} -> . ! name:[] -> name[JSON_ARYIDX_MARKER$] ! name:{} -> name. x = instr(1,item$,":",INSTRF_ANYQT) ! is item named$ if x then ! yes - add name to path parentpath$ += item$[1,x-1] endif ! see if we can skip the descent of this branch if Mlj.traverse'status < 1 then ! (only if we haven't found the starting path) if fn'mlj'can'skip'descent(parentpath$) then repeat endif endif if item$[-1,-1] = "}" then ! if sublist an object parentpath$ += "." ! then add . to curpath (else the object will just be [1]) else parentpath$ += "[" + JSON_ARYIDX_MARKER$ + "]" ! for array, add [JSON_ARYIDX_MARKER$] Mlj.arylvl += 1 Aryidx(Mlj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif call fn'mlj'traversex($$i.sublist,parentpath$,@fn'callback(),bsubarray) ! recurse for sublist !trace.print (99,"mlistjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mlj.arylvl = (Mlj.arylvl - 1) max 0 if Mlj.arylvl = 0 then bsubarray = .FALSE endif endif if Mlj.traverse'status < 0 then ! quit flag returned from lower level exit endif endif ! 5) else just proceed to next next $$i fn'mlj'traversex = Mlj.traverse'status EndFunction !--------------------------------------------------------------------- !Function: ! get next token (from file or string) !Params: ! s$ (str) [in] - string source (if not specified, we use file) [115] !Returns: ! a token (possibly empty) ! "" indicates we hit end of file !Examples: ! { - start of JSON doc containing object ! [ - start of JSON doc containing array ! } - end of object ! ] - end of array ! "name":{ - pair whose value is an object to follow ! "name":[ - pair whose value is an array to follow ! "name":"string" - a name:string-value pair ! "string" - a string value (in an array) ! scalar - a scalar value (in an array) ! !Module vars: ! Mlj.chin (open input file channel) - closed on eof [115] only if no param passed ! MLJ'Workbuf$ (characters read but not yet parsed) [115] shared between string and file versions !Notes: ! Whitespace outside of quoted strings stripped, as are commas !--------------------------------------------------------------------- Private Function fn'mlj'next'token$(s$ as s0:inputonly) as s0 map1 locals map2 i,i,4 if .argcnt then ! [115] if string passed, use it like MLJ'Workbuf$ = s$ ! [115] previously-read but not parsed endif ! [115] file data trace.print (99, "mlistjson") "fn'mlj'next'token$", .argcnt, MLJ'Workbuf$ do ! remove leading spaces, and any ctl chars outside quotes ! note: we know that buffer starts outside of a token, so ! no danger of the leading spaces/tabs being part of a string. MLJ'Workbuf$ = edit$(MLJ'Workbuf$,EDITF_CTLS+EDITF_SPTB+EDITF_EXQT) ! look for next delimiter (not within quotes) ! [102] Warning: this only works for matching sets of quotes ! [102] (We'll have to check for that below, after a match...) i = instr(1,MLJ'Workbuf$,JSON_DELIMITERS$,INSTRF_ANYQT) trace.print (99, "mlistjson") i ! if we didn't get one, then we need to read in more if i = 1 then ! first char is a delimiter if MLJ'Workbuf$[i;1] = "," then ! skip over leading commas MLJ'Workbuf$ = MLJ'Workbuf$[i+1,-1] repeat endif elseif i > 1 then ! [102] make sure the found character ! [102] isn't within an unterminated quoted string ! [102] by counting quotes before it if (fn'mlj'count'quotes(MLJ'Workbuf$,i) mod 2) then ! [102] if odd, then we need i = 0 ! [102] to read in more endif endif if i = 0 then if .argcnt then ! [115] string version; we're done MLJ'Workbuf$ = s$ ! [116] if no delimiters, take entire string as the token exit elseif fn'mlj'read'block() <= 0 then exit ! abort if we run out of data endif endif loop until i > 0 trace.print (99, "mlistjson") .argcnt, i, MLJ'Workbuf$ ! return buffer with just the one token ! if no delimiter, we must be at end of document and buffer must just ! be whitespace (which we'll edit out); anything else we return but ! it's probably garbage if not "" if i = 0 then fn'mlj'next'token$ = MLJ'Workbuf$ MLJ'Workbuf$ = "" elseif i = 1 then fn'mlj'next'token$ = MLJ'Workbuf$[1,1] MLJ'Workbuf$ = MLJ'Workbuf$[2,-1] elseif instr(1,"{[",MLJ'Workbuf$[i;1]) then ! leave opening delimeters on end of token fn'mlj'next'token$ = MLJ'Workbuf$[1,i] MLJ'Workbuf$ = MLJ'Workbuf$[i+1,-1] else ! return buffer up to just before delimiter fn'mlj'next'token$ = MLJ'Workbuf$[1,i-1] MLJ'Workbuf$ = MLJ'Workbuf$[i,-1] endif trace.print (99, "mlistjson") fn'mlj'next'token$ EndFunction !--------------------------------------------------------------------- !Function: ! read another block from the file into the working buffer !Params: !Returns: ! # bytes read (0=eof, -1=input file not open; <-1 error) !Module Vars: ! Mlj.chin (input channel) ! MLJ'Workbuf$ (working buffer) !Notes: ! See notes at top for buffering strategy !--------------------------------------------------------------------- Private Function fn'mlj'read'block() as i4 define JSON_BUF_SIZ = 512 ! # chars to read at a time map1 locals map2 blockbuf$,s,JSON_BUF_SIZ if Mlj.chin then if eof(Mlj.chin) # 1 then ! if not eof blockbuf$ = fill(chr(0),sizeof(blockbuf$)) xcall GET, blockbuf$, Mlj.chin, JSON_BUF_SIZ, fn'mlj'read'block MLJ'Workbuf$ += blockbuf$ endif else fn'mlj'read'block = -1 endif trace.print (99,"mlistjson") "read "+fn'mlj'read'block+" into buf; buflen = "+len(MLJ'Workbuf$) EndFunction !--------------------------------------------------------------------- !Function: ! parse a JSON array or object, up to final "]" or "}" !Params: ! $json() (mlist) [ref] - parsed JSON data stored here (see notes at top) ! endtoken$ (s) [in] - ending token to look for ("]" or "}") ! [116] if "", just go to end ! s$ (str) [in] - if specified, this is data source, not file [115] !Returns: ! >= 0 for success ! < 0 for error !Module vars: ! Mlj.chin, MLJ'Workbuf$ !Notes: !--------------------------------------------------------------------- Private Function fn'mlj'parse($json() as mlist(varstr), endtoken$ as s2:inputonly, & s$ as s0:inputonly) as i4 map1 locals map2 token$,s,0 map2 status,i,4 map2 bdone,BOOLEAN map2 subendtoken$,s,2 trace.print (99, "mlistjson") "fn'mlj'parse", endtoken$, s$ Mlj.level += 1 do if .argcnt > 2 then ! [115] if the s$ parameter passed token$ = fn'mlj'next'token$() ! [115][116] then pass it to the next'token routine else ! [115] else we use file version token$ = fn'mlj'next'token$() endif trace.print (99, "mlistjson") token$ switch token$ case "[" ! parse a new array case "{" ! parse an object $json(.pushback) = token$ subendtoken$ = ifelse$(token$="[","]","}") status = fn'mlj'parse($json(.back).sublist,subendtoken$) if status >= 0 then $json(.back) += subendtoken$ else $json(.back) += " !!Error: missing terminator: "+subendtoken$ endif exit case "]" case "}" status = ifelse(token$=endtoken$,0,-1) bdone = .TRUE exit case "" ! no more data (error?) bdone = .TRUE if endtoken$ = "" then ! [116] if not expecting and end token, ok status = 0 else status = -1 endif exit default switch token$[-1,-1] case "{" ! name:{ case "[" ! name:[ $json(.pushback) = token$ subendtoken$ = ifelse$(token$[-1,-1]="[","]","}") status = fn'mlj'parse($json(.back).sublist,subendtoken$) if status >= 0 then $json(.back) += subendtoken$ else $json(.back) += " !!Error: missing terminator: "+subendtoken$ endif exit default ! add an name:value, or scalar item to our list $json(.pushback) = token$ exit endswitch exit endswitch loop until bdone if status < 0 then fn'mlj'parse = -1 endif Mlj.level -= 1 trace.print (99,"mlistjson") Mlj.level, .fn, token$, endtoken$ EndFunction !--------------------------------------------------------------------- !Function: ! Recursive worker for Fn'MLJ'Serialize !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! outbuf$ (s0) [out] - if Mlj.chout=0, output goes here, else to #Mlj.chout !Returns: ! # bytes output ! -2 = parse error !Module Vars ! Mlj.chout (output channel, already open) ! Mlj.level ! Mlj.indent !Notes: ! Replaces the file if it already exists. ! See notes at top of this file for mlist encoding details. ! Similar to Fn'XMList'Save'Doc() in mlistxml.bsi !--------------------------------------------------------------------- Private Function fn'mlj'serialize($json() as mlist(varstr)) as i4 map1 locals map2 item$,s,0 map2 status,i,4 map2 x,i,4 map2 y,i,4 map2 char$,s,1 Mlj.level += 1 foreach $$i in $json() item$ = $$i ! slightly more efficient than many refs to iterator x = instr(1,item$,"[{",INSTRF_ANYQT) trace.print (99,"mlistjson") item$,x if x then char$ = item$[x;1] if x = 1 then call mlj'out'item(char$) else ! must be "name":[] or "name":{} call mlj'out'item(item$[1,x-1]) ! output "name:": call mlj'out'item(char$) ! output [ or { (possible new line) endif call fn'mlj'serialize($$i.sublist) ! recurse for sublist call mlj'out'item(item$[x+1;1]) ! output closing ] or } else call mlj'out'item(item$) ! scalar or "name":value endif next $$i Mlj.level -= 1 EndFunction !--------------------------------------------------------------------- !Procedure: ! output a new JSON item to output file; handle breaks and indenting !Params: ! item$ (str) [in] - item to output !Module vars: ! Mlj.chout (output channel) ! Mlj.outbytes (# bytes output, counting only one per line terminator) ! Mlj.level (nesting level) ! Mlj.indent (spaces per level to indent; if 0 no line breaks or indenting) !Notes: ! Determines whether a comma is needed based on last character of ! previous item and first character of this item. !--------------------------------------------------------------------- Private Procedure mlj'out'item(item$ as s0) static map1 s_lastchar$,s,1 map1 locals map2 spacecount,b,2 map2 firstchar$,s,1 trace.print (99,"mlistjson") item$ ! append a comma between items as needed... firstchar$ = item$[1,1] if instr(1,"}]",firstchar$) = 0 and s_lastchar$ # "" & and instr(1,"[{:",s_lastchar$) = 0 then ? #Mlj.chout, ","; Mlj.outbytes += 1 endif ! start a new line for each item unless first item or no indent if s_lastchar$ # "" and Mlj.indent > 0 then ? #Mlj.chout Mlj.outbytes += 1 endif if Mlj.indent > 0 and Mlj.level > 0 then spacecount = Mlj.indent*(Mlj.level-1) ? #Mlj.chout, space(spacecount); Mlj.outbytes += spacecount endif ? #Mlj.chout, item$; Mlj.outbytes += len(item$) s_lastchar$ = item$[-1,-1] EndProcedure !--------------------------------------------------------------------- !Function: ! count quote chars in given string, with optional limit pos !Params: ! strbuf (str) [in] - string ! limit (num) [in] - optional limit position !Returns: ! # of quotes in entire string (or up to limit position) !Notes: !--------------------------------------------------------------------- Private Function fn'mlj'count'quotes(strbuf$ as s0:inputonly, limit as b4:inputonly) as b4 map1 q,i,4 if limit = 0 then limit = len(strbuf$) endif do while q <= limit q = instr(q+1,strbuf$,"""") if q > 0 and q < limit then fn'mlj'count'quotes += 1 else exit endif loop EndFunction !--------------------------------------------------------------------- !Function: ! determine if current path matches requested path !Params: ! curpath$ (str) [in] - our path context (parent) ! item$ (str) [in] - current item within path (where we're at) ! aryidx (num) [in] - if specified, replace JSON_ARYIDX_MARKER$ with this !Returns: ! .TRUE or .FALSE !Module globals: ! Mlj.findpath$ - the path we are looking for ! Findpath'Stripped$ - version with quoted names unquoted !Notes: ! Empty Mlj.findpath$ matches everything ! Requested path is Mlj.findpath$ ! If Mlj.findpath$ starts with "*" then just do a right-anchored match; ! else complete match. ! Assumption is that Mlj.findpath$ has been fully quoted (likewise for curpath$ and item$) ! [117] treat . as a match for the top node !--------------------------------------------------------------------- Private Function fn'mlj'path'match(curpath$ as s0:inputonly, & item$ as s0:inputonly, & aryidx as b4:inputonly) as BOOLEAN map1 locals map2 x,i,4 map2 rp,i,4 map2 reqpath$,s,0 trace.print (99, "mlistjson") "fn'mlj'path'match", curpath$, item$, Mlj.findpath$ if Mlj.findpath$ = "" then fn'mlj'path'match = .TRUE else if Mlj.findpath$[-1,-1] = "." then ! [113] deal with special case of searching if item$ = "{}" or item$ = "[]" then ! [113] for parent of an object [117] or an array item$ = "" fn'mlj'path'match = .TRUE ! [117] this is a special case match else item$ = "." endif endif curpath$ = fn'mlj'fix'array'idx$(curpath$, item$, aryidx) trace.print (99, "mlistjson") curpath$, Mlj.findpath$, Mlj.findpath'len ! can't easily use regex for the path because it has brackets, dots, etc. ! so we just do a right-anchored match. xcall XSTRIP, curpath$, """", 1 ! [117] remote all quotes from the curpath$ for comparison x = len(curpath$) - Mlj.findpath'len + 1 if curpath$[x,-1] = Mlj.findpath$ then fn'mlj'path'match = .TRUE Mlj.foundpath$ = Mlj.findpath$ ! [117] endif endif trace.print (99, "mlistjson") fn'mlj'path'match, Mlj.foundpath$ EndFunction !--------------------------------------------------------------------- !Function: ! convert pro-forma array [] to actual [#] !Params: ! path$ (str) [in] - path possibly containing [JSON_ARYIDX_MARKER$] ! item$ (str) [in] - current item ! aryidx (num) [in] - current array idx !Returns: ! updated path$ with aryidx plugged in !Globals: !Notes: !--------------------------------------------------------------------- Private Function fn'mlj'fix'array'idx$(path$ as s0:inputonly, & item$ as s0:inputonly, & aryidx as b4:inputonly) as s0 map1 x,i,4 trace.print (99, "mlistjson") "fn'mlj'fix'array'idx$", path$, item$, aryidx x = instr(1,path$,JSON_ARYIDX_MARKER$) if x then fn'mlj'fix'array'idx$ = path$[1,x-1] + str(aryidx) + path$[x+2,-1] else fn'mlj'fix'array'idx$ = path$ endif fn'mlj'fix'array'idx$ += Fn'MLJ'Item'Name$(item$) !>! if item$ = "{}" then ! [113] !>! fn'mlj'fix'array'idx$ += "." !>! endif trace.print (99, "mlistjson") fn'mlj'fix'array'idx$, path$, item$, aryidx EndFunction !--------------------------------------------------------------------- !Function: ! return true if item (or item value) is sublist !Params: ! item$ (str) [in] - either name:value or just value !Returns: ! .TRUE if sublist !Globals: !Notes: !--------------------------------------------------------------------- Private Function fn'mlj'item'is'sublist(item$ as s0:inputonly) as BOOLEAN map1 value$,s,2 value$ = item$[-2,-1] if value$ = "{}" or value$ = "[]" then fn'mlj'item'is'sublist = .TRUE endif EndFunction !--------------------------------------------------------------------- !Function: ! return true if we can skip descending at this point because ! the target path is in another array item of current array !Params: ! parentpath$ (str) [in] - parent path (to be passed to children) !Returns: ! .TRUE if sublist !Module Globals: ! FindPath$ !Notes: ! Mlj.findpath$ can contain quoted names or not (but not a mixture) !--------------------------------------------------------------------- Private Function fn'mlj'can'skip'descent(parentpath$ as s0:inputonly) as BOOLEAN if (Mlj.findpath$[1,1] = "." or Mlj.findpath$[1,1] = "[") and parentpath$ # "" then if parentpath$ # Mlj.findpath$[1;len(parentpath$)] then fn'mlj'can'skip'descent = .TRUE endif endif EndFunction !--------------------------------------------------------------------- !Function: ! Init module variables related to searching. !Params: ! reqpath$ (str) [in] - required path ! flags (num) [in] - optional flags to set module Flags ! selection$ (str) [in] - optional selection string to set Selection$ !Returns: ! .TRUE unless an error !Module Globals: ! Mlj.findpath$ - copy of reqpath$ with all parts quoted per std JSON ! Mlj.findpath'len set to len(Mlj.findpath$) ! Mlj.arylvl set to 0 ! Mlj.foundpath$ set to "" ! Mlj.processed and Mlj.skipped set to 0 ! Flags set to flags [112] ! Selection$ set to selection$ [112] !Notes: ! As of 6.5.1639.3+, you could use the more convenient Fn'Explode'Ary() ! with an auto-extend array passed by ref. But to maximize backward ! compatility, we'll do it more clumsily and set a limit of 16 ! levels of path. (We could work around the limit by calling Fn'ExplodeEx ! in a loop, but that's even more overkill for the situation.) ! No matter what we need fnexplode.bsi [109]+ !--------------------------------------------------------------------- Private Function fn'mlj'init'module'search'vars(findpath$ as s0:inputonly, & flags=0 as b4:inputonly, & selection$="" as s0:inputonly) as BOOLEAN map1 locals map2 delimiter$,s,4,".[" map2 tokens,i,2 map2 i,i,2 map2 x,i,2 map2 lenpath,i,2,len(findpath$) ! fully quote it by first tokenizing it (which removes the quotes) !>! ! This version requires 6.5.1369.3+, compiler 866+ !>! dimx token$(0),x,0,auto_extend !>! tokens = Fn'Explode'Ary(findpath$, delimiter$, FXF_QUOTE, token$()) ! this version compatible with 6.4 but still requires fnexplode.bsi [109]+ !! dimx token$(16),s,0 tokens = Fn'ExplodeEx(findpath$, delimiter$, FXF_QUOTE, token$(1), token$(2), token$(3), & token$(4), token$(5), token$(6), token$(7), token$(8), token$(9), token$(10), & token$(11), token$(12), token$(13), token$(14), token$(15), token$(16)) ! note that we lose the delimiters in the above process, but can ! figure out what they were by the tokens left behind ! now rebuild the Mlj.findpath$ with the name parts quoted Mlj.findpath$ = "" for i = 1 to tokens x = instr(1,token$(i),"]",INSTRF_ANYQT) if x then Mlj.findpath$ += "[" + token$(i) elseif token$(i) = "." then ! [113] this happens with multiple contiguous dots (a..b) Mlj.findpath$ += "." elseif asc(token$(i)) then ! this test for null more reliable than #"" (until 6.5.1539.3 patch) Mlj.findpath$ += ifelse$(i > 1,".","") + Fn'Quote$(token$(i)) elseif i > 1 and i < tokens then x = instr(1,token$(i+1),"]",INSTRF_ANYQT) if x = 0 then Mlj.findpath$ += "." endif endif next i ! Restore leading . if lost in shuffle above if findpath$[1,1] = "." and Mlj.findpath$[1,1] # "." then Mlj.findpath$ = "." + Mlj.findpath$ endif ! [113] and trailing . if findpath$[-1,-1] = "." and Mlj.findpath$[-1,-1] # "." then Mlj.findpath$ += "." endif xcall XSTRIP, Mlj.findpath$, """", 1 ! [117] remove quotes from findpath for uniformity Mlj.findpath'len = len(Mlj.findpath$) Mlj.arylvl = 0 Mlj.foundpath$ = "" Mlj.processed = 0 ! init traversal variables Mlj.skipped = 0 Mlj.traverse'status = 0 ! [113] Mlj.flags = flags ! [112] Mlj.selection$ = selection$ ! [112] fn'mlj'init'module'search'vars = .TRUE ! for now we allow any syntax trace.print (99, "mlistjson") fn'mlj'init'module'search'vars, Mlj.findpath$, Mlj.selection$, Mlj.flags EndFunction !--------------------------------------------------------------------- !Function: ! test for special JSON literal values that shouldn't be quoted, ! i.e. true, false, null !Params: ! value$ (str) [in] - value to test !Returns: ! .TRUE if value$ is a special literal value !Globals: !Notes: !--------------------------------------------------------------------- Private Function fn'mlj'is'json'literal(value$ as s0:inputonly) as BOOLEAN if value$ = "true" or value$ = "false" or value$ = "null" then fn'mlj'is'json'literal = .TRUE elseif value$ = "[]" or value$ = "{}" then ! [116] fn'mlj'is'json'literal = .TRUE ! [116] endif EndFunction !--------------------------------------------------------------------- !Function: ! Callback function for Fn'MLJ'TraverseToMap() !Params: ! curpath$ (str) [in] - current path ! item$ (str) [in] - current item !Returns: !Module vars: ! Mlj.flags ! Mlj.selection$ ! Mlj.level ! Mlj.findpath$ (must be set at start of search!) !Notes: ! Caller doesn't call us until it finds the starting path, so ! first call we get contains curpath$ equal to the found path. ! For the horizontal selection, we only only process items with that ! same path. For vertical selection, we only process items in paths ! of which the original found path is a subset. ! !--------------------------------------------------------------------- Private Function fn'cb'traverse'to'map(curpath$ as s0:inputonly, & item$ as s0:inputonly) as i2 !>! static map1 basepath$,s,0 ! path !>! map1 newpath$,s,0 map1 iname$,s,0 ! debug map1 ivalue$,s,0 ! debug !>! newpath$ = curpath$ ![103] + Fn'MLJ'Item'Name$(item$) !>! if basepath$ # Mlj."" then ! first found path establishes the base !>! basepath$ = newpath$ !>! trace.print (99,"mlistjson") Mlj.findpath$ !>! endif if Mlj.flags and MLJF_VERT then ! vert mode; curpath must contain basepath if Mlj.findpath$ = "" or instr(1,curpath$,Mlj.findpath$) = 1 then fn'cb'traverse'to'map = 1 ! process the item (add to map) else fn'cb'traverse'to'map = -1 ! we left branch; we're done endif elseif Mlj.flags and MLJF_HORZ then ! horz mode; curpath must equal basepath if curpath$ = Mlj.findpath$ then fn'cb'traverse'to'map = 1 ! indicate we "processed" the item elseif Mlj.findpath$ # "" and instr(1,curpath$,Mlj.findpath$) # 1 then fn'cb'traverse'to'map = -1 ! we crossed out of branch; we're done endif else ! otherwise anything goes fn'cb'traverse'to'map = 1 endif if fn'cb'traverse'to'map = 1 ! if processing item, add to $map if (Mlj.flags and MLJF_PATH) then ! include path with item name $mljmap(curpath$+Fn'MLJ'Item'Name$(item$)) = Fn'MLJ'Item'Value$(item$) !trace.print (99,"mlistjson") "$mljmap(Fn'MLJ'Item'Name$("+curpath$+Fn'MLJ'Item'Name$(item$)+") = "+$mljmap(Fn'MLJ'Item'Value$(item$) ) else ! just name !$mljmap(Fn'MLJ'Item'Name$(item$)) = Fn'MLJ'Item'Value$(item$) iname$ = Fn'MLJ'Item'Name$(item$) ivalue$ = Fn'MLJ'Item'Value$(item$) !trace.print (99,"mlistjson") "$mljmap(Fn'MLJ'Item'Name$("+item$+") = "+$mljmap(Fn'MLJ'Item'Value$(item$)) $mljmap(iname$) = ivalue$ endif endif EndFunction ![117] !--------------------------------------------------------------------- !Function: ! Test if field qualifies as a JSON number !Params: ! s$ (str) [in] - field !Returns: ! .TRUE or .FALSE !Globals: !Notes: ! This isn't very strict - needs improvement!!! !--------------------------------------------------------------------- Function fn'mlj'is'json'number(s$ as s40:inputonly) as BOOLEAN if fn'all'digits(s$) then .fn = .TRUE elseif fn'isnumfld(s$) then if instr(1,s$,"$(),%",INSTRF_ANY)=0 then .fn = .TRUE endif endif EndFunction