Jim Tcl
Check-in [39428d770b]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:json: Add json encoder/decoder

Using the jsmn library for decoding. Based on the original implementation by Svyatoslav Mishyn <juef@openmailbox.org>

Signed-off-by: Steve Bennett <steveb@workware.net.au>

Timelines: family | ancestors | descendants | both | trunk |
Files: files | file ages | folders
SHA1: 39428d770bdd84797e1945335e7cff89a404dcbf
User & Date: steveb@workware.net.au 2019-11-09 09:59:15
Context
2019-11-09
11:06
json: Fix decode schema for list obj

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: 00e59d0dc4 user: steveb@workware.net.au tags: trunk,

09:59
json: Add json encoder/decoder

Using the jsmn library for decoding. Based on the original implementation by Svyatoslav Mishyn <juef@openmailbox.org>

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: 39428d770b user: steveb@workware.net.au tags: trunk,

09:59
jsmn: Fix a parser bug where object keys could be non-strings

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: 453a61f142 user: steveb@workware.net.au tags: trunk,

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to auto.def.

51
52
53
54
55
56
57

58
59
60
61
62
63
64
...
333
334
335
336
337
338
339


340
341
342
343
344
345
346
...
368
369
370
371
372
373
374

375
376
377
378
379
380
381
...
455
456
457
458
459
460
461








462
463
464
465
466
467
468
...
497
498
499
500
501
502
503
504



505

506

507
508

509
510
511
512
513
514
515
516
517
518
519
520
521
522
        These are disabled by default, but enabled by --full:

        oo        - Jim OO extension
        tree      - OO tree structure, similar to tcllib ::struct::tree
        binary    - Tcl-compatible 'binary' command
        tclprefix - Support for the tcl::prefix command
        zlib      - Interface to zlib


        These are disabled unless explicitly enabled:

        readline  - Interface to libreadline
        rlprompt  - Tcl wrapper around the readline extension
        mk        - Interface to Metakit
        sqlite3   - Interface to sqlite3
................................................................................
    clock     {}
    eventloop { static }
    exec      { static }
    file      {}
    glob      { tcl }
    history   {}
    interp    { }


    load      { static }
    mk        { cpp off }
    namespace { static }
    nshelper  { tcl optional }
    oo        { tcl }
    pack      {}
    package   { static }
................................................................................
dict set extdb info {
    binary   { dep pack }
    exec     { check {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]} }
    glob     { dep readdir }
    load     { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
    mk       { check {[check-metakit]} libdep lib_mk }
    namespace { dep nshelper }

    posix    { check {[have-feature waitpid]} }
    readdir  { check {[have-feature opendir]} }
    readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline}
    rlprompt { dep readline }
    tree     { dep oo }
    sdl      { pkg-config SDL_gfx check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]}
               libdep {lib_SDL_SetVideoMode lib_rectangleRGBA}
................................................................................

    # If the built-in regexp overrides the system regcomp, etc.
    # jim must be built shared so that the correct symbols are found
    if {[ext-get-status regexp] eq "m" && [get-define JIM_STATICLIB] && [have-feature regcomp]} {
        user-error "Must use --shared with regexp module and built-in regexp"
    }
}









# poor-man's signals
if {"signal" ni $extinfo(static-c)} {
    lappend extra_objs jim-nosignal.o
}

if {[ext-get-status load] eq "n"} {
................................................................................

# Now generate the Makefile rules to build the external C shared objects
# It is easier to do this here rather than listing them out explicitly in Makefile.in
set lines {}
foreach mod $extinfo(module-c) {
    set objs {}
    set libs [get-define LDLIBS_$mod]
    set src jim-$mod.c



    lappend lines "$mod.so: $src"

    set obj [file rootname $src].o

    lappend lines "\t\$(ECHO)\t\"\tCC\t$obj\""
    lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj $src"

    lappend lines "\t\$(ECHO)\t\"\tLDSO\t\$@\""
    lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(LDFLAGS) \$(SHOBJ_LDFLAGS) -o \$@ $obj \$(SH_LIBJIM) $libs"
    lappend lines ""
}
define BUILD_SHOBJS [join $lines \n]

make-config-header jim-config.h -auto {HAVE_LONG_LONG* JIM_UTF8} -bare JIM_VERSION -none *
make-config-header jimautoconf.h -auto {jim_ext_* TCL_PLATFORM_* TCL_LIBRARY USE_* JIM_* _FILE_OFFSET*} -bare {S_I*}
make-template Makefile.in
make-template tests/Makefile.in
make-template build-jim-ext.in
make-template jimtcl.pc.in

catch {exec chmod +x build-jim-ext}







>







 







>
>







 







>







 







>
>
>
>
>
>
>
>







 







|
>
>
>
|
>
|
>
|
|
>

|












51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
...
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
...
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
        These are disabled by default, but enabled by --full:

        oo        - Jim OO extension
        tree      - OO tree structure, similar to tcllib ::struct::tree
        binary    - Tcl-compatible 'binary' command
        tclprefix - Support for the tcl::prefix command
        zlib      - Interface to zlib
        json      - JSON encode/decode

        These are disabled unless explicitly enabled:

        readline  - Interface to libreadline
        rlprompt  - Tcl wrapper around the readline extension
        mk        - Interface to Metakit
        sqlite3   - Interface to sqlite3
................................................................................
    clock     {}
    eventloop { static }
    exec      { static }
    file      {}
    glob      { tcl }
    history   {}
    interp    { }
    json      { optional }
    jsonencode { tcl optional }
    load      { static }
    mk        { cpp off }
    namespace { static }
    nshelper  { tcl optional }
    oo        { tcl }
    pack      {}
    package   { static }
................................................................................
dict set extdb info {
    binary   { dep pack }
    exec     { check {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]} }
    glob     { dep readdir }
    load     { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
    mk       { check {[check-metakit]} libdep lib_mk }
    namespace { dep nshelper }
    json     { dep jsonencode extrasrcs jsmn/jsmn.c }
    posix    { check {[have-feature waitpid]} }
    readdir  { check {[have-feature opendir]} }
    readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline}
    rlprompt { dep readline }
    tree     { dep oo }
    sdl      { pkg-config SDL_gfx check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]}
               libdep {lib_SDL_SetVideoMode lib_rectangleRGBA}
................................................................................

    # If the built-in regexp overrides the system regcomp, etc.
    # jim must be built shared so that the correct symbols are found
    if {[ext-get-status regexp] eq "m" && [get-define JIM_STATICLIB] && [have-feature regcomp]} {
        user-error "Must use --shared with regexp module and built-in regexp"
    }
}

foreach mod $extinfo(static-c) {
    if {[dict exists $extdb info $mod extrasrcs]} {
        foreach src [dict get $extdb info $mod extrasrcs] {
            lappend extra_objs {*}[file rootname $src].o
        }
    }
}

# poor-man's signals
if {"signal" ni $extinfo(static-c)} {
    lappend extra_objs jim-nosignal.o
}

if {[ext-get-status load] eq "n"} {
................................................................................

# Now generate the Makefile rules to build the external C shared objects
# It is easier to do this here rather than listing them out explicitly in Makefile.in
set lines {}
foreach mod $extinfo(module-c) {
    set objs {}
    set libs [get-define LDLIBS_$mod]
    set srcs jim-$mod.c
    if {[dict exists $extdb info $mod extrasrcs]} {
        lappend srcs {*}[dict get $extdb info $mod extrasrcs]
    }
    lappend lines "$mod.so: $srcs"
    foreach src $srcs {
        set obj [file rootname $src].o
        lappend objs $obj
        lappend lines "\t\$(ECHO)\t\"\tCC\t$obj\""
        lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj $src"
    }
    lappend lines "\t\$(ECHO)\t\"\tLDSO\t\$@\""
    lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(LDFLAGS) \$(SHOBJ_LDFLAGS) -o \$@ $objs \$(SH_LIBJIM) $libs"
    lappend lines ""
}
define BUILD_SHOBJS [join $lines \n]

make-config-header jim-config.h -auto {HAVE_LONG_LONG* JIM_UTF8} -bare JIM_VERSION -none *
make-config-header jimautoconf.h -auto {jim_ext_* TCL_PLATFORM_* TCL_LIBRARY USE_* JIM_* _FILE_OFFSET*} -bare {S_I*}
make-template Makefile.in
make-template tests/Makefile.in
make-template build-jim-ext.in
make-template jimtcl.pc.in

catch {exec chmod +x build-jim-ext}

Added jim-json.c.





























































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
/*
 * Copyright (c) 2015 - 2016 Svyatoslav Mishyn <juef@openmailbox.org>
 * Copyright (c) 2019 Steve Bennett <steveb@workware.net.au>
 *
 * Permission to use, copy, modify, and/or distribute this software for
 * any purpose with or without fee is hereby granted, provided that the
 * above copyright notice and this permission notice appear in all
 * copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
 * WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
 * AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
 * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
 * PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
 * TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
 * PERFORMANCE OF THIS SOFTWARE.
 */

#include <assert.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>

#include <jim.h>

#include "jsmn/jsmn.h"

/* These are all the schema types we support */
typedef enum {
	JSON_BOOL,
	JSON_OBJ,
	JSON_LIST,
	JSON_MIXED,
	JSON_STR,
	JSON_NUM,
	JSON_MAX_TYPE,
} json_schema_t;

struct json_state {
	Jim_Obj *nullObj;
	const char *json;
	jsmntok_t *tok;
	int need_subst;
	/* The following are used for -schema */
	int enable_schema;
	Jim_Obj *schemaObj;
	Jim_Obj *schemaTypeObj[JSON_MAX_TYPE];
};

static void json_decode_dump_value(Jim_Interp *interp, struct json_state *state, Jim_Obj *list);

/**
 * Start a new subschema. Returns the previous schemaObj.
 * Does nothing and returns NULL if -schema is not enabled.
 */
static Jim_Obj *json_decode_schema_push(Jim_Interp *interp, struct json_state *state)
{
	Jim_Obj *prevSchemaObj = NULL;
	if (state->enable_schema) {
		prevSchemaObj = state->schemaObj;
		state->schemaObj = Jim_NewListObj(interp, NULL, 0);
		Jim_IncrRefCount(state->schemaObj);
	}
	return prevSchemaObj;
}

/**
 * Combines the current schema with the previous schema, prevSchemaObj
 * returned by json_decode_schema_push().
 * Does nothing if -schema is not enabled.
 */
static void json_decode_schema_pop(Jim_Interp *interp, struct json_state *state, Jim_Obj *prevSchemaObj)
{
	if (state->enable_schema) {
		Jim_ListAppendElement(interp, prevSchemaObj, state->schemaObj);
		Jim_DecrRefCount(interp, state->schemaObj);
		state->schemaObj = prevSchemaObj;
	}
}

/**
 * Appends the schema type to state->schemaObj based on 'type'
 */
static void json_decode_add_schema_type(Jim_Interp *interp, struct json_state *state, json_schema_t type)
{
	static const char * const schema_names[] = {
		"bool",
		"obj",
		"list",
		"mixed",
		"str",
		"num",
	};
	assert(type >= 0 && type < JSON_MAX_TYPE);
	/* Share multiple instances of the same type */
	if (state->schemaTypeObj[type] == NULL) {
		state->schemaTypeObj[type] = Jim_NewStringObj(interp, schema_names[type], -1);
	}
	Jim_ListAppendElement(interp, state->schemaObj, state->schemaTypeObj[type]);
}

/**
 * Returns the schema type for the given token.
 * There is a one-to-one correspondence except for JSMN_PRIMITIVE
 * which will return JSON_BOOL for true, false and JSON_NUM otherise.
 */
static json_schema_t json_decode_get_type(const jsmntok_t *tok, const char *json)
{
	switch (tok->type) {
		case JSMN_PRIMITIVE:
			assert(json);
			if (json[tok->start] == 't' || json[tok->start] == 'f') {
				return JSON_BOOL;
			}
			return JSON_NUM;
		case JSMN_OBJECT:
			return JSON_OBJ;
		case JSMN_ARRAY:
			/* Return mixed by default - need other checks to select list instead */
			return JSON_MIXED;
		case JSMN_STRING:
		default:
			return JSON_STR;
	}
}

/**
 * Returns the current object (state->tok) as a Tcl list.
 *
 * state->tok is incremented to just past the object that was dumped.
 */
static Jim_Obj *
json_decode_dump_container(Jim_Interp *interp, struct json_state *state)
{
	int i;
	Jim_Obj *list = Jim_NewListObj(interp, NULL, 0);
	int size = state->tok->size;
	int type = state->tok->type;
	json_schema_t container_type = JSON_OBJ; /* JSON_LIST, JSON_MIXED or JSON_OBJ */

	if (state->schemaObj) {
		json_schema_t list_type;
		/* Figure out the type to use for the container */
		if (type == JSMN_ARRAY) {
			/* If every element of the array is of the same primitive schema type (str, bool or num),
			 * we can use "list", otherwise need to use "mixed"
			 */
			container_type = JSON_LIST;
			if (size) {
				list_type = json_decode_get_type(&state->tok[1], state->json);

				if (list_type == JSON_BOOL || list_type == JSON_STR || list_type == JSON_NUM) {
					for (i = 2; i <= size; i++) {
						if (json_decode_get_type(state->tok + i, state->json) != list_type) {
							/* Can't use list */
							container_type = JSON_MIXED;
							break;
						}
					}
				}
			}
		}
		json_decode_add_schema_type(interp, state, container_type);
		if (container_type == JSON_LIST && size) {
			json_decode_add_schema_type(interp, state, list_type);
		}
	}

	state->tok++;

	for (i = 0; i < size; i++) {
		if (type == JSMN_OBJECT) {
			/* Dump the object key */
			if (state->enable_schema) {
				const char *p = state->json + state->tok->start;
				int len = state->tok->end - state->tok->start;
				Jim_ListAppendElement(interp, state->schemaObj, Jim_NewStringObj(interp, p, len));
			}
			json_decode_dump_value(interp, state, list);
		}

		if (state->schemaObj && container_type != JSON_LIST) {
			if (state->tok->type == JSMN_STRING || state->tok->type == JSMN_PRIMITIVE) {
				json_decode_add_schema_type(interp, state, json_decode_get_type(state->tok, state->json));
			}
		}

		/* Dump the array or object value */
		json_decode_dump_value(interp, state, list);
	}

	return list;
}

/**
 * Appends the value at state->tok to 'list' and increments state->tok to just
 * past that token.
 *
 * Also appends to the schema if state->enable_schema is set.
 */
static void
json_decode_dump_value(Jim_Interp *interp, struct json_state *state, Jim_Obj *list)
{
	const jsmntok_t *t = state->tok;

	if (t->type == JSMN_STRING || t->type == JSMN_PRIMITIVE) {
		Jim_Obj	*elem;
		int len = t->end - t->start;
		const char *p = state->json + t->start;
		if (t->type == JSMN_STRING) {
			/* Do we need to process backslash escapes? */
			if (state->need_subst == 0 && memchr(p, '\\', len) != NULL) {
				state->need_subst = 1;
			}
			elem = Jim_NewStringObj(interp, p, len);
		} else if (p[0] == 'n') {	/* null */
			elem = state->nullObj;
		} else if (p[0] == 'I') {
			elem = Jim_NewStringObj(interp, "Inf", -1);
		} else if (p[0] == '-' && p[1] == 'I') {
			elem = Jim_NewStringObj(interp, "-Inf", -1);
		} else {		/* number, true or false */
			elem = Jim_NewStringObj(interp, p, len);
		}

		Jim_ListAppendElement(interp, list, elem);
		state->tok++;
	}
	else {
		Jim_Obj *prevSchemaObj = json_decode_schema_push(interp, state);
		Jim_Obj *newList = json_decode_dump_container(interp, state);
		Jim_ListAppendElement(interp, list, newList);
		json_decode_schema_pop(interp, state, prevSchemaObj);
	}
}

/* Parses the options ?-null string? ?-schema? *state.
 * Any options not present are not set.
 *
 * Returns JIM_OK or JIM_ERR and sets an error result.
 */
static int parse_json_decode_options(Jim_Interp *interp, int argc, Jim_Obj *const argv[], struct json_state *state)
{
	static const char * const options[] = { "-null", "-schema", NULL };
	enum { OPT_NULL, OPT_SCHEMA, };
	int i;

	for (i = 1; i < argc - 1; i++) {
		int option;
		if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
			return JIM_ERR;
		}
		switch (option) {
			case OPT_NULL:
				i++;
				Jim_IncrRefCount(argv[i]);
				Jim_DecrRefCount(interp, state->nullObj);
				state->nullObj = argv[i];
				break;

			case OPT_SCHEMA:
				state->enable_schema = 1;
				break;
		}
	}

	if (i != argc - 1) {
		Jim_WrongNumArgs(interp, 1, argv,
			"?-null nullvalue? ?-schema? json");
		return JIM_ERR;
	}

	return JIM_OK;
}

/**
 * Use jsmn to tokenise the JSON string 'json' of length 'len'
 *
 * Returns an allocated array of tokens or NULL on error (and sets an error result)
 */
static jsmntok_t *
json_decode_tokenize(Jim_Interp *interp, const char *json, size_t len)
{
	jsmntok_t	*t;
	jsmn_parser	 parser;
	int n;

	/* Parse once just to find the number of tokens */
	jsmn_init(&parser);
	n = jsmn_parse(&parser, json, len, NULL, 0);

error:
	switch (n) {
		case JSMN_ERROR_INVAL:
			Jim_SetResultString(interp, "invalid JSON string", -1);
			return NULL;

		case JSMN_ERROR_PART:
			Jim_SetResultString(interp, "truncated JSON string", -1);
			return NULL;

		case 0:
			Jim_SetResultString(interp, "root element must be an object or an array", -1);
			return NULL;

		default:
			break;
	}

	if (n < 0) {
		return NULL;
	}

	t = Jim_Alloc(n * sizeof(*t));

	jsmn_init(&parser);
	n = jsmn_parse(&parser, json, len, t, n);
	if (t->type != JSMN_OBJECT && t->type != JSMN_ARRAY) {
		n = 0;
	}
	if (n <= 0) {
		Jim_Free(t);
		goto error;
	}

	return t;
}

/**
 * json::decode returns the decoded data structure.
 *
 * If -schema is specified, returns a list of {data schema}
 */
static int
json_decode(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
{
	Jim_Obj *list;
	jsmntok_t *tokens;
	int len;
	int ret = JIM_ERR;
	struct json_state state;

	memset(&state, 0, sizeof(state));

	state.nullObj = Jim_NewStringObj(interp, "null", -1);
	Jim_IncrRefCount(state.nullObj);

	if (parse_json_decode_options(interp, argc, argv, &state) != JIM_OK) {
		goto done;
	}

	state.json = Jim_GetString(argv[argc - 1], &len);

	if (!len) {
		Jim_SetResultString(interp, "empty JSON string", -1);
		goto done;
	}
	if ((tokens = json_decode_tokenize(interp, state.json, len)) == NULL) {
		goto done;
	}
	state.tok = tokens;
	json_decode_schema_push(interp, &state);

	list = json_decode_dump_container(interp, &state);
	Jim_Free(tokens);
	ret = JIM_OK;

	/* Make sure the refcount doesn't go to 0 during Jim_SubstObj() */
	Jim_IncrRefCount(list);

	if (state.need_subst) {
		/* Subsitute backslashes in the returned dictionary.
		 * Need to be careful of refcounts.
		 * Note that Jim_SubstObj() supports a few more escapes than
		 * JSON requires, but should give the same result for all legal escapes.
		 */
		Jim_Obj *newList;
		Jim_SubstObj(interp, list, &newList, JIM_SUBST_FLAG | JIM_SUBST_NOCMD | JIM_SUBST_NOVAR);
		Jim_IncrRefCount(newList);
		Jim_DecrRefCount(interp, list);
		list = newList;
	}

	if (state.schemaObj) {
		Jim_Obj *resultObj = Jim_NewListObj(interp, NULL, 0);
		Jim_ListAppendElement(interp, resultObj, list);
		Jim_ListAppendElement(interp, resultObj, state.schemaObj);
		Jim_SetResult(interp, resultObj);
		Jim_DecrRefCount(interp, state.schemaObj);
	}
	else {
		Jim_SetResult(interp, list);
	}
	Jim_DecrRefCount(interp, list);

done:
	Jim_DecrRefCount(interp, state.nullObj);

	return ret;
}

int
Jim_jsonInit(Jim_Interp *interp)
{
	if (Jim_PackageProvide(interp, "json", "1.0", JIM_ERRMSG) != JIM_OK) {
		return JIM_ERR;
	}

	Jim_CreateCommand(interp, "json::decode", json_decode, NULL, NULL);
	/* Load the Tcl implementation of the json encoder if possible */
	Jim_PackageRequire(interp, "jsonencode", 0);
	return JIM_OK;
}

Changes to jim_tcl.txt.

55
56
57
58
59
60
61

62
63
64
65
66
67
68
....
5326
5327
5328
5329
5330
5331
5332































































5333
5334
5335
5336
5337
5338
5339
Changes since 0.78
~~~~~~~~~~~~~~~~~~
1. Add `file mtimeus` for high resolution file timestamps
2. `aio` now supports datagram Unix-Domain sockets
3. Add support for `aio lock -wait`
4. Add `signal block` to prevent delivery of signals
5. Add support for `file split`


Changes between 0.77 and 0.78
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add serial/tty support with `aio tty`
2. Add support for 'jimsh -'
3. Add hidden '-commands' option to many commands
4. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete`
................................................................................
+*$interp eval* 'script' ...+::
    Evaluates a script in the context for the child interpreter, in the same way as 'eval'.

+*$interp alias* 'alias childcmd parentcmd ?arg ...?'+::
    Similar to 'alias', but creates a command, +'childcmd'+, in the child interpreter that is an
    alias for +'parentcmd'+ in the parent interpreter, with the given, fixed arguments.
    The alias may be deleted in the child with 'rename'.
































































[[BuiltinVariables]]
BUILT-IN VARIABLES
------------------

The following global variables are created automatically
by the Tcl library.







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
....
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
Changes since 0.78
~~~~~~~~~~~~~~~~~~
1. Add `file mtimeus` for high resolution file timestamps
2. `aio` now supports datagram Unix-Domain sockets
3. Add support for `aio lock -wait`
4. Add `signal block` to prevent delivery of signals
5. Add support for `file split`
6. Add support for `json::encode` and `json::decode`

Changes between 0.77 and 0.78
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add serial/tty support with `aio tty`
2. Add support for 'jimsh -'
3. Add hidden '-commands' option to many commands
4. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete`
................................................................................
+*$interp eval* 'script' ...+::
    Evaluates a script in the context for the child interpreter, in the same way as 'eval'.

+*$interp alias* 'alias childcmd parentcmd ?arg ...?'+::
    Similar to 'alias', but creates a command, +'childcmd'+, in the child interpreter that is an
    alias for +'parentcmd'+ in the parent interpreter, with the given, fixed arguments.
    The alias may be deleted in the child with 'rename'.

json::encode
~~~~~~~~~~~~

The Tcl -> JSON encoder is part of the optional 'json' package.

+*json::encode* 'value ?schema?'+::

Encode a Tcl value as JSON according to the schema (defaults to +'str'+). The following schema types are supported:
* 'str' - Tcl string -> JSON string
* 'num' - Tcl value -> bare numeric value or null
* 'bool' - Tcl boolean value -> true, false
* 'obj ?name subschema ...?' - Tcl dict -> JSON object. For each dict key matching 'name', the corresponding 'subschema'
is applied. The special name +'*'+ matches any keys not otherwise matched, otherwise the default +'str'+ is used.
* 'list ?subschema?' - Tcl list -> JSON array. The 'subschema' (default +'str'+) is applied for each element of the list/array.
* 'mixed ?subschema ...?' = Tcl list -> JSON array. Each 'subschema' is applied for the corresponding element of the list/array.
  ::
The following are examples:
----
    . json::encode {1 2 true false null 5.0} list
    [ "1", "2", "true", "false", "null", "5.0" ]
    . json::encode {1 2 true false null 5.0} {list num}
    [ 1, 2, true, false, null, 5.0 ]
    . json::encode {0 1 2 true false 5.0 off} {list bool}
    [ false, true, true, true, false, true, false ]
    . json::encode {a 1 b hello c {3 4}} obj
    { "a":"1", "b":"hello", "c":"3 4" }
    . json::encode {a 1 b hello c {3 4}} {obj a num c {list num}}
    { "a":1, "b":"hello", "c":[ 3, 4 ] }
    . json::encode {true true {abc def}} {mixed str num obj}
    [ "true", true, { "abc":"def" } ]
    . json::encode {a 1 b 3.0 c hello d null} {obj c str * num}
    { "a":1, "b":3.0, "c":"hello", "d":null }
----

json::decode
~~~~~~~~~~~~

The JSON -> Tcl decoder is part of the optional 'json' package.

+*json::decode* ?*-null* 'string'? ?*-schema*? 'json-string'+::

Decodes the given JSON string (must be array or object) into a Tcl data structure. If '+-schema+' is specified, returns a
list of +'{data schema}'+ where the schema is compatible with `json::encode`. Otherwise just returns the data.
Decoding is as follows (with schema types listed in parentheses):
* object -> dict ('obj')
* array -> list ('mixed' or 'list')
* number -> as-is ('num')
* boolean -> as-is ('bool')
* string -> string ('str')
* null -> supplied null string or the default +'"null"'+ ('num')
 ::
 Note that an object decoded into a dict will return the keys in the same order as the original string.
----
    . json::decode {[1, 2]}
    {1 2}
    . json::decode -schema {[1, 2]}
    {1 2} {list num}
    . json::decode -schema {{"a":1, "b":2}}
    {a 1 b 2} {obj a num b num}
    . json::decode -schema {[1, 2, {a:"b", c:false}, "hello"]}
    {1 2 {a b c false} hello} {mixed num num {obj a str c bool} str}
----

[[BuiltinVariables]]
BUILT-IN VARIABLES
------------------

The following global variables are created automatically
by the Tcl library.

Added jsonencode.tcl.









































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
# Implements 'json::encode'
#
# (c) 2019 Steve Bennett <steveb@workware.net.au>
#
# See LICENCE in this directory for licensing.

# Encode Tcl objects as JSON
# dict -> object
# list -> array
# numeric -> number
# string -> string
#
# The schema provides the type information for the value.
# str = string
# num = numeric (or null)
# bool = boolean
# obj ... = object. parameters are 'name' 'subschema' where the name matches the dict.
# list ... = array. parameters are 'subschema' for the elements of the list/array.
# mixed ... = array of mixed types. parameters are types for each element of the list/array.

# Top level JSON encoder which encodes the given
# value based on the schema
proc json::encode {value {schema str}} {
	json::encode.[lindex $schema 0] $value [lrange $schema 1 end]
}

# Encode a string
proc json::encode.str {value {dummy {}}} {
	# Strictly we should be converting \x00 through \x1F to unicode escapes
	# And anything outside the BMP to a UTF-16 surrogate pair
	return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\"
}

# If no type is given, also encode as a string
proc json::encode. {args} {
	tailcall json::encode.str {*}$args
}

# Encode a number
proc json::encode.num {value {dummy {}}} {
	if {$value in {Inf -Inf}} {
		append value inity
	}
	return $value
}

# Encode a boolean
proc json::encode.bool {value {dummy {}}} {
	if {$value} {
		return true
	}
	return false
}

# Encode an object (dictionary)
proc json::encode.obj {obj {schema {}}} {
	set result "\{"
	set sep " "
	foreach k [lsort [dict keys $obj]] {
		if {[dict exists $schema $k]} {
			set type [dict get $schema $k]
		} elseif {[dict exists $schema *]} {
			set type [dict get $schema *]
		} else {
			set type str
		}
		append result $sep\"$k\":

		append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]]
		set sep ", "
	}
	append result " \}"
}

# Encode an array (list)
proc json::encode.list {list {type str}} {
	set result "\["
	set sep " "
	foreach l $list {
		append result $sep
		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
		set sep ", "
	}
	append result " \]"
}

# Encode a mixed-type array (list)
# Must be as many types as there are elements of the list
proc json::encode.mixed {list types} {
	set result "\["
	set sep " "
	foreach l $list type $types {
		append result $sep
		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
		set sep ", "
	}
	append result " \]"
}

# vim: se ts=4:

Changes to make-index.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

while {[gets $f buf] >= 0} {
	if {[string match "~~*" $buf]} {
		if {[string match "*: *" $prev]} {
			incr c
			set target cmd_$c
			set lines [linsert $lines end-1 "\[\[$target\]\]"]
			set prevlist [split $prev ":, "]
		} else {
			set target _[string map {:: _} $prev]
			set prevlist [list $prev]
		}
		foreach cmd $prevlist {
			set cmd [string trim $cmd]
			if {[regexp {^[a-z.:]+$} $cmd]} {
				lappend commands [list $cmd $target]
				set cdict($cmd) $target
			}
		}
	}
	lappend lines $buf







|





|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

while {[gets $f buf] >= 0} {
	if {[string match "~~*" $buf]} {
		if {[string match "*: *" $prev]} {
			incr c
			set target cmd_$c
			set lines [linsert $lines end-1 "\[\[$target\]\]"]
			set prevlist [split $prev ", "]
		} else {
			set target _[string map {:: _} $prev]
			set prevlist [list $prev]
		}
		foreach cmd $prevlist {
			set cmd [string trim $cmd :]
			if {[regexp {^[a-z.:]+$} $cmd]} {
				lappend commands [list $cmd $target]
				set cdict($cmd) $target
			}
		}
	}
	lappend lines $buf

Added tests/json.test.





































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
source [file dirname [info script]]/testing.tcl

needs cmd json::decode json
needs cmd json::encode json

set json {
{
	"fossil":"9c65b5432e4aeecf3556e5550c338ce93fd861cc",
	"timestamp":1435827337,
	"command":"timeline/checkin",
	"procTimeUs":3333,
	"procTimeMs":3,
	"homepage":null,
	"payload":{
		"limit":1,
		"timeline":[{
			"type":"checkin",
			"uuid":"f8b17edee7ff4f16517601c40eb713602aed7a52",
			"isLeaf":true,
			"timestamp":1435318826,
			"user":"juef",
			"comment":"adwaita-icon-theme: update to 3.17.3",
			"parents":["de628be645cc62429d630f9234c56d1fddfdc2a3"],
			"tags":["trunk"]
		}]
	}
}}

test json-decode-001 {top level keys} {
	lsort [dict keys [json::decode $json]]
} {command fossil homepage payload procTimeMs procTimeUs timestamp}

# Note that the decode will return the keys/values in order
test json-decode-002 {object value} {
	dict get [json::decode $json] payload
} {limit 1 timeline {{type checkin uuid f8b17edee7ff4f16517601c40eb713602aed7a52 isLeaf true timestamp 1435318826 user juef comment {adwaita-icon-theme: update to 3.17.3} parents de628be645cc62429d630f9234c56d1fddfdc2a3 tags trunk}}}

test json-decode-003 {object nested value} {
	dict get [json::decode $json] payload timeline
} {{type checkin uuid f8b17edee7ff4f16517601c40eb713602aed7a52 isLeaf true timestamp 1435318826 user juef comment {adwaita-icon-theme: update to 3.17.3} parents de628be645cc62429d630f9234c56d1fddfdc2a3 tags trunk}}

test json-decode-004 {array entry from nested value} {
	lindex [dict get [json::decode $json] payload timeline] 0
} {type checkin uuid f8b17edee7ff4f16517601c40eb713602aed7a52 isLeaf true timestamp 1435318826 user juef comment {adwaita-icon-theme: update to 3.17.3} parents de628be645cc62429d630f9234c56d1fddfdc2a3 tags trunk}

test json-decode-005 {object value from child array entry} {
	dict get [lindex [dict get [json::decode $json] payload timeline] 0] comment
} {adwaita-icon-theme: update to 3.17.3}

test json-decode-006 {unicode escape} {
	dict get [json::decode {{"key":"\u2022"}}] key
} \u2022

test json-decode-011 {null subsitution} {
	dict get [json::decode -null NULL $json] homepage
} {NULL}

test json-decode-012 {default null value} {
	dict get [json::decode $json] homepage
} {null}

test json-decode-1.1 {Number forms} {
	json::decode {[ 1, 2, 3.0, 4, Infinity, NaN, -Infinity, -0.0, 1e5, -1e-5 ]}
} {1 2 3.0 4 Inf NaN -Inf -0.0 1e5 -1e-5}

test json-2.1 {schema tests} {
	lindex [json::decode -schema {[]}] 1
} {list}

test json-2.2 {schema tests} {
	lindex [json::decode -schema {[1, 2]}] 1
} {list num}

test json-2.3 {schema tests} {
	lindex [json::decode -schema {[1, 2, [3, 4], 4, 6]}] 1
} {mixed num num {list num} num num}

test json-2.4 {schema tests} {
	lindex [json::decode -schema {{"a":1, "b":2}}] 1
} {obj a num b num}

test json-2.5 {schema tests} {
	lindex [json::decode -schema {[1, 2, {a:"b", c:false}, "hello"]}] 1
} {mixed num num {obj a str c bool} str}

test json-2.6 {schema tests} {
	lindex [json::decode -schema {[1, 2, {a:["b", 1, true, Infinity]}]}] 1
} {mixed num num {obj a {mixed str num bool num}}}

test json-2.7 {schema tests} {
	lindex [json::decode -schema {[1, 2, {a:["b", 1, true, ["d", "e", "f"]]}]}] 1
} {mixed num num {obj a {mixed str num bool {list str}}}}

test json-2.8 {schema tests} {
	lindex [json::decode -schema {[1, 2, true, false]}] 1
} {mixed num num bool bool}


unset -nocomplain json

test json-encode-1.1 {String with backslashes}  {
	json::encode {A "quoted string containing \backslashes\"}
} {"A \"quoted string containing \\backslashes\\\""}

test json-encode-1.2 {String with special chars} {
	json::encode "Various \n special \b characters \t and /slash/ \r too"
} {"Various \n special \b characters \t and \/slash\/ \r too"}

test json-encode-1.3 {Array of numbers} {
	json::encode {1 2 3.0 4 Inf NaN -Inf -0.0 1e5 -1e-5} {list num}
} {[ 1, 2, 3.0, 4, Infinity, NaN, -Infinity, -0.0, 1e5, -1e-5 ]}

test json-encode-1.4 {Array of strings} {
	json::encode {1 2 3.0 4} list
} {[ "1", "2", "3.0", "4" ]}

test json-encode-1.5 {Array of objects} {
	json::encode {{state NY city {New York} postalCode 10021 streetAddress {21 2nd Street}} {state CA city {Los Angeles} postalCode 10345 streetAddress {15 Hale St}}} {list obj postalCode num}
} {[ { "city":"New York", "postalCode":10021, "state":"NY", "streetAddress":"21 2nd Street" }, { "city":"Los Angeles", "postalCode":10345, "state":"CA", "streetAddress":"15 Hale St" } ]}

test json-encode-1.6 {Simple typeless object} {
	json::encode {home {212 555-1234} fax {646 555-4567}} obj
} {{ "fax":"646 555-4567", "home":"212 555-1234" }}

test json-encode-1.7 {Primitives as num} {
	json::encode {a false b null c true} {obj a num b num c num}
} {{ "a":false, "b":null, "c":true }}

test json-encode-1.8 {Complex schema} {
	json::encode {Person {firstName John age 25 lastName Smith years {1972 1980 1995 2002} PhoneNumbers {home {212 555-1234} fax {646 555-4567}} Address {state NY city {New York} postalCode 10021 streetAddress {21 2nd Street}}}} {obj Person {obj age num Address {obj postalCode num} PhoneNumbers obj years {list num}}}
} {{ "Person":{ "Address":{ "city":"New York", "postalCode":10021, "state":"NY", "streetAddress":"21 2nd Street" }, "PhoneNumbers":{ "fax":"646 555-4567", "home":"212 555-1234" }, "age":25, "firstName":"John", "lastName":"Smith", "years":[ 1972, 1980, 1995, 2002 ] } }}

test json-encode-1.9 {Array of mixed types} {
	json::encode {{a b c d} 44} {mixed list num}
} {[ [ "a", "b", "c", "d" ], 44 ]}

test json-encode-1.10 {Array of objects} {
	json::encode {{state NY city {New York} postalCode 10021 streetAddress {21 2nd Street}} {state CA city {Los Angeles} postalCode 10345 streetAddress {15 Hale St}}} {list obj postalCode num}
} {[ { "city":"New York", "postalCode":10021, "state":"NY", "streetAddress":"21 2nd Street" }, { "city":"Los Angeles", "postalCode":10345, "state":"CA", "streetAddress":"15 Hale St" } ]}

test json-encode-1.11 {Forms of boolean} {
	json::encode {-5 4 1 0 yes no true false} {list bool}
} {[ true, true, true, false, true, false, true, false ]}


testreport