Posted to tcl by sebres at Wed Apr 10 16:14:58 GMT 2019view raw

  1. /*
  2. * json-encode.c --
  3. *
  4. * Small module to get native json escape in tcl.
  5. *
  6. * Compile:
  7. * mingw: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/win -I$tcl/generic chanhandle.c -shared -o json.dll libtclstub87.a
  8. * *nix: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/unix -I$tcl/generic chanhandle.c -shared -o json.so libtclstub87.a
  9. *
  10. * Usage:
  11. * $ tclsh87
  12. * % load json
  13. * % json-encode "string to encode"
  14. */
  15.  
  16. #include "tcl.h"
  17. #include "stdlib.h"
  18.  
  19. #if 0
  20. /* tcl-generator for _TJson_TokTab */
  21. set m [list "\"" "\\\"" \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t \
  22. \x00 \\u0000 \x01 \\u0001 \x02 \\u0002 \x03 \\u0003 \
  23. \x04 \\u0004 \x05 \\u0005 \x06 \\u0006 \x07 \\u0007 \
  24. \x0b \\u000b \x0e \\u000e \x0f \\u000f \x10 \\u0010 \
  25. \x11 \\u0011 \x12 \\u0012 \x13 \\u0013 \x14 \\u0014 \
  26. \x15 \\u0015 \x16 \\u0016 \x17 \\u0017 \x18 \\u0018 \
  27. \x19 \\u0019 \x1a \\u001a \x1b \\u001b \x1c \\u001c \
  28. \x1d \\u001d \x1e \\u001e \x1f \\u001f \x7f \\u007f \
  29. \x80 \\u0080 \x81 \\u0081 \x82 \\u0082 \x83 \\u0083 \
  30. \x84 \\u0084 \x85 \\u0085 \x86 \\u0086 \x87 \\u0087 \
  31. \x88 \\u0088 \x89 \\u0089 \x8a \\u008a \x8b \\u008b \
  32. \x8c \\u008c \x8d \\u008d \x8e \\u008e \x8f \\u008f \
  33. \x90 \\u0090 \x91 \\u0091 \x92 \\u0092 \x93 \\u0093 \
  34. \x94 \\u0094 \x95 \\u0095 \x96 \\u0096 \x97 \\u0097 \
  35. \x98 \\u0098 \x99 \\u0099 \x9a \\u009a \x9b \\u009b \
  36. \x9c \\u009c \x9d \\u009d \x9e \\u009e \x9f \\u009f ]
  37. for {set c 0} {$c <= 127} {} {
  38. time {
  39. set ch [format %c $c]
  40. if {[set cm [string map $m $ch]] ne $ch} {
  41. if {[string range $cm 0 1] ne "\\u"} {
  42. set cm [string range $cm 1 end]
  43. if {$cm eq "\\"} {
  44. append cm "\\"
  45. }
  46. set cm " '$cm' /* ESC '$cm' */,"
  47. } else {
  48. set cm " 1 /* SPEC '$cm' */,"
  49. }
  50. } else {
  51. set cm " 0 /* NOTOK '[url_encode -extended $ch]' */,"
  52. }
  53. puts -nonewline $cm
  54. incr c
  55. } 8
  56. puts ""
  57. }
  58. #endif
  59.  
  60. const char _TJson_TokTab[] = {
  61. 1 /* SPEC '\u0000' */, 1 /* SPEC '\u0001' */, 1 /* SPEC '\u0002' */, 1 /* SPEC '\u0003' */, 1 /* SPEC '\u0004' */, 1 /* SPEC '\u0005' */, 1 /* SPEC '\u0006' */, 1 /* SPEC '\u0007' */,
  62. 'b' /* ESC 'b' */, 't' /* ESC 't' */, 'n' /* ESC 'n' */, 1 /* SPEC '\u000b' */, 'f' /* ESC 'f' */, 'r' /* ESC 'r' */, 1 /* SPEC '\u000e' */, 1 /* SPEC '\u000f' */,
  63. 1 /* SPEC '\u0010' */, 1 /* SPEC '\u0011' */, 1 /* SPEC '\u0012' */, 1 /* SPEC '\u0013' */, 1 /* SPEC '\u0014' */, 1 /* SPEC '\u0015' */, 1 /* SPEC '\u0016' */, 1 /* SPEC '\u0017' */,
  64. 1 /* SPEC '\u0018' */, 1 /* SPEC '\u0019' */, 1 /* SPEC '\u001a' */, 1 /* SPEC '\u001b' */, 1 /* SPEC '\u001c' */, 1 /* SPEC '\u001d' */, 1 /* SPEC '\u001e' */, 1 /* SPEC '\u001f' */,
  65. 0 /* NOTOK '%20' */, 0 /* NOTOK '%21' */, '"' /* ESC '"' */, 0 /* NOTOK '%23' */, 0 /* NOTOK '%24' */, 0 /* NOTOK '%25' */, 0 /* NOTOK '%26' */, 0 /* NOTOK '%27' */,
  66. 0 /* NOTOK '%28' */, 0 /* NOTOK '%29' */, 0 /* NOTOK '%2a' */, 0 /* NOTOK '%2b' */, 0 /* NOTOK '%2c' */, 0 /* NOTOK '-' */, 0 /* NOTOK '.' */, 0 /* NOTOK '%2f' */,
  67. 0 /* NOTOK '0' */, 0 /* NOTOK '1' */, 0 /* NOTOK '2' */, 0 /* NOTOK '3' */, 0 /* NOTOK '4' */, 0 /* NOTOK '5' */, 0 /* NOTOK '6' */, 0 /* NOTOK '7' */,
  68. 0 /* NOTOK '8' */, 0 /* NOTOK '9' */, 0 /* NOTOK '%3a' */, 0 /* NOTOK '%3b' */, 0 /* NOTOK '%3c' */, 0 /* NOTOK '%3d' */, 0 /* NOTOK '%3e' */, 0 /* NOTOK '%3f' */,
  69. 0 /* NOTOK '@' */, 0 /* NOTOK 'A' */, 0 /* NOTOK 'B' */, 0 /* NOTOK 'C' */, 0 /* NOTOK 'D' */, 0 /* NOTOK 'E' */, 0 /* NOTOK 'F' */, 0 /* NOTOK 'G' */,
  70. 0 /* NOTOK 'H' */, 0 /* NOTOK 'I' */, 0 /* NOTOK 'J' */, 0 /* NOTOK 'K' */, 0 /* NOTOK 'L' */, 0 /* NOTOK 'M' */, 0 /* NOTOK 'N' */, 0 /* NOTOK 'O' */,
  71. 0 /* NOTOK 'P' */, 0 /* NOTOK 'Q' */, 0 /* NOTOK 'R' */, 0 /* NOTOK 'S' */, 0 /* NOTOK 'T' */, 0 /* NOTOK 'U' */, 0 /* NOTOK 'V' */, 0 /* NOTOK 'W' */,
  72. 0 /* NOTOK 'X' */, 0 /* NOTOK 'Y' */, 0 /* NOTOK 'Z' */, 0 /* NOTOK '%5b' */, '\\' /* ESC '\\' */, 0 /* NOTOK '%5d' */, 0 /* NOTOK '%5e' */, 0 /* NOTOK '_' */,
  73. 0 /* NOTOK '%60' */, 0 /* NOTOK 'a' */, 0 /* NOTOK 'b' */, 0 /* NOTOK 'c' */, 0 /* NOTOK 'd' */, 0 /* NOTOK 'e' */, 0 /* NOTOK 'f' */, 0 /* NOTOK 'g' */,
  74. 0 /* NOTOK 'h' */, 0 /* NOTOK 'i' */, 0 /* NOTOK 'j' */, 0 /* NOTOK 'k' */, 0 /* NOTOK 'l' */, 0 /* NOTOK 'm' */, 0 /* NOTOK 'n' */, 0 /* NOTOK 'o' */,
  75. 0 /* NOTOK 'p' */, 0 /* NOTOK 'q' */, 0 /* NOTOK 'r' */, 0 /* NOTOK 's' */, 0 /* NOTOK 't' */, 0 /* NOTOK 'u' */, 0 /* NOTOK 'v' */, 0 /* NOTOK 'w' */,
  76. 0 /* NOTOK 'x' */, 0 /* NOTOK 'y' */, 0 /* NOTOK 'z' */, 0 /* NOTOK '%7b' */, 0 /* NOTOK '|' */, 0 /* NOTOK '%7d' */, 0 /* NOTOK '%7e' */, 1 /* SPEC '\u007f' */,
  77. 0
  78. };
  79.  
  80. static
  81. void _TJson_ObjStrToDString(Tcl_DString *ds, Tcl_Obj *inObj)
  82. {
  83. const char *start, *str = Tcl_GetString(inObj);
  84. int len = inObj->length;
  85. int cl;
  86. Tcl_UniChar ch;
  87. char c, buf[2+8+1] = "\\_";
  88.  
  89. if (!len) {
  90. Tcl_DStringAppend(ds, "\"\"", 2);
  91. return;
  92. }
  93.  
  94. Tcl_DStringAppend(ds, "\"", 1);
  95. start = str;
  96. while (len > 0) {
  97. if ( !((ch = *str) & 0x80) ) {
  98. c = _TJson_TokTab[(unsigned)*str];
  99. if (!c) { len--; str++; continue; };
  100. cl = 1;
  101. } else {
  102. cl = Tcl_UtfToUniChar(str, &ch);
  103. c = 1;
  104. }
  105. if (str > start) {
  106. Tcl_DStringAppend(ds, start, str - start);
  107. }
  108. if (c == 1) { /* SPEC escape \uxxxx */
  109. if (ch <= 65536) {
  110. buf[1] = 'u';
  111. sprintf(&buf[2], "%04x", (unsigned)ch);
  112. Tcl_DStringAppend(ds, buf, 2+4);
  113. } else { /* TCL_UTF_MAX > 4, special JSON */
  114. buf[1] = 'U';
  115. sprintf(&buf[2], "%08x", (unsigned)ch);
  116. Tcl_DStringAppend(ds, buf, 2+8);
  117. }
  118. } else { /* ESC char \c */
  119. buf[1] = c;
  120. Tcl_DStringAppend(ds, buf, 2);
  121. }
  122. len -= cl, str += cl;
  123. start = str;
  124. }
  125. if (str > start) {
  126. Tcl_DStringAppend(ds, start, str - start);
  127. }
  128. Tcl_DStringAppend(ds, "\"", 1);
  129. }
  130.  
  131. /* ------------------------------------------------------------- */
  132.  
  133. int JsonEncodeObjCmd(
  134. ClientData dummy,
  135. Tcl_Interp* interp,
  136. int objc,
  137. Tcl_Obj * const objv[]
  138. ) {
  139. Tcl_DString ds;
  140.  
  141. if (objc != 2) {
  142. Tcl_WrongNumArgs(interp, 1, objv, "string");
  143. return TCL_ERROR;
  144. }
  145.  
  146. Tcl_DStringInit(&ds);
  147.  
  148. #if 1
  149. _TJson_ObjStrToDString(&ds, objv[1]);
  150. #else
  151. if (_TJson_ObjToDString(interp, &ds, objv[1]) != TCL_OK) {
  152. Tcl_DStringFree(&ds);
  153. return TCL_ERROR;
  154. }
  155. #endif
  156.  
  157. #if 1
  158. Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
  159. #else
  160. Tcl_SetObjResult(interp, Tcl_DStringAsObj(&ds));
  161. #endif
  162. return TCL_OK;
  163. }
  164.  
  165. int Json_Init(Tcl_Interp *interp) {
  166. if (!Tcl_InitStubs(interp, "8.5", 0)) {
  167. return TCL_ERROR;
  168. }
  169. Tcl_CreateObjCommand(interp, "json-encode", JsonEncodeObjCmd, NULL, NULL);
  170. return TCL_OK;
  171. }
  172.  

Comments

Posted by sebres at Wed Apr 10 16:29:55 GMT 2019 [text] [code]

/* * json-encode.c -- * * Small module to get native json escape in tcl. * * Compile: * mingw: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/win -I$tcl/generic chanhandle.c -shared -o json.dll libtclstub87.a * *nix: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/unix -I$tcl/generic chanhandle.c -shared -o json.so libtclstub87.a * * Usage: * $ tclsh87 * % load json * % json-encode "string to encode" */ #include "tcl.h" #include "stdlib.h" /* tcl-generator for _TJson_TokTab * set m [list "\"" "\\\"" \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t \ \x00 \\u0000 \x01 \\u0001 \x02 \\u0002 \x03 \\u0003 \ \x04 \\u0004 \x05 \\u0005 \x06 \\u0006 \x07 \\u0007 \ \x0b \\u000b \x0e \\u000e \x0f \\u000f \x10 \\u0010 \ \x11 \\u0011 \x12 \\u0012 \x13 \\u0013 \x14 \\u0014 \ \x15 \\u0015 \x16 \\u0016 \x17 \\u0017 \x18 \\u0018 \ \x19 \\u0019 \x1a \\u001a \x1b \\u001b \x1c \\u001c \ \x1d \\u001d \x1e \\u001e \x1f \\u001f \x7f \\u007f \ \x80 \\u0080 \x81 \\u0081 \x82 \\u0082 \x83 \\u0083 \ \x84 \\u0084 \x85 \\u0085 \x86 \\u0086 \x87 \\u0087 \ \x88 \\u0088 \x89 \\u0089 \x8a \\u008a \x8b \\u008b \ \x8c \\u008c \x8d \\u008d \x8e \\u008e \x8f \\u008f \ \x90 \\u0090 \x91 \\u0091 \x92 \\u0092 \x93 \\u0093 \ \x94 \\u0094 \x95 \\u0095 \x96 \\u0096 \x97 \\u0097 \ \x98 \\u0098 \x99 \\u0099 \x9a \\u009a \x9b \\u009b \ \x9c \\u009c \x9d \\u009d \x9e \\u009e \x9f \\u009f ] for {set c 0} {$c <= 127} {} { time { set ch [format %c $c] if {[set cm [string map $m $ch]] ne $ch} { if {[string range $cm 0 1] ne "\\u"} { set cm [string range $cm 1 end] if {$cm eq "\\"} { append cm "\\" } set cm " '$cm' /\* ESC '$cm' *\/," } else { set cm " 1 /\* SPEC '$cm' *\/," } } else { set cm " 0 /\* NOTOK '[url_encode -extended $ch]' *\/," } puts -nonewline $cm incr c } 8 puts "" } */ const char _TJson_TokTab[] = { 1 /* SPEC '\u0000' */, 1 /* SPEC '\u0001' */, 1 /* SPEC '\u0002' */, 1 /* SPEC '\u0003' */, 1 /* SPEC '\u0004' */, 1 /* SPEC '\u0005' */, 1 /* SPEC '\u0006' */, 1 /* SPEC '\u0007' */, 'b' /* ESC 'b' */, 't' /* ESC 't' */, 'n' /* ESC 'n' */, 1 /* SPEC '\u000b' */, 'f' /* ESC 'f' */, 'r' /* ESC 'r' */, 1 /* SPEC '\u000e' */, 1 /* SPEC '\u000f' */, 1 /* SPEC '\u0010' */, 1 /* SPEC '\u0011' */, 1 /* SPEC '\u0012' */, 1 /* SPEC '\u0013' */, 1 /* SPEC '\u0014' */, 1 /* SPEC '\u0015' */, 1 /* SPEC '\u0016' */, 1 /* SPEC '\u0017' */, 1 /* SPEC '\u0018' */, 1 /* SPEC '\u0019' */, 1 /* SPEC '\u001a' */, 1 /* SPEC '\u001b' */, 1 /* SPEC '\u001c' */, 1 /* SPEC '\u001d' */, 1 /* SPEC '\u001e' */, 1 /* SPEC '\u001f' */, 0 /* NOTOK '%20' */, 0 /* NOTOK '%21' */, '"' /* ESC '"' */, 0 /* NOTOK '%23' */, 0 /* NOTOK '%24' */, 0 /* NOTOK '%25' */, 0 /* NOTOK '%26' */, 0 /* NOTOK '%27' */, 0 /* NOTOK '%28' */, 0 /* NOTOK '%29' */, 0 /* NOTOK '%2a' */, 0 /* NOTOK '%2b' */, 0 /* NOTOK '%2c' */, 0 /* NOTOK '-' */, 0 /* NOTOK '.' */, 0 /* NOTOK '%2f' */, 0 /* NOTOK '0' */, 0 /* NOTOK '1' */, 0 /* NOTOK '2' */, 0 /* NOTOK '3' */, 0 /* NOTOK '4' */, 0 /* NOTOK '5' */, 0 /* NOTOK '6' */, 0 /* NOTOK '7' */, 0 /* NOTOK '8' */, 0 /* NOTOK '9' */, 0 /* NOTOK '%3a' */, 0 /* NOTOK '%3b' */, 0 /* NOTOK '%3c' */, 0 /* NOTOK '%3d' */, 0 /* NOTOK '%3e' */, 0 /* NOTOK '%3f' */, 0 /* NOTOK '@' */, 0 /* NOTOK 'A' */, 0 /* NOTOK 'B' */, 0 /* NOTOK 'C' */, 0 /* NOTOK 'D' */, 0 /* NOTOK 'E' */, 0 /* NOTOK 'F' */, 0 /* NOTOK 'G' */, 0 /* NOTOK 'H' */, 0 /* NOTOK 'I' */, 0 /* NOTOK 'J' */, 0 /* NOTOK 'K' */, 0 /* NOTOK 'L' */, 0 /* NOTOK 'M' */, 0 /* NOTOK 'N' */, 0 /* NOTOK 'O' */, 0 /* NOTOK 'P' */, 0 /* NOTOK 'Q' */, 0 /* NOTOK 'R' */, 0 /* NOTOK 'S' */, 0 /* NOTOK 'T' */, 0 /* NOTOK 'U' */, 0 /* NOTOK 'V' */, 0 /* NOTOK 'W' */, 0 /* NOTOK 'X' */, 0 /* NOTOK 'Y' */, 0 /* NOTOK 'Z' */, 0 /* NOTOK '%5b' */, '\\' /* ESC '\\' */, 0 /* NOTOK '%5d' */, 0 /* NOTOK '%5e' */, 0 /* NOTOK '_' */, 0 /* NOTOK '%60' */, 0 /* NOTOK 'a' */, 0 /* NOTOK 'b' */, 0 /* NOTOK 'c' */, 0 /* NOTOK 'd' */, 0 /* NOTOK 'e' */, 0 /* NOTOK 'f' */, 0 /* NOTOK 'g' */, 0 /* NOTOK 'h' */, 0 /* NOTOK 'i' */, 0 /* NOTOK 'j' */, 0 /* NOTOK 'k' */, 0 /* NOTOK 'l' */, 0 /* NOTOK 'm' */, 0 /* NOTOK 'n' */, 0 /* NOTOK 'o' */, 0 /* NOTOK 'p' */, 0 /* NOTOK 'q' */, 0 /* NOTOK 'r' */, 0 /* NOTOK 's' */, 0 /* NOTOK 't' */, 0 /* NOTOK 'u' */, 0 /* NOTOK 'v' */, 0 /* NOTOK 'w' */, 0 /* NOTOK 'x' */, 0 /* NOTOK 'y' */, 0 /* NOTOK 'z' */, 0 /* NOTOK '%7b' */, 0 /* NOTOK '|' */, 0 /* NOTOK '%7d' */, 0 /* NOTOK '%7e' */, 1 /* SPEC '\u007f' */, 0 }; static void _TJson_ObjStrToDString(Tcl_DString *ds, Tcl_Obj *inObj) { const char *start, *str = Tcl_GetString(inObj); int len = inObj->length; int cl; Tcl_UniChar ch; char c, buf[2+8+1] = "\\_"; if (!len) { Tcl_DStringAppend(ds, "\"\"", 2); return; } Tcl_DStringAppend(ds, "\"", 1); start = str; while (len > 0) { if ( !((ch = *str) & 0x80) ) { c = _TJson_TokTab[(unsigned)*str]; if (!c) { len--; str++; continue; }; cl = 1; } else { cl = Tcl_UtfToUniChar(str, &ch); c = 1; } if (str > start) { Tcl_DStringAppend(ds, start, str - start); } if (c == 1) { /* SPEC escape \uxxxx */ if (ch <= 0xffff) { buf[1] = 'u'; sprintf(&buf[2], "%04x", (unsigned)ch); Tcl_DStringAppend(ds, buf, 2+4); } else { /* TCL_UTF_MAX > 4, special JSON */ buf[1] = 'U'; sprintf(&buf[2], "%08x", (unsigned)ch); Tcl_DStringAppend(ds, buf, 2+8); } } else { /* ESC char \c */ buf[1] = c; Tcl_DStringAppend(ds, buf, 2); } len -= cl, str += cl; start = str; } if (str > start) { Tcl_DStringAppend(ds, start, str - start); } Tcl_DStringAppend(ds, "\"", 1); } /* ------------------------------------------------------------- */ int JsonEncodeObjCmd( ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj * const objv[] ) { Tcl_DString ds; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } Tcl_DStringInit(&ds); #if 1 _TJson_ObjStrToDString(&ds, objv[1]); #else if (_TJson_ObjToDString(interp, &ds, objv[1]) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } #endif #if 1 Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); #else Tcl_SetObjResult(interp, Tcl_DStringAsObj(&ds)); #endif return TCL_OK; } int Json_Init(Tcl_Interp *interp) { if (!Tcl_InitStubs(interp, "8.5", 0)) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "json-encode", JsonEncodeObjCmd, NULL, NULL); return TCL_OK; }