API tools faq
paste
Damaged

MUF JSON parser v4

Damaged
Apr 1st, 2013
219
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.29 KB | None | 0 0
raw download clone embed print report
  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 not if break else 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 then
  63. repeat
  64. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^,])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem
  65. continue
  66. else
  67. 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
  68. JSONstring @ dup
  69. begin
  70. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else 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 then
  71. repeat
  72. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\}])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem
  73. output @ array_appenditem output !
  74. break
  75. then
  76. then
  77. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  78. JSONarray @ 0 array_delitem JSONarray !
  79. repeat
  80. end
  81. "[" instr 1 = when
  82. JSONstring @ 1 strcut nip JSONstring !
  83. 0 array_make
  84. begin
  85. 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
  86. JSONstring @ dup
  87. begin
  88. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else 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 then
  89. repeat
  90. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^,])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONelement swap array_appenditem
  91. continue
  92. else
  93. 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
  94. JSONstring @ dup
  95. begin
  96. dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else 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 then
  97. repeat
  98. "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\]])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONelement swap array_appenditem
  99. output @ array_appenditem output !
  100. break
  101. then
  102. then
  103. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  104. JSONarray @ 0 array_delitem JSONarray !
  105. repeat
  106. end
  107. "\"" instr 1 = when
  108. begin
  109. JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" REG_ICASE regexp 0 array_getitem swap not if
  110. pop
  111. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  112. JSONarray @ 0 array_delitem JSONarray !
  113. continue
  114. then
  115. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "\"" rsplit pop
  116. "\"" "\\\"" subst "/" "\\/" subst "\\" "\\\\" subst
  117. output @ array_appenditem output !
  118. 1 until
  119. end
  120. "#" instr 1 = when
  121. begin
  122. JSONstring @ "#[0-9]*#" REG_ICASE regexp 0 array_getitem swap not if
  123. pop
  124. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  125. JSONarray @ 0 array_delitem JSONarray !
  126. continue
  127. then
  128. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop stod output @ array_appenditem output !
  129. 1 until
  130. end
  131. "%" instr 1 = when
  132. begin
  133. JSONstring @ "%([^\\\\%]*|\\\\[\\\\%])*%" REG_ICASE regexp 0 array_getitem swap not if
  134. pop
  135. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  136. JSONarray @ 0 array_delitem JSONarray !
  137. continue
  138. then
  139. JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop
  140. "%" "\\%" subst "\\" "\\\\" subst parselock
  141. output @ array_appenditem output !
  142. 1 until
  143. end
  144. ":" instr 1 = when
  145. JSONstring @ 1 strcut nip JSONstring !
  146. end
  147. dup "true" instring 1 = swap "false" instring 1 = or when
  148. begin
  149. JSONstring @ "true|false" REG_ICASE regexp swap not if
  150. pop
  151. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  152. JSONarray @ 0 array_delitem JSONarray !
  153. continue
  154. then
  155. 0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! "true" stringcmp not if 1 else 0 then output @ array_appenditem output !
  156. 1 until
  157. end
  158. pop 1 when
  159. begin
  160. JSONstring @ "-?(?=[1-9]|0(?!\\d))\\d+(\\.\\d+)?([eE][+-]?\\d+)?" REG_ICASE regexp swap not if
  161. pop
  162. JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !
  163. JSONarray @ 0 array_delitem JSONarray !
  164. continue
  165. then
  166. 0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! dup var! number
  167. dup atoi swap strtof floor int = if
  168. number @ atoi
  169. else
  170. number @ strtof
  171. then
  172. output @ array_appenditem output !
  173. 1 until
  174. end
  175. endcase
  176. JSONarray @ not JSONstring @ not and until
  177. output @
  178. ; PUBLIC JSON2object
  179. $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!