Удалены зависимости на json. Конфиг будет ввиде tcl-словаря
This commit is contained in:
parent
2503187e59
commit
0a61eff7db
|
@ -311,6 +311,39 @@ proc SaveMainServer {host port path_to_rac} {
|
|||
return "$host:$port"
|
||||
}
|
||||
|
||||
proc SaveConfig {} {
|
||||
global host server active_cluster infobase profile_name dir rac_cmd_for_host rac_cmd servers_list
|
||||
set file [open [file join $dir(work) 1c_srv_new.cfg] "a+"]
|
||||
|
||||
puts "$host:$port $rac_cmd"
|
||||
puts $file "$host:$port,$rac_cmd"
|
||||
close $file
|
||||
return "$host:$port"
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
set servers_list {
|
||||
server_id {
|
||||
command rac_cmd
|
||||
cluster_id {
|
||||
cluster_name ""
|
||||
infobase-id1 {
|
||||
infobase_name ""
|
||||
infobase_user ""
|
||||
infobase_pwd ""
|
||||
}
|
||||
infobase-id2 {
|
||||
infobase_name ""
|
||||
infobase_user ""
|
||||
infobase_pwd ""
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc GetWorkTreeItems {par} {
|
||||
set work_tree_id [.frm_work.tree_work selection]
|
||||
set work_tree_values [.frm_work.tree_work item $work_tree_id -values]
|
||||
|
@ -377,6 +410,9 @@ proc CreateInfoBasesJSONfile {serversList} {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
namespace eval Run {} {}
|
||||
# Получение данных по кластерам
|
||||
|
||||
|
@ -2475,3 +2511,4 @@ proc Del::inet {tree host profile_name} {
|
|||
|
||||
|
||||
|
||||
|
||||
|
|
60
lib/json.tcl
60
lib/json.tcl
|
@ -1,60 +0,0 @@
|
|||
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
|
||||
}
|
||||
|
||||
|
|
@ -126,6 +126,3 @@ set default(auth) {
|
|||
set color(dark_table_bg) "#6f6f6f"
|
||||
set color(light_table_bg) "#424242"
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user