210 lines
6.7 KiB
Tcl
210 lines
6.7 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 GetClusterAdmin {host cluster} {
|
|
global servers_list
|
|
if [dict exists $servers_list servers $host clusters $cluster cluster_user] {
|
|
return [dict get $servers_list servers $host clusters $cluster cluster_user]
|
|
}
|
|
}
|
|
proc GetClusterPassword {host cluster} {
|
|
global servers_list
|
|
if [dict exists $servers_list servers $host clusters $cluster cluster_pwd] {
|
|
return [dict get $servers_list servers $host clusters $cluster cluster_pwd]
|
|
}
|
|
}
|
|
|
|
proc GetAgentAdmin {host} {
|
|
global servers_list
|
|
if [dict exists $servers_list servers $host agent_user] {
|
|
return [dict get $servers_list servers $host agent_user]
|
|
}
|
|
}
|
|
proc GetAgentPassword {host} {
|
|
global servers_list
|
|
if [dict exists $servers_list servers $host agent_pwd] {
|
|
return [dict get $servers_list servers $host agent_pwd]
|
|
}
|
|
}
|
|
|
|
# Конвертация словаря в удобочитаемый формат
|
|
|
|
proc DictFormatter {dict {indent}} {
|
|
set str ""
|
|
set i 0
|
|
foreach {k v} $dict {
|
|
#if {$v eq ""} {set v "NULL"}
|
|
#puts "\nkey - $k value - [string trim $v]"
|
|
|
|
if [regexp {\{} $v] {
|
|
append indent "-"
|
|
DictFormatter $v $indent
|
|
} elseif [regexp {\}} $v] {
|
|
set indent [string trimright $indent "-"]
|
|
DictFormatter $v $indent
|
|
} else {
|
|
set str "$k $v"
|
|
}
|
|
}
|
|
puts "$indent$str"
|
|
}
|
|
proc dict2json {dictionary} {
|
|
dict for {key value} $dictionary {
|
|
puts "$key $value"
|
|
if {[string match {\{*\}} $value]} {
|
|
lappend Result "\"$key\":$value"
|
|
} elseif {![catch {dict size $value}]} {
|
|
lappend Result "\"$key\":\"[dict2json $value]\""
|
|
} else {
|
|
lappend Result "\"$key\":\"$value\""
|
|
}
|
|
puts $Result
|
|
}
|
|
return "\{[join $Result ",\n"]\}"
|
|
}
|
|
|
|
|
|
proc SetServersConfigDict {} {
|
|
global servers_list
|
|
|
|
}
|
|
|
|
# Сохраянем конфиг
|
|
proc SaveConfig {} {
|
|
global dir servers_list
|
|
#puts ">>>>>>>>>>> $servers_list <<<<<<<<<<<<"
|
|
set file [open [file join $dir(work) 1c_srv_new.cfg] "w"]
|
|
set f [open [file join $dir(work) 1c_srv_new_.cfg] "w"]
|
|
if {![dict exists $servers_list servers]} {
|
|
return
|
|
}
|
|
set dict [dict get $servers_list servers]
|
|
set dict [string map {"\{" "\{\n" "\}" "\n\}"} $dict]
|
|
regsub -- {(\})} $dict "\}\n" dict
|
|
puts $file $dict
|
|
close $file
|
|
set file [open [file join $dir(work) 1c_srv_new.cfg] "r"]
|
|
|
|
set str ""
|
|
seek $file 0
|
|
set close_brace 0
|
|
set open_brace 0
|
|
set indent ""
|
|
while {[gets $file line] >=0} {
|
|
if [regexp -- {\{} $line] {
|
|
if {$open_brace == 0} {
|
|
append indent ""
|
|
} else {
|
|
append indent " "
|
|
}
|
|
incr open_brace
|
|
}
|
|
if [regexp -- {\}} $line] {
|
|
#incr open_brace -1
|
|
set indent [string range $indent 0 end-4]
|
|
incr close_brace
|
|
}
|
|
if [regexp -nocase -all -- {(\})(.+?\{)} $line match brace phrase] {
|
|
set line "$brace\n$indent$phrase"
|
|
}
|
|
if {$open_brace > $close_brace} {
|
|
#set line "$indent$line"
|
|
}
|
|
if [regexp -nocase -indices -all -- {((.*?)\s(".*?"))} $line match v1 v2 v3] {
|
|
set index [lindex [split $v3 " "] 1]
|
|
#puts $index
|
|
set last_pair [string trim [string range $line $index+1 end]]
|
|
set line [GetDictFromString $line $indent]
|
|
if {$last_pair ne ""} {
|
|
append line "$indent[string trim $last_pair]"
|
|
}
|
|
}
|
|
append str $indent [string trim $line] "\n"
|
|
}
|
|
puts $f $str
|
|
close $f
|
|
set file [open [file join $dir(work) 1c_srv_new.cfg] "w"]
|
|
set f [open [file join $dir(work) 1c_srv_new_.cfg] "r"]
|
|
while {[gets $f line] >=0} {
|
|
if {$line ne ""} {
|
|
puts $file $line
|
|
}
|
|
}
|
|
#puts $file $servers_list
|
|
#file delete -force [file join $dir(work) 1c_srv_new_.cfg]
|
|
#file copy -force [file join $dir(work) 1c_srv_new_.cfg] [file join $dir(work) 1c_srv_new.cfg]
|
|
}
|
|
|
|
proc GetDictFromString {str indent} {
|
|
puts $str
|
|
if [regexp -nocase -indices -- {((.*?)\s(".*?"))} $str match v1 v2 v3] {
|
|
set index [lindex [split $v3 " "] 1]
|
|
set first_pair [string range $str 0 $index]
|
|
append res $indent $first_pair "\n"
|
|
append res [GetDictFromString [string range $str $index+1 end] $indent] "\n"
|
|
#append res [string range $str $index+1 end] "\n"
|
|
return $res
|
|
}
|
|
}
|
|
|
|
# Проверка установки переменных в конфиге
|
|
proc CheckVariablesSet {} {
|
|
global default dir
|
|
set lst_vars {
|
|
rac_dir
|
|
critical_total_memory
|
|
temporary_allowed_total_memory
|
|
temporary_allowed_total_memory_time_limit
|
|
}
|
|
set result [::msgcat::mc "The default variables is undefinied:"]
|
|
set var ""
|
|
foreach item $lst_vars {
|
|
if {![info exists default($item)]} {
|
|
append var "\ndefault($item)"
|
|
}
|
|
}
|
|
puts $var
|
|
append result $var "\n" [::msgcat::mc "New config file will be copying from RAC GUI distributive."]
|
|
if {$var ne ""} {
|
|
set answer [tk_messageBox -message $result \
|
|
-icon warning -type yesno ]
|
|
switch -- $answer {
|
|
no return
|
|
yes {
|
|
CopyNewConfig
|
|
source [file join $dir(work) rac_gui.cfg]
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
proc CopyNewConfig {} {
|
|
global dir
|
|
if {[file exists [file join $dir(work) rac_gui.cfg]] ==1} {
|
|
file rename -force [file join $dir(work) rac_gui.cfg] [file join $dir(work) rac_gui.cfg.old]
|
|
file copy [file join $dir(root) rac_gui.cfg] [file join $dir(work) rac_gui.cfg]
|
|
}
|
|
}
|