Here is a small interface I wrote to handle JSON data. It is somewhat specialized to my app, but easily adapted. Basically is converts JSON to DICT, processes DICTs and then regenerates JSON.
if { ! [info exists JSON.TCL] || $tcl_interactive } {
set JSON.TCL 1
package require json
# These functions are used to manipulate dict structures used by the Tcl JSON package
namespace eval json {
set ARRAY_NAMES { spouses images documents notes comments }
# Check if a string is an array
proc isArray { what } {
variable ARRAY_NAMES
if { [lsearch $ARRAY_NAMES $what] == -1 } {
return 0;
}
return 1
}
# Set the list of array names
proc setArrayNames { args } {
variable ARRAY_NAMES
set ARRAY_NAMES $args
}
# Convert a list to a json array element
proc array2json { items { is_dict 1 } } {
set result "\["
foreach item $items {
append result "\{"
foreach { key value } $item {
if { [isArray $key] } {
set entry "[array2json $value],"
} else {
set entry "\"$key\":\"$value\","
}
append result $entry
}
set result "[string trim $result ,]\},\n"
}
set result [string trim $result ",\n"]
append result "\]"
return $result
}
# Convert a dict structure to a json string
proc dict2json { dict { is_dict 1 } } {
set result "\{\n"
foreach { key value } $dict {
if { [string trim $key] != "" } {
append result "\"$key\":"
if { [isArray $key] } {
set json [array2json $value $is_dict]
append result "$json,\n"
} else {
append result "\"$value\",\n"
}
}
} ;# foreach loop
set result [string trim $result ",\n"]
append result "\n\}"
return $result
}
# Get a list of dict elements that match a regular expression pattern
proc getDictElements { dict pat } {
set result {}
foreach { item value } $dict {
if { [regexp $pat $item] } {
lappend result "$item=$value"
}
}
return $result
}
# Check if a dict has an element that matches a regular expression pattern
proc hasDictElement { dict pat } {
foreach { key value } $dict {
if { [regexp $pat $key] } {
return 1;
}
}
return 0;
}
# See if a dict element value matches a pattern
proc dictElementMatches { dict name value } {
return [regexp $value [getDictElement $dict $name]]
}
# Get an element from a dict structure
proc getDictElement { dict name } {
foreach { item value } $dict {
if { $name == $item } {
return $value
}
} ;# foreach loop
return ""
}
# Set an element in a dict structure. Do nothing if there is not element matching the name
proc setDictElement { dict name new_value } {
set result {}
foreach { item value } $dict {
if { $item == $name } {
lappend result $item $new_value
} else {
lappend result $item $value
}
}
return $result
}
# Add an element to a dict
proc addDictElement { dict name value } {
if { [hasDictElement $dict $name] == 0 } {
lappend dict $name $value
}
return $dict
}
# Insert an element into a dict. Here the parameter where is the name of the element
# in the dict to use to insert the new item, if before is non-zero, the new item
# goes before the item with the name where, otherwise it follows.
proc insertDictElement { dict name value where { before 0 } } {
set result ""
foreach { key data } $dict {
if { $key == $where } {
if { $before } {
append result "$name \{$value\} $key \{$data\} "
} else {
append result "$key \{$data\} $name \{$value\} "
}
} else {
append result "$key \{$data\} "
}
}
return $result
}
# Delete an element from a dict
proc deleteDictElement { dict name } {
set result {}
foreach { item value } $dict {
if { $item != $name } {
lappend result $item $value
}
}
return $result
}
# Add an item to a list of items
proc addListItem { items value idx before } {
set result ""
for { set i 0 } { $i < [llength $items] } { incr i } {
set item [lindex $items $i]
if { $i == $idx } {
if { $before } {
lappend result $value
lappend result $item
} else {
lappend result $item
lappend result $value
}
} else {
lappend result $item
}
} ;# for loop
return $result
}
# Insert a new item into an array of items
proc insertDictArrayElement { dict name value idx { before 0 } } {
set items [getDictElement $dict $name]
if { [isValidIndex $items $idx] } {
return [setDictElement $dict $name [addListItem $items $value $idx $before]]
}
return ""
}
# Get a list of elements from a dict
proc getDictElements { dict args { level 1 } } {
foreach arg $args {
upvar $level $arg x
set x [getDictElement $dict $arg]
}
}
# Check if an array element exists
proc arrayElementExists { dict name idx } {
if { [getDictArrayElement $dict $name $idx] != "" } {
return 1
}
return 0
}
# Check that an index is valid for an array
proc isValidIndex { items idx } {
set len [llength $items]
if { $idx < 0 || $idx > [incr len -1] } {
return 0
}
return 1
}
# Get an element from an array
proc getDictArrayElement { dict name idx } {
set items [getDictElement $dict $name]
if { [isValidIndex $items $idx] } {
return [lindex $items $idx]
}
return ""
}
# Get the value of an array element item
proc getDictArrayElementValue { dict name idx key } {
set item [getDictArrayElement $dict $name $idx]
if { $item != "" } {
return [getDictElement $item $key]
}
return ""
}
# Check if an array contains a matching element
proc arrayHasMatchingElement { dict name key value } {
set items [getDictElement $dict $name]
for { set i 0 } { $i < [llength $items] } { incr i } {
if { [dictElementMatches [lindex $items $i] $key $value] } {
return $i
}
}
return -1
}
# Add an element to a dict array
proc addDictArrayElement { dict name value } {
set items [getDictElement $dict $name]
lappend items $value
return [setDictElement $dict $name $items]
}
# Replace an item in a dict list
proc replaceListItem { items idx new_value } {
set result ""
for { set i 0 } { $i < [llength $items] } { incr i } {
if { $i == $idx } {
if { $new_value != "" } {
lappend result $new_value
}
} else {
lappend result [lindex $items $i]
}
}
return $result
}
# Delete a dict array element
proc deleteDictArrayElement { dict name idx } {
set items [getDictElement $dict $name]
if { [isValidIndex $items $idx] } {
return [setDictElement $dict $name [replaceListItem $items $idx ""]]
}
return ""
}
# Set an element in an array item of a dict. This proc sets the element of
# the array item with index idx and item name item to the specified value.
proc setDictArrayElement { dict name item value idx } {
set items [getDictElement $dict $name]
if { [isValidIndex $items $idx] } {
set new_value [setDictElement [lindex $items $idx] $item $value]
if { $new_value == "" } {
return ""
}
return [setDictElement $dict $name [replaceListItem $items $idx $new_value]]
}
return ""
}
# Replace an array element
proc replaceDictArrayElement { dict name idx value } {
set items [getDictElement $dict $name]
if { [isValidIndex $items $idx] } {
return [setDictElement $dict $name [replaceListItem $items $idx $value]]
}
return ""
}
} ;# namespace eval
# Create a new dict object
proc NewDict { json } {
return [::json::json2dict $json]
}
# Generate a JSON object from a dict object
proc NewJson { dict } {
return [::json::dict2json $dict]
}
# Get an element from a dictionary
proc GetDictElement { dict name } {
set ord [lsearch $dict $name]
if { $ord != -1 } { return [lindex $dict [incr ord]] }
return ""
}
# Get a list of element values from a dictionary
proc GetDictElements { dict args } {
set result ""
foreach arg $args {
lappend result [GetDictElement $dict $arg]
}
return $result
}
# Set the value of a dict element
proc SetDictElement { dict name value } {
return [::json::setDictElement $dict $name $value]
}
# Set a list of elements in a dict
proc SetDictElements { dict args } {
foreach { name value } $args {
set dict [SetDictElement $dict $name $value]
}
return $dict
}
} ;# if info exists JSON.TCL