diff --git a/lib/function.tcl b/lib/function.tcl index 5457257..31350f1 100644 --- a/lib/function.tcl +++ b/lib/function.tcl @@ -340,23 +340,6 @@ proc GetWorkTreeRow {} { return $lst } -proc JsonGet {json args} { - 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 -} - proc CreateInfoBasesJSONfile {} { global default dir set info_base_json_file [file join $dir(work) infobases.lst] @@ -2479,3 +2462,5 @@ proc Del::inet {tree host profile_name} { + + diff --git a/lib/json.tcl b/lib/json.tcl new file mode 100644 index 0000000..eff505b --- /dev/null +++ b/lib/json.tcl @@ -0,0 +1,59 @@ +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 +} +