Attachment "json2.c" to
ticket [6efa4f571a]
added by
anonymous
2013-12-10 15:04:53.
#include <assert.h>
#include <tcl.h>
#include <string.h>
#include <stdio.h>
#include <json-c/json.h>
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");
}