#include #include #include #include #include Tcl_AppInitProc Json2dict_Init; static Tcl_ObjCmdProc json2dict; static Tcl_FreeInternalRepProc jsoncfree; static Tcl_UpdateStringProc jsonc2string; static Tcl_DupInternalRepProc jsoncdup; static Tcl_Obj *value2obj(Tcl_Interp *, struct json_object *); static Tcl_ObjType json_t = { .name = "json-c", .freeIntRepProc = jsoncfree, .dupIntRepProc = jsoncdup, .updateStringProc = jsonc2string }; #define tcl2jso(O) (O->internalRep.twoPtrValue.ptr1) void jsoncfree(Tcl_Obj *O) { assert(O->typePtr == &json_t); json_object_put(tcl2jso(O)); } void jsoncdup(Tcl_Obj *src, Tcl_Obj *dst) { assert(src->typePtr == &json_t); dst->bytes = src->bytes; dst->length = src->length; dst->typePtr = &json_t; Tcl_IncrRefCount(src); } void jsonc2string(Tcl_Obj *O) { json_object *jso = tcl2jso(O); Tcl_Obj *copy; assert(O->typePtr == &json_t); copy = value2obj(NULL, jso); O->typePtr = copy->typePtr; O->bytes = Tcl_GetStringFromObj(copy, &O->length); json_object_put(tcl2jso(O)); memcpy(&O->internalRep, ©->internalRep, sizeof(O->internalRep)); copy->bytes = NULL; copy->length = 0; copy->typePtr = NULL; Tcl_DecrRefCount(copy); } static Tcl_Obj * jsoncNewObj(struct json_object *jso) { Tcl_Obj *result = Tcl_NewObj(); result->bytes = NULL; result->typePtr = &json_t; tcl2jso(result) = json_object_get(jso); return result; } Tcl_Obj * value2obj(Tcl_Interp *I, struct json_object *jso) { Tcl_Obj *result, *key, *value; int len; struct array_list *ar; switch (json_object_get_type(jso)) { case json_type_object: result = Tcl_NewDictObj(); json_object_object_foreach(jso, k, v) { key = Tcl_NewStringObj(k, -1); switch (json_object_get_type(v)) { case json_type_object: case json_type_array: value = jsoncNewObj(v); break; default: value = value2obj(I, v); } Tcl_DictObjPut(I, result, key, value); // json_object_object_del(jso, k); } return result; case json_type_null: result = Tcl_NewObj(); break; case json_type_boolean: result = Tcl_NewBooleanObj(json_object_get_boolean(jso)); break; case json_type_double: result = Tcl_NewDoubleObj(json_object_get_double(jso)); break; case json_type_int: result = Tcl_NewWideIntObj(json_object_get_int64(jso)); break; case json_type_array: ar = json_object_get_array(jso); result = Tcl_NewListObj(0, NULL); for (len = 0; len < ar->length; len++) { switch (json_object_get_type(ar->array[len])) { case json_type_object: case json_type_array: value = jsoncNewObj(ar->array[len]); break; default: value = value2obj(I, ar->array[len]); } Tcl_ListObjAppendElement(I, result, value); } return result; case json_type_string: len = json_object_get_string_len(jso); result = Tcl_NewStringObj(json_object_get_string(jso), len); } return result; /* unreachable */ } int json2dict(ClientData cd, Tcl_Interp *I, int objc, Tcl_Obj * const *objv) { struct json_tokener *tok; enum json_tokener_error jerr; struct json_object *parsed; const char *text; int len; Tcl_Obj *result; if (objc != 2) { Tcl_WrongNumArgs(I, 1, objv, "JSON-text"); return TCL_ERROR; } text = Tcl_GetStringFromObj(objv[1], &len); tok = json_tokener_new(); parsed = json_tokener_parse_ex(tok, text, len); if (parsed == NULL) { jerr = json_tokener_get_error(tok); Tcl_SetResult(I, (void *)json_tokener_error_desc(jerr), TCL_STATIC); json_tokener_free(tok); return TCL_ERROR; } json_tokener_free(tok); result = value2obj(I, parsed); json_object_put(parsed); Tcl_SetObjResult(I, result); return TCL_OK; } int Json2dict_Init(Tcl_Interp *I) { Tcl_CreateObjCommand(I, "json-c::json2dict", json2dict, NULL, NULL); /* * Conversion from string needs to be implemented before we can * safely register the "json-c" type with Tcl: */ if (json_t.setFromAnyProc) Tcl_RegisterObjType(&json_t); return Tcl_PkgProvide(I, "json_bin", "1.1"); }