API tools faq
paste
Damaged

MUF JSON parser v5

Damaged
Apr 1st, 2013
119
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 12.47 KB | None | 0 0
raw download clone embed print report diff
  1. $def maxstring 64000 2 /
  2. lvar filler_text
  3. $def filler filler_text @ not if "****************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************" begin dup strcat dup strlen maxstring > if maxstring strcut pop break then repeat dup filler_text ! else filler_text @ then
  4.  
  5. : object2JSON[ any:input -- array of strings ]
  6. input @ string? if input @ strlen maxstring -- > if maxstring "JSON: String exceeds %i char limit." fmtstring abort then then
  7. input @ string? if { "\"" input @ "\\\\" "\\" subst "\\\"" "\"" subst "\\/" "/" subst "\"" }cat 1 array_make exit then
  8. input @ int? if input @ intostr 1 array_make exit then
  9. input @ float? if input @ "%f" fmtstring 1 array_make exit then
  10. input @ dbref? if input @ "%d#" fmtstring 1 array_make exit then
  11. input @ lock? if input @ unparselock "\\\\" "\\" subst "\\%" "%" subst "%%%s%%" fmtstring 1 array_make exit then
  12. 0 array_make var! output
  13. input @ dictionary? if
  14. "{" output @ array_appenditem output !
  15. input @ foreach var! value var! key
  16. key @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
  17. ":" output @ array_appenditem output !
  18. value @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
  19. "," output @ array_appenditem output !
  20. repeat
  21. "}" output @ dup array_last pop array_setitem exit
  22. then
  23. input @ array? if
  24. "[" output @ array_appenditem output !
  25. input @ foreach var! value pop
  26. value @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
  27. "," output @ array_appenditem output !
  28. repeat
  29. "]" output @ dup array_last pop array_setitem exit
  30. then
  31. "JSON: Error in object2JSON" abort
  32. ; PUBLIC object2JSON
  33. $libdef object2JSON
  34.  
  35. : JSONmember[ str:input -- key value ]
  36. input @ 1 array_make "$lib/damagedJSON" match "JSON2object" call
  37. dup 0 array_getitem swap 1 array_getitem
  38. ; SAFECALL JSONmember
  39.  
  40. : JSONelement[ str:input -- value ]
  41. input @ 1 array_make "$lib/damagedJSON" match "JSON2object" call
  42. 0 array_getitem
  43. ;
  44.  
  45.  
  46. : JSON2object[ array:JSONarray -- arr:data ]
  47. "" var! JSONstring
  48. 0 array_make var! output
  49. begin
  50. JSONstring @ not if
  51. JSONarray @ 0 array_getitem JSONstring !
  52. JSONarray @ 0 array_delitem JSONarray !
  53. then
  54. JSONstring @ case
  55. "{" instr 1 = when
  56. JSONstring @ 1 strcut nip JSONstring !
  57. 0 array_make_dict
  58. begin
  59. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup dup "," instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < swap dup "," instr ?dup not if 99999999 then swap "}" instr ?dup not if 9999999 then < and if
  60. JSONstring @ dup
  61. begin
  62. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  63. dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  64. dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  65. 1 until
  66. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^,])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem
  67. continue
  68. else
  69. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup "}" instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < if
  70. JSONstring @ dup
  71. begin
  72. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  73. dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  74. dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  75. 1 until
  76. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\}])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem
  77. output @ array_appenditem output !
  78. break
  79. then
  80. then
  81. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  82. JSONarray @ 0 array_delitem JSONarray !
  83. repeat
  84. end
  85. "[" instr 1 = when
  86. JSONstring @ 1 strcut nip JSONstring !
  87. 0 array_make
  88. begin
  89. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup dup "," instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < swap dup "," instr ?dup not if 99999999 then swap "]" instr ?dup not if 9999999 then < and if
  90. JSONstring @ dup
  91. begin
  92. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  93. dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  94. dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  95. 1 until
  96. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^,])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONelement swap array_appenditem
  97. continue
  98. else
  99. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup "]" instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < if
  100. JSONstring @ dup
  101. begin
  102. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  103. dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  104. dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
  105. 1 until
  106. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\]])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONelement swap array_appenditem
  107. output @ array_appenditem output !
  108. break
  109. then
  110. then
  111. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  112. JSONarray @ 0 array_delitem JSONarray !
  113. repeat
  114. end
  115. "\"" instr 1 = when
  116. begin
  117. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" REG_ICASE regexp 0 array_getitem swap not if
  118. pop
  119. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  120. JSONarray @ 0 array_delitem JSONarray !
  121. continue
  122. then
  123. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "\"" rsplit pop
  124. "\"" "\\\"" subst "/" "\\/" subst "\\" "\\\\" subst
  125. output @ array_appenditem output !
  126. 1 until
  127. end
  128. "#" instr 1 = when
  129. begin
  130. JSONstring @ "#[0-9]*#" REG_ICASE regexp 0 array_getitem swap not if
  131. pop
  132. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  133. JSONarray @ 0 array_delitem JSONarray !
  134. continue
  135. then
  136. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop stod output @ array_appenditem output !
  137. 1 until
  138. end
  139. "%" instr 1 = when
  140. begin
  141. JSONstring @ "%([^\\\\%]*|\\\\[\\\\%])*%" REG_ICASE regexp 0 array_getitem swap not if
  142. pop
  143. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  144. JSONarray @ 0 array_delitem JSONarray !
  145. continue
  146. then
  147. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop
  148. "%" "\\%" subst "\\" "\\\\" subst parselock
  149. output @ array_appenditem output !
  150. 1 until
  151. end
  152. ":" instr 1 = when
  153. JSONstring @ 1 strcut nip JSONstring !
  154. end
  155. dup "true" instring 1 = swap "false" instring 1 = or when
  156. begin
  157. JSONstring @ "true|false" REG_ICASE regexp swap not if
  158. pop
  159. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  160. JSONarray @ 0 array_delitem JSONarray !
  161. continue
  162. then
  163. 0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! "true" stringcmp not if 1 else 0 then output @ array_appenditem output !
  164. 1 until
  165. end
  166. pop 1 when
  167. begin
  168. JSONstring @ "-?(?=[1-9]|0(?!\\d))\\d+(\\.\\d+)?([eE][+-]?\\d+)?" REG_ICASE regexp swap not if
  169. pop
  170. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  171. JSONarray @ 0 array_delitem JSONarray !
  172. continue
  173. then
  174. 0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! dup var! number
  175. dup atoi swap strtof floor int = if
  176. number @ atoi
  177. else
  178. number @ strtof
  179. then
  180. output @ array_appenditem output !
  181. 1 until
  182. end
  183. endcase
  184. JSONarray @ not JSONstring @ not and until
  185. output @
  186. ; PUBLIC JSON2object
  187. $libdef JSON2object
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!