1
0
mirror of https://bitbucket.org/svk28/rac-gui synced 2024-11-11 00:16:53 +00:00
1c_rac-gui/lib/function.tcl

506 lines
21 KiB
Tcl
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

######################################################
# 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
######################################################
proc Quit {} {
exit
}
proc TreePress {tree} {
global host
set id [$tree selection]
set values [$tree item [$tree selection] -values]
set key [lindex [split $id "::"] 0]
if {$key eq "server"} {
set host $values
}
Run::$key $tree $host $values
#RunCommand $root "infobase summary list --cluster=$cluster $host"
}
namespace eval Run {} {}
# Получение данных по кластерам
proc Run::server {tree host values} {
puts "Server info $host $values"
set lst [RunCommand server::$host "cluster list $host"]
set l [split $lst "&"]
foreach i $l {
set cluster_list [split $i ":"]
if {[string trim [lindex $cluster_list 0]] eq "cluster"} {
set cluster_id [string trim [lindex $cluster_list 1]]
lappend cluster($cluster_id) $cluster_id
}
if {[string trim [lindex $cluster_list 0]] eq "name"} {
lappend cluster($cluster_id) [string trim [lindex $cluster_list 1]]
}
}
foreach x [array names cluster] {
set id [lindex $cluster($x) 0]
if { [$tree exists "cluster::$id"] == 0 } {
$tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
InsertClusterItems $tree $id
}
}
}
proc Run::cluster {$tree host values} {
global active_cluster
set active_cluster $values
puts "Server info $host $values"
puts [RunCommand cluster::$values "cluster info --cluster=$values $host"]
}
proc Run::infobases {tree host values} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "infobase summary --cluster=$active_cluster list $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
if {[string trim [lindex $base_list 0]] eq "infobase"} {
set base_id [string trim [lindex $base_list 1]]
lappend base($base_id) $base_id
}
if {[string trim [lindex $base_list 0]] eq "name"} {
lappend base($base_id) [string trim [lindex $base_list 1]]
}
InsertItemsWorkList $base_list
}
foreach x [array names base] {
set id [lindex $base($x) 0]
if { [$tree exists "infobase::$id"] == 0 } {
$tree insert "infobases::$values" end -id "infobase::$id" -text "[lindex $base($x) 1]" -values "$id"
}
InsertBaseItems $tree $id
}
}
proc Run::infobase {tree host values} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "infobase info --cluster=$active_cluster --infobase=$values $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
InsertItemsWorkList $base_list
}
}
proc Run::List:Base {tree host values par} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster --infobase=$values $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
InsertItemsWorkList $base_list
}
}
proc Run::List {tree host values par} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
InsertItemsWorkList $base_list
}
}
proc Run::sessions {tree host values} {
Run::List:Base $tree $host $values session
}
proc Run::locks {tree host values} {
Run::List:Base $tree $host $values lock
}
proc Run::connections {tree host values} {
Run::List:Base $tree $host $values connection
}
proc Run::servers {tree host values} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "server list --cluster=$active_cluster $host"]
set l [split $lst "&"]
foreach i $l {
set server_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $server_list 0]] eq "server"} {
set server_id [string trim [lindex $server_list 1]]
lappend server($server_id) $server_id
}
if {[string trim [lindex $server_list 0]] eq "name"} {
lappend server($server_id) [string trim [lindex $server_list 1]]
}
}
foreach x [array names server] {
set id [lindex $server($x) 0]
if { [$tree exists "work_server::$id"] == 0 } {
$tree insert "servers::$values" end -id "work_server::$id" -text "[lindex $server($x) 1]" -values "$id"
}
#InsertServerItems $tree $id
}
#Run::List $tree $host $values server
}
proc Run::work_server {tree host values} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "server info --cluster=$active_cluster --server=$values $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
InsertItemsWorkList $base_list
}
#Run::List $tree $host $values server
}
proc Run::profiles {tree host values} {
Run::List $tree $host $values profile
}
proc Run::processes {tree host values} {
Run::List $tree $host $values process
}
proc Run::managers {tree host values} {
Run::List $tree $host $values manager
}
proc Run::admins {tree host values} {
global active_cluster
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand infobase::$values "agent admin list $host"]
set l [split $lst "&"]
foreach i $l {
set base_list [split $i ":"]
InsertItemsWorkList $base_list
}
}
proc InsertItemsWorkList {lst} {
.frm_work.tree_work insert {} end -values $lst
#.frm_work.tree_work insert val end -text [lindex $lst 1] -values [lindex $lst 1]
}
proc RunCommand {root par} {
global dir rac_cmd cluster
set pipe [open "|$rac_cmd $par" "r"]
set lst ""
while {[gets $pipe line]>=0} {
#puts "$line"
append lst "$line&"
}
close $pipe
return $lst
# fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
# fconfigure $pipe -buffering none -blocking no
}
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text "Информационные базы" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Рабочие серверы" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Администраторы" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Менеджеры кластера" -values "managers-all"
$tree insert $parent end -id "processes::$id" -text "Рабочие процессы" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Профили безопасности" -values "secureprofiles-all"
}
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
}
}
proc InsertServerstems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
}
}
proc DebugInfo {widget f} {
if {[eof $f]} {
catch [close $f] msg
if {$msg != ""} {
puts $msg
} else {
puts $msg
}
}
while {[gets $f line]>=0} {
puts "$line"
$widget insert {} end -text "$line" -values "$line"
}
}
proc Del {} {
global active_cluster host
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
puts "$key, $id , $values"
Del::$key .frm_tree.tree $host $values
}
namespace eval Del {} {
proc work_server {tree host values} {
global active_cluster
set answer [tk_messageBox -message "Удалить рабочий сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "server remove --cluster=$active_cluster --server=$values $host"]
$tree delete "work_server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc cluster {tree host values} {
set answer [tk_messageBox -message "Удалить кластер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "cluster remove --cluster=$values $host"]
$tree delete "cluster::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc infobase {tree host values} {
global active_cluster
set answer [tk_messageBox -message "Удалить информационную базу $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "infobase drop --infobase=$values --cluster=$active_cluster $host"]
$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc server {tree host values} {
global dir
set answer [tk_messageBox -message "Удалить сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
#set lst [RunCommand infobase::$values "cluster remove --cluster=$values $host"]
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
puts $line
if { $line ne "" && $line ne "$values"} {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
$tree delete "server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
file delete [file join $dir(work) 1c_srv.cfg.bak]
}
no {return}
}
}
}
proc Add {} {
global active_cluster host
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
}
puts "$key, $id , $values"
Add::$key .frm_tree.tree $host $values
}
namespace eval Add {} {
proc server {} {
global default
toplevel .add
set frm [ttk::labelframe .add.frm -text "Добавление основного сервера" -labelanchor nw]
label $frm.lbl_host -text "Адрес сервера"
entry $frm.ent_host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
#grid $frm.btn_ok -row 2 -column 1 -sticky nw -padx 5 -pady 5
#grid $frm.btn_cancel -row 2 -column 1 -sticky se -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [frame .add.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image add_grey_24 -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24
pack $frm $frm_btn -padx 5 -pady 5 -expand true -fill x
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
puts $host
}
proc work_server {tree host values} {
}
proc infobase {tree host values} {
Add::infobases $tree $host $values
}
proc infobases {tree host values} {
global default active_cluster
toplevel .add
wm title .add "Добавление информационной базы"
ttk::label .add.lbl -image add_database_grey_64
set frm [ttk::labelframe .add.frm -text "Добавление информационной базы" -labelanchor nw]
label $frm.lbl_host -text "Адрес сервера баз даннных"
entry $frm.ent_host
label $frm.lbl_db_user -text "Имя пользователя базы даннных"
entry $frm.ent_db_user
label $frm.lbl_db_pass -text "Пароль"
entry $frm.ent_db_pass
#$frm.ent_host insert end $host
label $frm.lbl_locale -text "Язык базы данных"
entry $frm.ent_locale
$frm.ent_locale insert end $default(locale)
label $frm.lbl_infobase_name -text "Имя информационной базы"
entry $frm.ent_infobase_name
label $frm.lbl_base_name -text "Имя базы данных"
entry $frm.ent_base_name
label $frm.lbl_base_type -text "Тип СУБД"
set combo [ttk::combobox $frm.cb_base_type -textvariable dbms -values $default(dbms)]]
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_db_user -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_user -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_db_pass -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_pass -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_locale -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_locale -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_infobase_name -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_infobase_name -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_base_name -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_base_name -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_base_type -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_base_type -row 6 -column 1 -sticky nsew -padx 5 -pady 5
# grid $frm.lbl_host $frm.ent_host -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_db_user $frm.ent_db_user -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_db_pass $frm.ent_db_pass -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_locale $frm.ent_locale -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_infobase_name $frm.ent_infobase_name -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_base_name $frm.ent_base_name -sticky nwse -padx 5 -pady 5
# grid $frm.lbl_base_type $frm.cb_base_type -sticky nwse -padx 5 -pady 5
#
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set active_cluster $values
set frm_btn [frame .add.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image add_grey_24 -command {
#puts [RunCommand "" "cluster insert --host=[.add.frm.ent_host get] --port=[.add.frm.ent_port get] --name=[.add.frm.ent_cluster_name get] $host"]
RunCommand "" "infobase create --create-database \
--name=[.add.frm.ent_infobase_name get] \
--dbms=$dbms \
--db-server=[.add.frm.ent_host get] \
--db-name=[.add.frm.ent_base_name get] \
--locale=[.add.frm.ent_locale get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pass get] \
--cluster=$active_cluster $host"
#SaveCluster [.add.frm.ent_host get] [.add.frm.ent_port get]]
#.frm_tree.tree insert "server::$host" end -id "er::$host" -text "$host" -values "$host"
destroy .add
#return $host
}
ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24
grid .add.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
# pack .add.lbl -side left
# pack $frm -padx 5 -pady 5 -expand true -fill x -side left
# pack $frm_btn -padx 5 -pady 5 -expand true -fill x
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
}
proc cluster {tree host values} {
global default
toplevel .add
set frm [ttk::labelframe .add.frm -text "Добавление кластера" -labelanchor nw]
label $frm.lbl_host -text "Адрес основного сервера"
entry $frm.ent_host
#$frm.ent_host insert end $host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_cluster_name -text "Название кластера"
entry $frm.ent_cluster_name
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_cluster_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_cluster_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [frame .add.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image add_grey_24 -command {
puts [RunCommand "" "cluster insert --host=[.add.frm.ent_host get] --port=[.add.frm.ent_port get] --name=[.add.frm.ent_cluster_name get] $host"]
#SaveCluster [.add.frm.ent_host get] [.add.frm.ent_port get]]
#.frm_tree.tree insert "server::$host" end -id "er::$host" -text "$host" -values "$host"
destroy .add
#return $host
}
ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24
pack $frm $frm_btn -padx 5 -pady 5 -expand true -fill x
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
puts $host
}
}
proc SaveMainServer {host port} {
global dir
set file [open [file join $dir(work) 1c_srv.cfg] "a+"]
puts $file "$host:$port"
close $file
return "$host:$port"
}