Добавлены функции для работы с JSON

master
Sergey Kalinin 2019-08-21 16:49:13 +03:00
parent 8f70f97e5f
commit caa39b49aa
2 changed files with 61 additions and 17 deletions

View File

@ -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} {

59
lib/json.tcl 100644
View File

@ -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
}