55 lines
1.8 KiB
Tcl
55 lines
1.8 KiB
Tcl
|
#############################################
|
||
|
|
# Rac GUI
|
||
|
|
# Distributed under GNU Public License
|
||
|
|
# Author: Sergey Kalinin svk@nuk-svk.ru
|
||
|
|
# Copyright (c) "http://nuk-svk.ru", 2018
|
||
|
|
# https://bitbucket.org/svk28/rac-gui
|
||
|
|
#############################################
|
||
|
|
# Config file and dictionary working functions
|
||
|
|
# global dict - $servers_list
|
||
|
|
##############################################
|
||
|
|
|
||
|
|
# Получаем юзера и пароль из конфига
|
||
|
|
proc GetInfobaseUser {host cluster infobase} {
|
||
|
|
global servers_list
|
||
|
|
if [dict exists $servers_list servers $host clusters $cluster infobases $infobase infobase_user] {
|
||
|
|
return [dict get $servers_list servers $host clusters $cluster infobases $infobase infobase_user]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
proc GetInfobasePassword {host cluster infobase} {
|
||
|
|
global servers_list
|
||
|
|
if [dict exists $servers_list servers $host clusters $cluster infobases $infobase infobase_pwd] {
|
||
|
|
return [dict get $servers_list servers $host clusters $cluster infobases $infobase infobase_pwd]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# Конвертация словаря в удобочитаемый формат
|
||
|
|
proc dict2file {dictionary} {
|
||
|
|
#regexp -nocase -indices -all -- {\{} $dictionary list
|
||
|
|
#set str [string map {"\{" "\{\r\n" "\}" "\r\n\}\r\n"} $dictionary]
|
||
|
|
set str $dictionary
|
||
|
|
# Pretty indenting...
|
||
|
|
set indent ""
|
||
|
|
if {[regexp {\}} $str]} {
|
||
|
|
set indent [string range $indent 0 end-4]
|
||
|
|
}
|
||
|
|
append result $indent$str\n
|
||
|
|
if {[regexp {\{} $str]} {
|
||
|
|
append indent " "
|
||
|
|
}
|
||
|
|
|
||
|
|
return $result
|
||
|
|
}
|
||
|
|
|
||
|
|
# Сохраянем конфиг
|
||
|
|
proc SaveConfig {} {
|
||
|
|
global dir servers_list
|
||
|
|
set file [open [file join $dir(work) 1c_srv_new.cfg] "w"]
|
||
|
|
|
||
|
|
puts $file [dict2file [dict get $servers_list servers]]
|
||
|
|
close $file
|
||
|
|
}
|
||
|
|
|
||
|
|
|