!fnmjson.bsi [204] - library for manipulating JSON based on Mlists and ordMaps !------------------------------------------------------------------------------ !EDIT HISTORY !Version 2.0:- (converted from/superseding mlistjson.bsi which is now deprecated) ! [204] 06-Sep-23 / jdm / Add keywords for funcidx, minor modernization ! [203] 05-Aug-19 / jdm / Add Fn'MJ'CountSubElements() ! [202] 03-Aug-19 / jdm / More functions, revisions. ! [201] 31-Jul-19 / jdm / Add Fn'MJ'SetNamedValueX() to insert or replace ! named arrays and named objects; ! Add Fn'MJ'AppendItemX() ! [200] 01-Aug-19 / jdm / Rename mlistjson functions, using Fn'MJ'xxx !Version 1.0:- ! [115] 10-Jul-19 / jdm / Add Fn'MJ'MapToObject$($map()) ! [114] 01-Oct-18 / jdm / Rename module (was fnmlistjsn.bsi); adjust module vars ! to avoid s,0 members; add MJF_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'MJ'TraverseToMap() ! [111] 06-Jul-18 / jdm / Fix bug in Fn'MJ'Load when file not found ! [110] 04-Jul-18 / jdm / Add Fn'MJ'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'MJ'SetNamedValue$() ! [106] 12-Jun-18 / jdm / Add path to Fn'MJ'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'MJ'GetNamedParam$() ! [102] 07-Nov-16 / jdm / Fix bug in the fn'mj'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'MJ'Serialize() (inverse of MLJ'Load) ! [100] 22-Oct-16 / jdm / Created !------------------------------------------------------------------------ !KEYWORDS: JSON MLIST parsing ! !REQUIREMENTS ! 6.3.1532 (for MLIST) ! 6.3.1534.0 (for EDIT$ enhancements) ! 6.5.1633.0 (for writeable iterators - lib will complain if less than this ! fnexplode.bsi [110]+ !SAMPLE/TEST PROGRAMS ! See mj*[908,63] !NOTES ! Fnmjson.bsi (this library) vs Mlistjson.bsi: this is a general reworking ! and cleanup of the original library, with the following objectives: ! ! - Relieve the caller from having to touch JSON syntax (although it ! doesn't eliminate the option to use it when convenient) ! - De-emphasize the MLIST dependencies (hence the library name change). ! The caller still needs to declare an MLIST to hold the JSON ! document, but all of the terminology and other details of MLIST ! are encapsulated in the library. Also the library contains ! functions which use other data structure such as ORDMAP, string, etc. ! - Adopt standard JSON terminology. (Previously we avoided use of "element" ! due to the ovelapping/conflicting meanings between MLIST/ORDMAP and JSON. ! See Terminology section below for more details. ! ! Terminology: We try to stick to standard JSON terms when naming and documenting ! functions. In particular the terms most used here are: ! ! json ! element ! ! value ! object ! array ! string ! number ! "true" ! "false" ! "null" ! ! elements ! element ! element "," elements ! ! element ! ws value ws (ws = zero or more whitespace characters) ! ! members ! member ! member "," members ! ! member ! string:element (aka name:value pair) ! ! object ! { ws } ! { members } ! ! array ! [ ws ] ! [ elements ] ! ! doc (not an official json term) ! object ! array ! ! scalar (not an official json term) ! number ! string ! true ! false ! null ! ! item (not an official json term) ! member ! scalar ! ! Note that of the above, "elements" is the most generic in that it could ! consist of a complete JSON document, an object, array, member, list of ! members, value, etc. There appears to be no official term that distinguishes ! between a "complete JSON document" (which is normally an object or array), and ! an element (which could be a single number like 42). In cases where we expect ! a complete document, we'll use the term "doc". ! ! We also use the term "name value pair" as an alias for "member", since it is ! more intuitive for the typical application context. Functions that retrieve ! or set the value part of a member will use the terminology "NamedValue" ! ! The term "item" is used to refer to either a member (name:value) or a scalar ! in context where either one would be allowed (like in serializing). ! ! Because we are primarily using the mlist structure for storage, internally we ! may refer to a "node", which is a single "mlist element", i.e. unit of mlist ! storage, which consists of a value, implicit previous/next links, and an ! optional explicit link to a sublist. Each "node" can contain on 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":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'MJ'GetNamedValue$() and Fn'MJ'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 member foo in the document. (This is consistent with ! the behavior prior to [106].) Otherwise, if you search for ".foo", it will only find ! the member 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 anywhere for a value 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 (a member "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 member named bar. !------------------------------------------------------------------------ !Public Functions ! Fn'MJ'Clear($json()) - clear/reset structure and module variables ! Fn'MJ'LoadDocFromFile(json$, fspec$) - load JSON doc into MLIST ! Fn'MJ'LoadElementsFromString(json$(), s$, needdoc) - Load elements string [202] ! Fn'MJ'LoadObjectFromMap(json$(), $map()) - load a JSON object from an ordmap [202] ! Fn'MJ'Serialize($json(), fspec$) - serialize to file ! Fn'MJ'Serialize$($json()) - serialize to a compact string [202] ! Fn'MJ'GetNamedValue$($json(), path$, flags) ! - return value of named pair [106][109][114] ! Fn'MJ'SetNamedValue$($json(), path$, value$) ! - find and change value of named pair [106][109] ! Fn'MJ'SetNamedValueX($json(), path$, value$, status) [116] ! - extended version to set/replace arrays, objects and scalars ! Fn'MJ'AppendElements($json(), path$, value$, status) [116][202] ! - append value$ to end of path$ ! Fn'MJ'Traverse($json(), path$, @fn'callback()) ! - traverse document, calling callback for each member ! Fn'MJ'TraverseToMap($json(), path$, $map(), flags) ! - traverse and copy to ordmap [112] ! Fn'MJ'CountSubElements($json(), path$) [203] ! - count the elements at the specified path level ! ! Fn'MJ'Member'Name$(member$) - retrieve name from na me:value pair (aka member) ! Fn'MJ'Member'Value$(item$) - return value of member ! Fn'MJ'MapToObjectString$($map()) - convert ordmap into an object ! string consisting of a series name:value pairs ! Fn'MJ'CreateObject$($jmap()) - create a JSON doc consisting of an empty object {} [117] ! Fn'MJ'CreateArray$($jmap()) - create a JSON doc consisting of an empty array [] [117] ! Fn'MJ'AppendNameValue$($jmap(),path$,name$,value$) - append a name:value pair to specified path [117] ! !Private Functions ! mj'out'item(text$) - output an item; handle indenting ! fn'mj'next'token$() - return next string token from input stream ! fn'mj'read'block() - read another block into working buffer ! fn'mj'serialize($json()) - serializer ! fn'mj'count'quotes(strbuf$, limit) ! - count quotes in string up to limit pos ! fn'mj'path'match(curpath$,item$,aryidx) ! - returns .true if paths match ! fn'mj'name'match(reqname$,item$,barray) [1] ! fn'mj'parse($json,endtoken$) [3] ! fn'mj'namedvalue$($json,curpath$,value$,barray) ! - Fn'MJ'xxxNamedValue() helper; search for Mj.findpath$; ! optional value update ! fn'mj'appendelements($json,curpath$,elements$) ! - Fn'MJ'Appendxxx() helper; search for Mj.findpath$, append elements$ ! fn'mj'countsubelements($json,curpath$,elements$) ! - Fn'MJ'CountSubElements() helper; search for Mj.findpath$, count children ! fn'mj'val'save'findpath(findpath$) - validate/reformat/save incoming findpath ! fn'mj'is'json'literal(value$) ! - return TRUE if value is a special JSON literal (true,false,null) ! fn'mj'item'is'sublist(item$) - determine if item is a sublist ! fn'mj'fix'array'idx$(path$,item$,aryidx) - fix (assign) aryidx ! fn'mj'can'skip'descent(parentpath$) ! - determine if we can skip descent during scan ! fn'mj'is'json'number(value$) - check if qualifies as a JSON number ! fn'mj'auto'quote'item$(item$) !------------------------------------------------------------------------ ++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'MJ'TraverseToMap flags define MJF_HORZ = &h001 ! traverse horizontally (one level within branch) define MJF_VERT = &h002 ! traverse vertically (all levels of branch) define MJF_PATH = &h004 ! include path in $map key (highly recommended with _VERT!) ![114] Fn'MJ'GetNamedValue flags define MJF_UNQUOTE = &h001 ! [114] remove quotes from returned value ![116] error codes define MJERR_BAD_JSON = -1 ! [116] string does not appear to be JSON define MJERR_ASH_VER = -2 ! [116] insufficient A-Shell version define MJERR_BAD_OBJECT = -3 ! [116] invalid object syntax define MJERR_BAD_ARRAY = -4 ! [116] invalid array syntax define MJERR_BAD_PATH = -5 ! [116] bad path specified define MJERR_PATH_NOT_FOUND= -6 ! [116] path not found defstruct ST_MJ_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 map3 lastchar$,s,1 ! [202] last char output 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 ! MJF_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 Mj, ST_MJ_MODULE_VARS ! [113] map1 MJ'Dynamic'Strings ! [114] move these out of structure map2 MJ'Workbuf$,s,0 ! buffer containing unparsed text dimx Aryidx(0),b,4,auto_extend ! array index within levels dimx $mjmap, 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 ![202] !--------------------------------------------------------------------- !Function: ! Clear the $json() structure (if passed) and reset the module variables. !Params: ! $json() (MLIST) [byref] - (optional) if passed, will be cleared !Returns: ! 0 = success (not possible to fail) !Module vars: ! all are reset !Notes: ! Called automatically when loading into an empty $json !--------------------------------------------------------------------- Function Fn'MJ'Clear($json() as mlist(varstr)) as i4 if .argcnt then if .extent($json()) > 0 then .clear $json() endif endif Mj = fill(chr(0),sizeof(Mj)) MJ'Workbuf$ = "" .clear Aryidx() .clear $mjmap() EndFunction ![202] !--------------------------------------------------------------------- !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'MJ'CreateObject($json() as mlist(varstr)) as i4 call Fn'MJ'Clear($json()) $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'MJ'CreateArray($json() as mlist(varstr)) as i4 call Fn'MJ'Clear($json()) $json(.pushback) = "[]" EndFunction !--------------------------------------------------------------------- !Function: ! Load JSON document from file into MLIST !Params: ! fspec$ (str) [in] - JSON file ! $json() (MLIST) [byref] - mlist to return document in !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: ! Mj.chin - open input channel ! all module vars cleared if $json() is empty !Notes: !--------------------------------------------------------------------- Function Fn'MJ'LoadDocFromFile($json() as mlist(varstr), & fspec$ as T_NATIVEPATH:inputonly) as i4 map1 locals map2 token$,s,2 map2 status,i,4 if .extent($json()) < 1 then ! [202] if loading into an empty call Fn'MJ'Clear() ! [202] DOM, clear the module vars endif xcall SIZE, fspec$, .fn if .fn > 0 then ! [111] Mj.chin = Fn'NextCh(50000) open #Mj.chin, fspec$, input token$ = fn'mj'next'token$() ! get first token if token$ # "[" and token$ # "{" then .fn = -1 else $json(.pushback) = token$ token$ = ifelse$(token$="[","]","}") ! expected ending token Mj.level = 0 status = fn'mj'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 close #Mj.chin Mj.chin = 0 endif EndFunction !--------------------------------------------------------------------- !Function: ! Load JSON elements (ranging from a single scalar value to a complete ! doc) from a string. !Params: ! $json() (MLIST) [byref] - mlist to return document in ! s$ (str) [in] - JSON string ! needdoc (BOOLEAN) [in] - .TRUE to insist on loading an entire doc !Returns: ! # bytes in string (0 for non-existent, <0 for error) ! -1 (MJERR_BAD_JSON) = does not appear to be JSON (doesn't start with "[" or "{") ! -2 (MJERR_ASH_VER) = Version of A-Shell not sufficient ! !Module vars: ! all module vars cleared if $json() is empty !Notes: ! Example legal source strings: ! { } ! { "name":"value", [ 1, 2, 3 ], "amount":999 } ! "name":"value" !--------------------------------------------------------------------- Function Fn'MJ'LoadElementsFromString($json() as mlist(varstr), & s$ as s0:inputonly, & needdoc as BOOLEAN:inputonly) as i4 map1 locals map2 token$,s,0 map2 endtoken$,s,2 map2 status,i,4 if .extent($json()) < 1 then ! [202] if loading into an empty call Fn'MJ'Clear() ! [202] DOM, clear the module vars endif trace.print (99, "fnmjson") "Fn'MJ'LoadFromString", needdoc, s$ .fn = len(s$) if .fn > 0 then token$ = fn'mj'next'token$(s$) ! get first token trace.print (99, "fnmjson") token$, .fn if (token$ = "[" or token$ ="{") & ! [202] or ((not needdoc) and (token$[-1,-1] = "[" or token$[-1,-1] = "{")) then $json(.pushback) = token$ token$ = token$[-1,-1] if token$ = "[" then endtoken$ = "]" elseif token$ = "{" then endtoken$ = "}" else endtoken$ = "" ! this would be for allowitem case endif Mj.level = 0 status = fn'mj'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 not needdoc then ! [202] this should be a name:value or scalar $json(.pushback) = token$ ! [202] (i.e. a single token) else .fn = MJERR_BAD_JSON ! (-1) endif close #Mj.chin Mj.chin = 0 endif EndFunction !--------------------------------------------------------------------- !Function: ! Load a JSON object from an ordmap !Params: ! $json() (MLIST) [byref-out] - mlist to hold JSON DOM ! $map() (ORDMAP) [byref-in] - ordmap(varstr;varstr) to load from !Returns: ! !Module vars: ! all module vars cleared if $json() is empty !Notes: ! The map is treated as an object of form: ! { "key1":"value1", "key2":"value2", ... } !--------------------------------------------------------------------- Function Fn'MJ'LoadObjectFromMap($json() as mlist(varstr), & $map() as ordmap(varstr;varstr)) as i4 if .extent($json()) < 1 then ! [202] if loading into an empty call Fn'MJ'Clear() ! [202] DOM, clear the module vars endif .fn = Fn'MJ'LoadElementsFromString($json(), Fn'MJ'MapToObjectString$($map()), needdoc=.TRUE) EndFunction ![203] !--------------------------------------------------------------------- !Function: ! Count the child elements of the specified path. Useful for ! counting the number of elements of an array, or members of ! an object. !Params: ! $json() (MLIST) [byref-in] - mlist holding JSON DOM ! path$ (str) [in/out] - path/level to count (updated on return) !Returns: ! # of elements at the specified level (only 1 level deep) ! (or <0 for MJ_xxx errors) ! 0 on success, else an MJERR_xxx code !Module Vars ! Mj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mj.foundpath$ to be set to path we find the item at. (Should be the same as Mj.findpath$ ! unless Mj.findpath$ is partial) ! Mj.status'code !Notes: !--------------------------------------------------------------------- Function Fn'MJ'CountSubElements($json() as mlist(varstr), & path$ as s0) as i4 call fn'mj'init'module'search'vars(path$) .fn = fn'mj'countsubelements($json(),"") path$ = Mj.foundpath$ ! also return the Mj.foundpath$ xputarg @path$ EndFunction !--------------------------------------------------------------------- !Function: ! Write JSON data from the MLIST format created by Fn'MJ'Load back ! to JSON file format (i.e. serialize it to a file) or a string !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: ! Mj.chout (output channel) ! Mj.level ! Mj.indent ! Mj.outbytes (updated by lower level output routine) !Notes: !--------------------------------------------------------------------- Function Fn'MJ'Serialize($json() as mlist(varstr), & fspec$ as s0, indent as b2) 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'MJ'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 Mj.chout = Fn'NextCh(50000) open #Mj.chout, fspec$, output Mj.indent = indent ! save indent at module level Mj.level = 0 ! init level Mj.outbytes = 0 ! init output byte count Mj.lastchar$ = "" ! [202] Fn'MJ'Serialize = fn'mj'serialize($json()) close #Mj.chout if tempspec$ # "" then ! load file back into return var fspec$ = Fn'FileToStr$(tempspec$) xputarg 2, fspec$ Fn'MJ'Serialize = len(fspec$) ! return # bytes output kill tempspec$ else Fn'MJ'Serialize = Mj.outbytes ! return # bytes output endif Mj.chout = 0 EndFunction ![202] !--------------------------------------------------------------------- !Function: ! Write JSON data from the MLIST structure to a compact string. ! (Simplified wrapper for Fn'MJ'Serialize() !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data !Returns: ! resulting string or "!Error #" ! !Module vars: ! Mj.chout (output channel) ! Mj.level ! Mj.indent ! Mj.outbytes (updated by lower level output routine) !Notes: !--------------------------------------------------------------------- Function Fn'MJ'Serialize$($json() as mlist(varstr)) as s0 map1 locals map2 s$,s,0 map2 status,i,4 status = Fn'MJ'Serialize($json(), s$, 0) if status > 0 then .fn = s$ else .fn = "!Error " + str(status) endif EndFunction !--------------------------------------------------------------------- !Function: ! Return value of a name:value pair !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! path$ (str) [in] - value name to search for, optionally prepended by path ! returns fully qualified current path where found [106] ! flags (num) [in] - optional flags ! MJF_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 Mj.findpath$, Mj.findpath'len ! Retrieves Mj.foundpath$ !Notes: ! See notes at top of this file for mlist encoding and path details !--------------------------------------------------------------------- Function Fn'MJ'GetNamedValue$($json() as mlist(varstr), & path$ as s0, & flags as b4:inputonly) as s0 call fn'mj'init'module'search'vars(path$) ! validate, init, set search params in mod vars Fn'MJ'GetNamedValue$ = fn'mj'namedvalue$($json(),"",JSON_GETONLY_VALUE$) if flags and MJF_UNQUOTE then Fn'MJ'GetNamedValue$ = Fn'Unquote$(Fn'MJ'GetNamedValue$) endif if Fn'MJ'GetNamedValue$ # "" then ! if value returned (found) path$ = Mj.foundpath$ ! also return the Mj.foundpath$ else path$ = "" endif xputarg @path$ EndFunction ![106] !--------------------------------------------------------------------- !Function: ! Set the value of member (aka name-value pair) !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! path$ (str) [in/out] - path of member (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 ! Mj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mj.foundpath$ to be set to path we find the item at. (Should be the same as Mj.findpath$ ! unless Mj.findpath$ is partial) !Notes: ! Equivalent to Fn'MJ'GetNamedValue$ if value$ = JSON_GETONLY_VALUE$ ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Function Fn'MJ'SetNamedValue$($json() as mlist(varstr), & path$ as s0, & value$ as s0:inputonly) as s0 call fn'mj'init'module'search'vars(path$) Fn'MJ'SetNamedValue$ = fn'mj'namedvalue$($json(),"",value$) if Fn'MJ'SetNamedValue$ # "" then ! if value returned (found) path$ = Mj.foundpath$ ! also return the found path else path$ = "" endif xputarg @path$ EndFunction ![116] !--------------------------------------------------------------------- !Function: ! Set the value of item. Nearly same as Fn'MJ'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 ! path$ (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 MJERR_xxx code !Module Vars ! Mj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mj.foundpath$ to be set to path we find the item at. (Should be the same as Mj.findpath$ ! unless Mj.findpath$ is partial) ! Mj.status'code !Notes: ! See Fn'MJ'SetNamedValue$() ! See notes at top of this file for mlist encoding details. ! !--------------------------------------------------------------------- Function Fn'MJ'SetNamedValueX($json() as mlist(varstr), & path$ as s0, & value$ as s0:inputonly, & origvalue$ as s0:outputonly) as i2 call fn'mj'init'module'search'vars(path$) origvalue$ = fn'mj'namedvalue$($json(),"",value$) if origvalue$ # "" then ! if value returned (found) path$ = Mj.foundpath$ ! also return the found path else path$ = "" endif xputarg @path$ xputarg @origvalue$ .fn = Mj.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 MJERR_xxx code !Module Vars ! Mj.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. ! This is essentially the same as Fn'MJ'AppendElements(), except ! that it is more explicitly designed for name:value pairs, and ! will take care of quoting the name and value. !--------------------------------------------------------------------- Function Fn'MJ'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'mj'is'json'literal(value$) then ! if not fn'mj'is'json'number(value$) then value$ = fn'mj'auto'quote'item$(value$) ! Fn'Quote$(value$,FNQF_TRIM) !endif !endif call fn'mj'init'module'search'vars(path$) .fn = fn'mj'appendelements($json(),"",name$+":"+value$) EndFunction ![116] !--------------------------------------------------------------------- !Function: ! Append elements to end of specified path$. Generalized version ! of Fn'MJ'AppendNameValue() !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! path$ (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 MJERR_xxx code !Module Vars ! Mj.findpath$ contains the (partial) path we are looking for. (Seems pointlessly inefficient to ! pass this to every iteration of this routine) ! Mj.foundpath$ to be set to path we find the item at. (Should be the same as Mj.findpath$ ! unless Mj.findpath$ is partial) ! Mj.status'code !Notes: ! See Fn'MJ'SetNamedValue$() ! See notes at top of this file for mlist encoding details. ! !--------------------------------------------------------------------- Function Fn'MJ'AppendElements($json() as mlist(varstr), & path$ as s0, & value$ as s0:inputonly) as i2 call fn'mj'init'module'search'vars(path$) .fn = fn'mj'appendelements($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 ! path$ (str) [in/out] - starting path ! @fn'callback() - callback function !Returns: ! # of items scanned (from path$ 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'MJ'Traverse($json() as mlist(varstr), & path$ as s0, & @fn'callback() as lblref) as i4 call fn'mj'init'module'search'vars(path$) ! call fn'mj'traversex($json(), "", @fn'callback(), .FALSE) Fn'MJ'Traverse = Mj.processed EndFunction ![112] !--------------------------------------------------------------------- !Function: ! Variation of Fn'MJ'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 ! path$ (str) [in/out] - starting path ! $map() (ORDMAP) [byref] - {path}name -> value ! flags (num) [in] - See MJF_xxx flags ! selection$ (str) [in] - item selection criteria to pass to ! callback (nothing yet defined for this) !Returns: ! # of items scanned (from path$ 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'MJ'TraverseToMap($json() as mlist(varstr), & path$ as s0, & $map() as ordmap(varstr;varstr), & flags as b4:inputonly, & selection$ as s0:inputonly) as i4 call fn'mj'init'module'search'vars(path$, flags=flags, selection$=selection$) .clear $map() call fn'mj'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'mj'traversex() routine (complicating it for the regular ! Fn'MJ'Traverse() function, and also requiring it to be passed to itself for every ! recursive call) foreach $$i in $mjmap() $map(.key($$i)) = $$i next $$i .clear $mjmap() Fn'MJ'TraverseToMap = Mj.processed EndFunction !--------------------------------------------------------------------- !Function: ! extract name from a member (i.e. from a name:value pair) !Params: ! member$ (str) [in] - member !Returns: ! "name" ! or "" (for unnamed member) !Globals: !Notes: ! name will be quoted, if there is one. !--------------------------------------------------------------------- Function Fn'MJ'Member'Name$(member$ as s0:inputonly) as s JSON_MAX_NAME map1 x,i,4 x = instr(1,member$,":",INSTRF_ANYQT) if x then Fn'MJ'Member'Name$ = member$[1,x-1] if member$[1,1] # """" then Fn'MJ'Member'Name$ = """" + Fn'MJ'Member'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: ! Names are always quoted; values are auto-quoted as needed ! Order of the members in the resulting object will be based on ! the alphabetical order of the keys in the map. !--------------------------------------------------------------------- Function Fn'MJ'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 += Fn'Quote$(.key($$i)) + ":" + fn'mj'auto'quote'item$($$i) next $$i .fn += " }" EndFunction !--------------------------------------------------------------------- !Function: ! extract value from a member (i.e. from a name:value pair) !Params: ! member$ (str) [in] - name:value pair !Returns: ! value portion of member (for sublist, either {} or []) !Globals: !Notes: ! string values are quoted, booleans and numbers, not !--------------------------------------------------------------------- Private Function Fn'MJ'Member'Value$(member$ as s0:inputonly) as s0 map1 x,i,4 x = instr(1,member$,":",INSTRF_ANYQT) Fn'MJ'Member'Value$ = member$[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 ! Mj.findpath$ contains the {path}name we are looking for ! Mj.findpath'len is length of Mj.findpath$ ! Mj.foundpath$ to be set to the actual path where found ! Mj.arylvl is current array nesting level ! Mj.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'mj'namedvalue$($json() as mlist(varstr), & curpath$ as s0:inputonly, & value$ as s0:inputonly,& barray as BOOLEAN:inputonly) as s0 map1 locals map2 member$,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,"fnmjson") "fn'mj'namedvalue$",curpath$,value$, Mj.findpath$ ! traverse the json list to locate the curpath$ ... foreach $$i in $json() member$ = $$i ! slightly more efficient than many refs to iterator if instr(1,member$,"[{",INSTRF_ANYQT) then bsublist = .TRUE else bsublist = .FALSE endif if barray then ! if processing an array, increment member # for each time thru loop Aryidx(Mj.arylvl) += 1 idx = Aryidx(Mj.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 member ! 1) check for match if fn'mj'path'match(curpath$,member$,idx) then ! we have a MATCH!!! fn'mj'namedvalue$ = Fn'MJ'Member'Value$(member$) Mj.foundpath$ = fn'mj'fix'array'idx$(curpath$, member$, idx) ! replace value if not special JSON_GETONLY_VALUE$ and old value scalar or new value .NULL if value$ # JSON_GETONLY_VALUE$ then Mj.status'code = 0 ! so far so good if .isnull(value$) then ! any member can be deleted $json(.ref($$i)).sublist = .NULL ! [116] delete sublist if it exists $json(.ref($$i)) = .NULL ! [116] delete member else ! [116] member value replacement if bsublist then ! [116] if member 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 = MJERR_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'mj'next'token$(value$) ! now get first token token$ = ifelse$(save'value$="[","]","}") ! determine end token save'value$ += token$ trace.print (99,"fnmjson") token$,value$ status = fn'mj'parse($$i.sublist, token$, value$) ! and now parse up to it trace.print (99,"fnmjson") $$i.sublist if status >= 0 then ! success Mj.status'code = 0 else save'value$ += " !!Error: missing terminator; status="+status Mj.status'code = status endif value$ = save'value$ endif ! [116] (fall thru to set member value) ![116] elseif not fn'mj'member'is'sublist(fn'mj'namedvalue$) then name$ = Fn'MJ'Member'Name$(member$) if name$ # "" then name$ += ":" endif ! [202] determine quoting based on prior value and whether new value is literal !if Fn'IsQuoted(fn'mj'namedvalue$) & !and not fn'mj'is'json'literal(value$) then ! if old value was quoted and new value not a special literal ! member$ = name$ + Fn'Quote$(value$) ! then quote the new one !else ! member$ = name$ + value$ !endif member$ = name$ + fn'mj'auto'quote'item$(value$) ! [202] !trace.print (99,"fnmjson") "replacing "+$$i+" with "+member$ ![116] $json(.ref($$i)) = member$ ! (old fashioned/deprecated version) $$i = member$ ! [116] endif endif exit else trace.print (99,"fnmjson") bsublist,curpath$,member$,"no match against",Mj.findpath$ 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(Mj.arylvl)) + parentpath$[x+2,-1] endif endif ! before descending, add the current member to the path to be seen by children ! note multiple cases: ! [] -> [JSON_ARYIDX_MARKER$] ! {} -> . ! name:[] -> name[JSON_ARYIDX_MARKER$] ! name:{} -> name. x = instr(1,member$,":",INSTRF_ANYQT) ! is member named$ if x then ! yes - add name to path parentpath$ += member$[1,x-1] endif ! see if we can skip the descent of this branch if fn'mj'can'skip'descent(parentpath$) then repeat endif if member$[-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$] Mj.arylvl += 1 Aryidx(Mj.arylvl) = 0 ! we're on the first member for this level bsubarray = .TRUE endif fn'mj'namedvalue$ = fn'mj'namedvalue$($$i.sublist,parentpath$,value$,bsubarray) ! recurse for sublist [106] !trace.print (99,"fnmjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mj.arylvl = (Mj.arylvl - 1) max 0 if Mj.arylvl = 0 then bsubarray = .FALSE endif endif if fn'mj'namedvalue$ # "" then ! found at lower level, so we can exit this one !trace.print (99,"fnmjson") "*INHERITED MATCH*" exit endif endif ! 3) else just proceed to next next $$i trace.print (99,"fnmjson") fn'mj'namedvalue$,Mj.findpath$,Mj.foundpath$ EndFunction ![116] append elements 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 ! elements$ (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: ! MJERR_PATH_NOT_FOUND, 0 (found), other errors !Module Vars ! Mj.findpath$ contains the {path}name we are looking for ! Mj.findpath'len is length of Mj.findpath$ ! Mj.foundpath$ to be set to the actual path where found ! Mj.arylvl is current array nesting level ! Mj.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'mj'appendelements($json() as mlist(varstr), & curpath$ as s0:inputonly, & elements$ 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,"fnmjson") "fn'mj'appendelements",curpath$,elements$ .fn = MJERR_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,"fnmjson") 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(Mj.arylvl) += 1 idx = Aryidx(Mj.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'mj'path'match(curpath$,item$,idx) then ! we have a MATCH!!! orig'value$ = Fn'MJ'Member'Value$(item$) Mj.foundpath$ = fn'mj'fix'array'idx$(curpath$, item$, idx) ! value must be {} or [] if orig'value$ # "[]" and orig'value$ # "{}" then .fn = MJERR_BAD_PATH Mj.status'code = .fn exitfunction endif trace.print (99,"fnmjson") "calling Fn'MJ'LoadElementsFromString", $$i, $$i.sublist, elements$ .fn = Fn'MJ'LoadElementsFromString($$i.sublist, elements$) trace.print (99,"fnmjson") .fn,elements$,$$i.sublist if .fn >= 0 then .fn = 0 ! path found endif Mj.status'code = .fn ! save status globally (probably redundant here) exit endif ! The rest of this logic is just the recursive search, and is the same as for ! the fn'mj'countsubelements and fn'mj'getnamedvalue, except for the name of the ! recursive function (ideally we should figure out a way to combine these, i.e. DRY) ! 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, "fnmjson") bsublist, parentpath$,Mj.arylvl 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(Mj.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'mj'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$] Mj.arylvl += 1 Aryidx(Mj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif .fn = fn'mj'appendelements($$i.sublist,parentpath$,elements$,bsubarray) ! recurse for sublist !trace.print (99,"fnmjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mj.arylvl = (Mj.arylvl - 1) max 0 if Mj.arylvl = 0 then bsubarray = .FALSE endif endif if .fn # MJERR_PATH_NOT_FOUND then ! found at lower level, so we can exit this one !trace.print (99,"fnmjson") "*INHERITED MATCH*" exit endif endif ! 3) else just proceed to next next $$i EndFunction ![203] !--------------------------------------------------------------------- !Function: ! count subelements of a path !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! curpath$ (str) [in] - current path (updated as we recurse down) ! barray (BOOLEAN) [in] - internal use for recursion only - set to indicate ! we are processing an array !Returns: ! >=0 (# subelements), <0 errors such as MJERR_PATH_NOT_FOUND !Module Vars ! Mj.findpath$ contains the {path}name we are looking for ! Mj.findpath'len is length of Mj.findpath$ ! Mj.foundpath$ to be set to the actual path where found ! Mj.arylvl is current array nesting level ! Mj.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'mj'countsubelements($json() as mlist(varstr), & curpath$ as s0:inputonly, & barray as BOOLEAN:inputonly) as i4 map1 locals map2 element$,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,"fnmjson") "fn'mj'countsubelements",curpath$ .fn = MJERR_PATH_NOT_FOUND ! traverse the json list to locate the curpath$ ... foreach $$i in $json() element$ = $$i ! slightly more efficient than many refs to iterator trace.print (99,"fnmjson") element$ if instr(1,element$,"[{",INSTRF_ANYQT) then bsublist = .TRUE else bsublist = .FALSE endif if barray then ! if processing an array, increment item # for each time thru loop Aryidx(Mj.arylvl) += 1 idx = Aryidx(Mj.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'mj'path'match(curpath$,element$,idx) then ! we have a MATCH!!! orig'value$ = Fn'MJ'Member'Value$(element$) Mj.foundpath$ = fn'mj'fix'array'idx$(curpath$, element$, idx) !>! (count subelements makes sense for elements with {} or [] value, but it's !>! ok to let the fn'mj'extent() function take care of returning -1) !>! ! value must be {} or [] !>! if orig'value$ # "[]" and orig'value$ # "{}" then !>! .fn = MJERR_BAD_PATH !>! Mj.status'code = .fn !>! exitfunction !>! endif .fn = fn'mj'extent($$i.sublist) trace.print (99,"fnmjson") fn'mj'countsubelements,$$i,$$i.sublist exitfunction endif ! The rest of this logic is just the recursive search, and is the same as for ! the fn'mj'appendelements and fn'mj'getnamedvalue, except for the name and ! argument list of the recursive function ! (ideally we should figure out a way to combine these, i.e. DRY) ! 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, "fnmjson") bsublist, parentpath$, Mj.arylvl 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(Mj.arylvl)) + parentpath$[x+2,-1] endif endif ! before descending, add the current element to the path to be seen by children ! note multiple cases: ! [] -> [JSON_ARYIDX_MARKER$] ! {} -> . ! name:[] -> name[JSON_ARYIDX_MARKER$] ! name:{} -> name. x = instr(1,element$,":",INSTRF_ANYQT) ! is element a named-pair member? if x then ! yes - add name to path parentpath$ += element$[1,x-1] endif ! see if we can skip the descent of this branch if fn'mj'can'skip'descent(parentpath$) then repeat endif if element$[-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$] Mj.arylvl += 1 Aryidx(Mj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif .fn = fn'mj'countsubelements($$i.sublist,parentpath$,bsubarray) ! recurse for sublist if bsubarray then Mj.arylvl = (Mj.arylvl - 1) max 0 if Mj.arylvl = 0 then bsubarray = .FALSE endif endif if .fn # MJERR_PATH_NOT_FOUND then ! found at lower level, so we can exit this one !trace.print (99,"fnmjson") "*INHERITED MATCH*" exit endif endif ! 3) else just proceed to next next $$i EndFunction ![106] !--------------------------------------------------------------------- !Function: ! Variation of fn'mj'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'MJ'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 ! Mj.findpath$ contains the {path}name we are looking for ! Mj.findpath'len is length of Mj.findpath$ ! Mj.foundpath$ to be set to the actual path where found ! Mj.arylvl is current array nesting level !Notes: ! Called Recursively!!! ! See notes at top of this file for mlist encoding details. !--------------------------------------------------------------------- Private Function fn'mj'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(Mj.arylvl) += 1 idx = Aryidx(Mj.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 Mj.traverse'status = 0 then ! not yet found ! check for match if fn'mj'path'match(curpath$,item$,idx) then ! we have a MATCH!!! Mj.traverse'status = 1 Mj.foundpath$ = fn'mj'fix'array'idx$(curpath$, item$, idx) ! set global path (just for kicks) endif endif ! 2) if found, call the callback function if Mj.traverse'status > 0 then Mj.traverse'status = fn'callback(fn'mj'fix'array'idx$(curpath$, "", idx), item$) ! [113] if Mj.traverse'status > 0 then ! keep track of the processed/skipped totals Mj.processed += 1 elseif Mj.traverse'status = 0 then Mj.skipped += 1 endif endif ! 3) if quit flag returned, quit if Mj.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(Mj.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 Mj.traverse'status < 1 then ! (only if we haven't found the starting path) if fn'mj'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$] Mj.arylvl += 1 Aryidx(Mj.arylvl) = 0 ! we're on the first item for this level bsubarray = .TRUE endif call fn'mj'traversex($$i.sublist,parentpath$,@fn'callback(),bsubarray) ! recurse for sublist !trace.print (99,"fnmjson") "return from recurse: ",barray,bsubarray,curpath$ if bsubarray then Mj.arylvl = (Mj.arylvl - 1) max 0 if Mj.arylvl = 0 then bsubarray = .FALSE endif endif if Mj.traverse'status < 0 then ! quit flag returned from lower level exit endif endif ! 5) else just proceed to next next $$i fn'mj'traversex = Mj.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: ! Mj.chin (open input file channel) - closed on eof [115] only if no param passed ! MJ'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'mj'next'token$(s$ as s0:inputonly) as s0 map1 locals map2 i,i,4 if .argcnt then ! [115] if string passed, use it like MJ'Workbuf$ = s$ ! [115] previously-read but not parsed endif ! [115] file data trace.print (99, "fnmjson") "fn'mj'next'token$", .argcnt, MJ'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. MJ'Workbuf$ = edit$(MJ'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,MJ'Workbuf$,JSON_DELIMITERS$,INSTRF_ANYQT) trace.print (99, "fnmjson") i ! if we didn't get one, then we need to read in more if i = 1 then ! first char is a delimiter if MJ'Workbuf$[i;1] = "," then ! skip over leading commas MJ'Workbuf$ = MJ'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'mj'count'quotes(MJ'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 MJ'Workbuf$ = s$ ! [116] if no delimiters, take entire string as the token exit elseif fn'mj'read'block() <= 0 then exit ! abort if we run out of data endif endif loop until i > 0 trace.print (99, "fnmjson") .argcnt, i, MJ'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'mj'next'token$ = MJ'Workbuf$ MJ'Workbuf$ = "" elseif i = 1 then fn'mj'next'token$ = MJ'Workbuf$[1,1] MJ'Workbuf$ = MJ'Workbuf$[2,-1] elseif instr(1,"{[",MJ'Workbuf$[i;1]) then ! leave opening delimeters on end of token fn'mj'next'token$ = MJ'Workbuf$[1,i] MJ'Workbuf$ = MJ'Workbuf$[i+1,-1] else ! return buffer up to just before delimiter fn'mj'next'token$ = MJ'Workbuf$[1,i-1] MJ'Workbuf$ = MJ'Workbuf$[i,-1] endif trace.print (99, "fnmjson") fn'mj'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: ! Mj.chin (input channel) ! MJ'Workbuf$ (working buffer) !Notes: ! See notes at top for buffering strategy !--------------------------------------------------------------------- Private Function fn'mj'read'block() as i4 define JSON_BUF_SIZ = 512 ! # chars to read at a time map1 locals map2 blockbuf$,s,JSON_BUF_SIZ if Mj.chin then if eof(Mj.chin) # 1 then ! if not eof blockbuf$ = fill(chr(0),sizeof(blockbuf$)) xcall GET, blockbuf$, Mj.chin, JSON_BUF_SIZ, fn'mj'read'block MJ'Workbuf$ += blockbuf$ endif else fn'mj'read'block = -1 endif trace.print (99,"fnmjson") "read "+fn'mj'read'block+" into buf; buflen = "+len(MJ'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: ! Mj.chin, MJ'Workbuf$ !Notes: !--------------------------------------------------------------------- Private Function fn'mj'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, "fnmjson") "fn'mj'parse", endtoken$, s$ Mj.level += 1 do if .argcnt > 2 then ! [115] if the s$ parameter passed token$ = fn'mj'next'token$() ! [115][116] then pass it to the next'token routine else ! [115] else we use file version token$ = fn'mj'next'token$() endif trace.print (99, "fnmjson") token$ switch token$ case "[" ! parse a new array case "{" ! parse an object $json(.pushback) = token$ subendtoken$ = ifelse$(token$="[","]","}") status = fn'mj'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'mj'parse($json(.back).sublist,subendtoken$) if status >= 0 then $json(.back) += subendtoken$ else $json(.back) += " !!Error: missing terminator: "+subendtoken$ endif exit default ! add an item (name:value or scalar) to our list ! auto-quote it... $json(.pushback) = fn'mj'auto'quote'item$(token$) ! [202] exit endswitch exit endswitch loop until bdone if status < 0 then fn'mj'parse = -1 endif Mj.level -= 1 EndFunction !--------------------------------------------------------------------- !Function: ! Recursive worker for Fn'MJ'Serialize !Params: ! $json() (MLIST) [byref] - mlist representation of JSON data ! outbuf$ (s0) [out] - if Mj.chout=0, output goes here, else to #Mj.chout !Returns: ! # bytes output ! -2 = parse error !Module Vars ! Mj.chout (output channel, already open) ! Mj.level ! Mj.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'mj'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 Mj.level += 1 trace.print (99,"fnmjson") ABC_CURRENT_ROUTINE$, Mj.level, .extent($json()) foreach $$i in $json() item$ = $$i ! slightly more efficient than many refs to iterator x = instr(1,item$,"[{",INSTRF_ANYQT) trace.print (99,"fnmjson") x, item$ if x then char$ = item$[x;1] if x = 1 then call mj'out'item(char$) else ! must be "name":[] or "name":{} call mj'out'item(item$[1,x-1]) ! output "name:": call mj'out'item(char$) ! output [ or { (possible new line) endif call fn'mj'serialize($$i.sublist) ! recurse for sublist call mj'out'item(item$[x+1;1]) ! output closing ] or } else call mj'out'item(item$) ! scalar or "name":value endif next $$i Mj.level -= 1 trace.print (99,"fnmjson") "exit level", Mj.level EndFunction !--------------------------------------------------------------------- !Procedure: ! output a new JSON item to output file; handle breaks and indenting !Params: ! item$ (str) [in] - item to output !Module vars: ! Mj.chout (output channel) ! Mj.outbytes (# bytes output, counting only one per line terminator) ! Mj.level (nesting level) ! Mj.indent (spaces per level to indent; if 0 no line breaks or indenting) ! Mj.lastchar$ (last char output during serialization) [202] !Notes: ! Determines whether a comma is needed based on last character of ! previous item and first character of this item. !--------------------------------------------------------------------- Private Procedure mj'out'item(item$ as s0) ![202] static map1 s_lastchar$,s,1 ! (move this to private so we can init it) map1 locals map2 spacecount,b,2 map2 firstchar$,s,1 ! append a comma between items as needed... firstchar$ = item$[1,1] ! debug... map1 z1,i,2 map1 z2,i,2 z1 = instr(1,"}]",firstchar$) z2 = instr(1,"[{:",Mj.lastchar$) trace.print (99,"fnmjson") ABC_CURRENT_ROUTINE$, firstchar$, item$, Mj.lastchar$, z1, z2 ! ... if instr(1,"}]",firstchar$) = 0 and Mj.lastchar$ # "" & and instr(1,"[{:",Mj.lastchar$) = 0 then trace.print (99,"fnmjson") "mj'out'item", item$, firstchar$, Mj.lastchar$ ? #Mj.chout, ","; Mj.outbytes += 1 endif ! start a new line for each item unless first item or no indent if Mj.lastchar$ # "" and Mj.indent > 0 then ? #Mj.chout Mj.outbytes += 1 endif if Mj.indent > 0 and Mj.level > 0 then spacecount = Mj.indent*(Mj.level-1) ? #Mj.chout, space(spacecount); Mj.outbytes += spacecount endif ? #Mj.chout, item$; Mj.outbytes += len(item$) Mj.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'mj'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'mj'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: ! Mj.findpath$ - the path we are looking for ! Findpath'Stripped$ - version with quoted names unquoted !Notes: ! Empty Mj.findpath$ matches everything ! Requested path is Mj.findpath$ ! If Mj.findpath$ starts with "*" then just do a right-anchored match; ! else complete match. ! Assumption is that Mj.findpath$ has been fully quoted (likewise for curpath$ and item$) ! [117] treat . as a match for the top node !--------------------------------------------------------------------- Private Function fn'mj'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, "fnmjson") "fn'mj'path'match", curpath$, item$, Mj.findpath$ if Mj.findpath$ = "" then fn'mj'path'match = .TRUE else if Mj.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'mj'path'match = .TRUE ! [117] this is a special case match else item$ = "." endif endif curpath$ = fn'mj'fix'array'idx$(curpath$, item$, aryidx) trace.print (99, "fnmjson") curpath$, Mj.findpath$, Mj.findpath'len ! can't easily use regex for the path because it has brackets, dots, etc. ! so we accept a right-anchored match. xcall XSTRIP, curpath$, """", 1 ! [117] remote all quotes from the curpath$ for comparison x = len(curpath$) - Mj.findpath'len + 1 if curpath$[x,-1] = Mj.findpath$ then fn'mj'path'match = .TRUE Mj.foundpath$ = Mj.findpath$ ! [117] endif endif trace.print (99, "fnmjson") fn'mj'path'match, Mj.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'mj'fix'array'idx$(path$ as s0:inputonly, & item$ as s0:inputonly, & aryidx as b4:inputonly) as s0 map1 x,i,4 trace.print (99, "fnmjson") "fn'mj'fix'array'idx$", path$, item$, aryidx x = instr(1,path$,JSON_ARYIDX_MARKER$) if x then fn'mj'fix'array'idx$ = path$[1,x-1] + str(aryidx) + path$[x+2,-1] else fn'mj'fix'array'idx$ = path$ endif fn'mj'fix'array'idx$ += Fn'MJ'Member'Name$(item$) !>! if item$ = "{}" then ! [113] !>! fn'mj'fix'array'idx$ += "." !>! endif trace.print (99, "fnmjson") fn'mj'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'mj'item'is'sublist(item$ as s0:inputonly) as BOOLEAN map1 value$,s,2 value$ = item$[-2,-1] if value$ = "{}" or value$ = "[]" then fn'mj'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: ! Mj.findpath$ can contain quoted names or not (but not a mixture) !--------------------------------------------------------------------- Private Function fn'mj'can'skip'descent(parentpath$ as s0:inputonly) as BOOLEAN xcall XSTRIP, parentpath$, """", 1 ! remote quotes for simpler matching [202] if (Mj.findpath$[1,1] = "." or Mj.findpath$[1,1] = "[") and parentpath$ # "" then if parentpath$ # Mj.findpath$[1;len(parentpath$)] then fn'mj'can'skip'descent = .TRUE endif endif trace.print (99, "fnmjson") fn'mj'can'skip'descent,parentpath$,Mj.findpath$ 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: ! Mj.findpath$ - copy of reqpath$ with all parts quoted per std JSON ! Mj.findpath'len set to len(Mj.findpath$) ! Mj.arylvl set to 0 ! Mj.foundpath$ set to "" ! Mj.processed and Mj.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'mj'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 Mj.findpath$ with the name parts quoted Mj.findpath$ = "" for i = 1 to tokens x = instr(1,token$(i),"]",INSTRF_ANYQT) if x then Mj.findpath$ += "[" + token$(i) elseif token$(i) = "." then ! [113] this happens with multiple contiguous dots (a..b) Mj.findpath$ += "." elseif asc(token$(i)) then ! this test for null more reliable than #"" (until 6.5.1539.3 patch) Mj.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 Mj.findpath$ += "." endif endif next i ! Restore leading . if lost in shuffle above if findpath$[1,1] = "." and Mj.findpath$[1,1] # "." then Mj.findpath$ = "." + Mj.findpath$ endif ! [113] and trailing . if findpath$[-1,-1] = "." and Mj.findpath$[-1,-1] # "." then Mj.findpath$ += "." endif xcall XSTRIP, Mj.findpath$, """", 1 ! [117] remove quotes from findpath for uniformity Mj.findpath'len = len(Mj.findpath$) Mj.arylvl = 0 Mj.foundpath$ = "" Mj.processed = 0 ! init traversal variables Mj.skipped = 0 Mj.traverse'status = 0 ! [113] Mj.flags = flags ! [112] Mj.selection$ = selection$ ! [112] fn'mj'init'module'search'vars = .TRUE ! for now we allow any syntax trace.print (99, "fnmjson") fn'mj'init'module'search'vars, Mj.findpath$, Mj.selection$, Mj.flags EndFunction !--------------------------------------------------------------------- !Function: ! Callback function for Fn'MJ'TraverseToMap() !Params: ! curpath$ (str) [in] - current path ! item$ (str) [in] - current item !Returns: !Module vars: ! Mj.flags ! Mj.selection$ ! Mj.level ! Mj.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 map1 iname$,s,0 ! debug map1 ivalue$,s,0 ! debug trace.print (99,"fnmjson") "fn'cb'traverse'to'map",curpath$,item$,Mj.findpath$ xcall XSTRIP, curpath$, """", 1 if Mj.flags and MJF_VERT then ! vert mode; curpath must contain basepath if Mj.findpath$ = "" or instr(1,curpath$,Mj.findpath$) = 1 then .fn = 1 ! process the item (add to map) else .fn = -1 ! we left branch; we're done endif elseif Mj.flags and MJF_HORZ then ! horz mode; curpath must equal basepath if curpath$ = Mj.findpath$ then .fn = 1 ! indicate we "processed" the item elseif Mj.findpath$ # "" and instr(1,curpath$,Mj.findpath$) # 1 then .fn = -1 ! we crossed out of branch; we're done endif else ! otherwise anything goes .fn = 1 endif trace.print (99,"fnmjson") .fn if .fn = 1 ! if processing item, add to $map if (Mj.flags and MJF_PATH) then ! include path with item name $mjmap(curpath$+Fn'MJ'Member'Name$(item$)) = Fn'MJ'Member'Value$(item$) !trace.print (99,"fnmjson") "$mjmap(Fn'MJ'Member'Name$("+curpath$+Fn'MJ'Member'Name$(item$)+") = "+$mjmap(Fn'MJ'Member'Value$(item$) ) else ! just name !$mjmap(Fn'MJ'Member'Name$(item$)) = Fn'MJ'Member'Value$(item$) iname$ = Fn'MJ'Member'Name$(item$) ivalue$ = Fn'MJ'Member'Value$(item$) !trace.print (99,"fnmjson") "$mjmap(Fn'MJ'Member'Name$("+item$+") = "+$mjmap(Fn'MJ'Member'Value$(item$)) $mjmap(iname$) = ivalue$ endif endif EndFunction !--------------------------------------------------------------------- !Function: ! test for special JSON literal values that shouldn't be quoted, ! i.e. true, false, null, numbers !Params: ! value$ (str) [in] - value to test !Returns: ! .TRUE if value$ is a special literal value !Globals: !Notes: !--------------------------------------------------------------------- Private Function fn'mj'is'json'literal(value$ as s0:inputonly) as BOOLEAN if value$ = "true" or value$ = "false" or value$ = "null" then fn'mj'is'json'literal = .TRUE elseif value$ = "[]" or value$ = "{}" then ! [116] fn'mj'is'json'literal = .TRUE ! [116] elseif fn'all'digits(value$) then fn'mj'is'json'literal = .TRUE ! [202] elseif fn'mj'is'json'number(value$) then fn'mj'is'json'literal = .TRUE ! [202] this is a number endif EndFunction ![202] !--------------------------------------------------------------------- !Function: ! Test if field qualifies as a JSON number !Params: ! value$ (str) [in] - field !Returns: ! .TRUE or .FALSE !Globals: !Notes: !--------------------------------------------------------------------- Function fn'mj'is'json'number(value$ as s40:inputonly) as BOOLEAN if instr(1,value$,"-?\d+(.\d+)?([Ee][+-]?\d+)?$",PCRE_ANCHORED) .fn = .TRUE endif EndFunction ![202] !--------------------------------------------------------------------- !Function: ! auto-quote an item, i.e. member (name:value pair) or a scalar !Params: ! item$ (str) [in] - the item !Returns: ! item$ with proper quoting !Globals: !Notes: ! color:red -> "color":"red" ! amount:123 -> "amount":123 ! "foo" -> "foo" ! "123" -> "123" (we don't remove quotes) ! true -> true !--------------------------------------------------------------------- Function fn'mj'auto'quote'item$(item$ as s0:inputonly) as s0 map1 locals map2 x,i,2 map2 name$,s,JSON_MAX_NAME map2 value$,s,0 xcall TRIM, item$ if instr(1,"[{",item$[1,1]) then ! fail-safe to ignore objects, arrays .fn = item$ elseif instr(1,item$,",",INSTRF_ANYQT) then ! fail-safe to ignore lists .fn = item$ else ! if there is a : break it into name:value x = instr(2,item$,":",INSTRF_ANYQT) if x then name$ = item$[1,x-1] value$ = item$[x+1,-1] .fn = fn'mj'auto'quote'item$(name$) + ":" + fn'mj'auto'quote'item$(value$) ! (recursive) elseif fn'mj'is'json'literal(item$) .fn = item$ else .fn = Fn'Quote$(item$) endif endif EndFunction !--------------------------------------------------------------------- !Function: ! return the extend of a specified mlist !Params: ! $m() (mlist(varstr)) [byref-in] - the list or sublist to count !Returns: ! # of elements, or 0 if there are none !Globals: !Notes: ! This is hardly any more than just .extent($m()) except it solves ! the limitation of .extent($$i.sublist) not working, and also ! returns 0 for all error conditions (cleaner than reporting that ! there are -1 subelements) !--------------------------------------------------------------------- private function fn'mj'extent($m() as mlist(varstr)) map1 element$,s,0 ! debugging element$ = $m(.front) ! debugging .fn = .extent($m()) trace.print (99,"fnmjson") fn'mj'extent,element$ endfunction