Tcl Library Source Code

Artifact 7825c7089e6422ac4f26fa69e3e9662930c047e4:

#include <tcl.h>

#include <json-c/json.h>

static Tcl_ObjCmdProc json2dict;
Tcl_AppInitProc Json2dict_Init;

static 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);
			value = value2obj(I, v);
			Tcl_DictObjPut(I, result, key, value);
			json_object_object_del(jso, k);
		}
		return result;
	case json_type_null:
		return Tcl_NewObj();
	case json_type_boolean:
		return Tcl_NewBooleanObj(json_object_get_boolean(jso));
	case json_type_double:
		return Tcl_NewDoubleObj(json_object_get_double(jso));
	case json_type_int:
		return Tcl_NewLongObj(json_object_get_int64(jso));
	case json_type_array:
		ar = json_object_get_array(jso);
		result = Tcl_NewListObj(0, NULL);
		for (len = 0; len < ar->length; len++)
			Tcl_ListObjAppendElement(I, result,
			    value2obj(I, ar->array[len]));
		return result;
	case json_type_string:
		len = json_object_get_string_len(jso);
		return Tcl_NewStringObj(json_object_get_string(jso), len);
	}
	return NULL; /* 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;

	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);

	Tcl_SetObjResult(I, value2obj(I, parsed));

	json_object_put(parsed);
	
	return TCL_OK;
}

int Json2dict_Init(Tcl_Interp *I)
{
	Tcl_CreateObjCommand(I, "json2dict", json2dict, NULL, NULL);

	return Tcl_PkgProvide(I, "json_bin", "1.0");
}