60 lines
1.9 KiB
Tcl
60 lines
1.9 KiB
Tcl
|
proc tcl2json value {
|
||
|
|
# https://rosettacode.org/wiki/JSON#Tcl
|
||
|
|
# Guess the type of the value; deep *UNSUPPORTED* magic!
|
||
|
|
regexp {^value is a (.*?) with a refcount} \
|
||
|
|
[::tcl::unsupported::representation $value] -> type
|
||
|
|
|
||
|
|
switch $type {
|
||
|
|
string {
|
||
|
|
return [json::write string $value]
|
||
|
|
}
|
||
|
|
dict {
|
||
|
|
return [json::write object {*}[
|
||
|
|
dict map {k v} $value {tcl2json $v}]]
|
||
|
|
}
|
||
|
|
list {
|
||
|
|
return [json::write array {*}[lmap v $value {tcl2json $v}]]
|
||
|
|
}
|
||
|
|
int - double {
|
||
|
|
return [expr {$value}]
|
||
|
|
}
|
||
|
|
booleanString {
|
||
|
|
return [expr {$value ? "true" : "false"}]
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
# Some other type; do some guessing...
|
||
|
|
if {$value eq "null"} {
|
||
|
|
# Tcl has *no* null value at all; empty strings are semantically
|
||
|
|
# different and absent variables aren't values. So cheat!
|
||
|
|
return $value
|
||
|
|
} elseif {[string is integer -strict $value]} {
|
||
|
|
return [expr {$value}]
|
||
|
|
} elseif {[string is double -strict $value]} {
|
||
|
|
return [expr {$value}]
|
||
|
|
} elseif {[string is boolean -strict $value]} {
|
||
|
|
return [expr {$value ? "true" : "false"}]
|
||
|
|
}
|
||
|
|
return [json::write string $value]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc jsonget {json args} {
|
||
|
|
# https://wiki.tcl-lang.org/page/JSON
|
||
|
|
foreach key $args {
|
||
|
|
if {[dict exists $json $key]} {
|
||
|
|
set json [dict get $json $key]
|
||
|
|
} elseif {[string is integer $key]} {
|
||
|
|
if {$key >= 0 && $key < [llength $json]} {
|
||
|
|
set json [lindex $json $key]
|
||
|
|
} else {
|
||
|
|
error "can't get item number $key from {$json}"
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
error "can't get \"$key\": no such key in {$json}"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $json
|
||
|
|
}
|
||
|
|
|