Па меры ўнікання ў тэму працы 1С-аўскіх прадуктаў у асяроддзі linux, выявіўся адзін недахоп – адсутнасць зручнай графічнай мультыплатформеннай прылады для кіравання кластарам сервераў 1С. І вырашана было гэты недахоп выправіць, шляхам напісання GUI для кансольнай утыліты rac. Мовай для распрацоўкі быў абраны tcl/tk як, на мой погляд, найболей падыходны для гэтай задачы. І вось, некаторыя цікавыя аспекты рашэння жадаю прадставіць у дадзеным матэрыяле.
Для працы спатрэбяцца дыстрыбутывы tcl/tk і 1С. А бо я вырашыў максімальна выкарыстаць магчымасці базавай пастаўкі tcl/tk без ужывання іншых пакетаў, то спатрэбіцца версія 8.6.7, куды ўваходзіць ttk — пакет з дадатковымі графічнымі элементамі, з якіх нам запатрабуецца, у асноўным, ttk::TreeView, ён дазваляе выводзіць дадзеныя як у выглядзе дрэвападобнай структуры так і ў выглядзе табліцы (спісу). Яшчэ, у новай версіі перароблена праца з выключэннямі (каманда try, якая ў праекце выкарыстоўваецца пры запуску вонкавых каманд).
Праект складаецца з некалькіх файлаў (хоць нічога не мяшае ўсё зрабіць адным):
rac_gui.cfg - дэфолтны канфіг
rac_gui.tcl - асноўны скрыпт запуску
У каталогу lib ляжаць файлы, якія аўтаматычна загружаюцца пры старце:
function.tcl - файл з працэдурамі
gui.tcl - асноўны графічны інтэрфейс
images.tcl — бібліятэка выяў у base64
Файл rac_gui.tcl, уласна, запускае інтэрпрэтатар, ініцыялізуе зменныя, загружае модулі, канфігі і гэтак далей. Змесціва файла з каментарамі:
rac_gui.tcl
#!/bin/sh
exec wish "$0" -- "$@"
# Устанавливаем текущий каталог
set dir(root) [pwd]
# Устанавливаем рабочий каталог, если его нет то создаём
set dir(work) [file join $env(HOME) .rac_gui]
if {[file exists $dir(work)] == 0 } {
file mkdir $dir(work)
}
# каталог с модулями
set dir(lib) "[file join $dir(root) lib]"
# загружаем пользовательский конфиг, если он отсутствует, то копируем дефолтный
if {[file exists [file join $dir(work) rac_gui.cfg]] ==0} {
file copy [file join [pwd] rac_gui.cfg] [file join $dir(work) rac_gui.cfg]
}
source [file join $dir(work) rac_gui.cfg]
# Код проверки наличия rac и правильности указания пути в конфиге
# если программа не найдена то будет выведен диалог для указания корректного пути
# и этот путь будет записан в пользовательский конфиг
if {[file exists $rac_cmd] == 0} {
set rac_cmd [tk_getOpenFile -initialdir $env(HOME) -parent . -title "Укажите путь до rac" -initialfile rac]
file copy [file join $dir(work) rac_gui.cfg] [file join $dir(work) rac_gui.cfg.bak]
set orig_file [open [file join $dir(work) rac_gui.cfg.bak] "r"]
set file [open [file join $dir(work) rac_gui.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if {[string match "set rac_cmd*" $line]} {
puts $file "set rac_cmd $rac_cmd"
} else {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
file delete [file join $dir(work) 1c_srv.cfg.bak]
} else {
puts "Found $rac_cmd"
}
set cluster_user ""
set cluster_pwd ""
set agent_user ""
set agent_pwd ""
## LOAD FILE ##
# Загружаем модули кроме gui.tcl так как его надо загрузить последним
foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
if {[file tail $modFile] ne "gui.tcl"} {
source $modFile
puts "Loaded module $modFile"
}
}
source [file join $dir(lib) gui.tcl]
source [file join $dir(work) rac_gui.cfg]
# Читаем файл со списком серверов 1С
# и добавляем в дерево
if [file exists [file join $dir(work) 1c_srv.cfg]] {
set f [open [file join $dir(work) 1c_srv.cfg] "RDONLY"]
while {[gets $f line] >=0} {
.frm_tree.tree insert {} end -id "server::$line" -text "$line" -values "$line"
}
}Пасля загрузкі за ўсё, што патрабуецца і праверкі наяўнасці ўтыліты rac, будзе запушчана графічнае акно. Інтэрфейс праграмы складаецца з трох элементаў:
Панэль інструментаў, дрэва і спіс
Змесціва «дрэва» я зрабіў максімальна падобным на штатнае windows-абсталяванне ад 1С.
Асноўны код які фармуе дадзенае акно змяшчаецца ў файле
lib/gui.tcl
# установка размера и положения основного окна
# можно установить в переменную topLevelGeometry в конфиг программы
if {[info exists topLevelGeometry]} {
wm geometry . $topLevelGeometry
} else {
wm geometry . 1024x768
}
# Заголовок окна
wm title . "1C Rac GUI"
wm iconname . "1C Rac Gui"
# иконка окна (берется из файла lib/imges.tcl)
wm iconphoto . tcl
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user
ttk::style theme use clam
# Панель инсрументов
set frm_tool [frame .frm_tool]
pack $frm_tool -side left -fill y
ttk::panedwindow .panel -orient horizontal -style TPanedwindow
pack .panel -expand true -fill both
pack propagate .panel false
ttk::button $frm_tool.btn_add -command Add -image add_grey_32
ttk::button $frm_tool.btn_del -command Del -image del_grey_32
ttk::button $frm_tool.btn_edit -command Edit -image edit_grey_32
ttk::button $frm_tool.btn_quit -command Quit -image quit_grey_32
pack $frm_tool.btn_add $frm_tool.btn_del $frm_tool.btn_edit -side top -padx 5 -pady 5
pack $frm_tool.btn_quit -side bottom -padx 5 -pady 5
# Дерево с полосами прокрутки
set frm_tree [frame .frm_tree]
ttk::scrollbar $frm_tree.hsb1 -orient horizontal -command [list $frm_tree.tree xview]
ttk::scrollbar $frm_tree.vsb1 -orient vertical -command [list $frm_tree.tree yview]
set tree [ttk::treeview $frm_tree.tree -show tree
-xscrollcommand [list $frm_tree.hsb1 set] -yscrollcommand [list $frm_tree.vsb1 set]]
grid $tree -row 0 -column 0 -sticky nsew
grid $frm_tree.vsb1 -row 0 -column 1 -sticky nsew
grid $frm_tree.hsb1 -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_tree 0 -weight 1
grid rowconfigure $frm_tree 0 -weight 1
# назначение обработчика нажатия кнопкой мыши
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"
# Список для данных (таблица)
set frm_work [frame .frm_work]
ttk::scrollbar $frm_work.hsb -orient horizontal -command [list $frm_work.tree_work xview]
ttk::scrollbar $frm_work.vsb -orient vertical -command [list $frm_work.tree_work yview]
set tree_work [
ttk::treeview $frm_work.tree_work
-show headings -columns "par val" -displaycolumns "par val"
-xscrollcommand [list $frm_work.hsb set]
-yscrollcommand [list $frm_work.vsb set]
]
# Установка цветов для чередования в таблице
$tree_work tag configure dark -background $color(dark_table_bg)
$tree_work tag configure light -background $color(light_table_bg)
# Размещение элементов на форме
grid $tree_work -row 0 -column 0 -sticky nsew
grid $frm_work.vsb -row 0 -column 1 -sticky nsew
grid $frm_work.hsb -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_work 0 -weight 1
grid rowconfigure $frm_work 0 -weight 1
pack $frm_tree $frm_work -side left -expand true -fill both
#.panel add $frm_tool -weight 1
.panel add $frm_tree -weight 1
.panel add $frm_work -weight 1
Алгарытм працы з праграмай наступны:
1. У пачатку, трэба дадаць асноўны сервер кластара (г.зн. сервер кіравання кластарам (у linux кіраванне запускаецца камандай "/opt/1C/v8.3/x86_64/ras cluster -daemon")).
Для гэтага цісне на кнопку «+» і ў якое адкрылася акне, уводны адрас сервера і порт:
Пасля, у дрэве з'явіцца наш сервер па пстрычцы на якім, адкрыецца спіс кластараў альбо будзе выведзена памылка злучэння.
2. Пстрыкнуўшы на імя кластара адкрыецца спіс функцый даступны для яго.
3. ...
Ну і гэтак далей, г.зн. каб дадаць новы кластар, вылучаем любы даступны ў спісе і націскаем кнопку "+" у панэлі інструментаў і будзе выведзены дыялог дадання новага:
Кнопкі ў панэлі прылад выконваюць функцыі ў залежнасці ад кантэксту, г.зн. ад таго які элемент дрэва або спісу абраны, будзе выканана тая ці іншая працэдура.
Разгледзім на прыкладзе кнопкі дадання («+»):
Код фармавання кнопкі:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Тут бачым, што пры націску кнопкі будзе выканана працэдура "Add", яе код:
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 ]
return
}
Add::$key .frm_tree.tree $host $values
}Вось і праглядае адзін з плюсаў цікля - у якасці імя працэдуры можна перадаць значэнне зменнай:
Add::$key .frm_tree.tree $host $valuesГ.зн., да прыкладу, калі мы ткнем у асноўны сервер і націснем "+" то будзе запушчана працэдура Add::server, калі ў кластар - Add::cluster і гэтак далей (пра тое адкуль бяруцца патрэбныя "ключы" напішу ледзь ніжэй), пералічаныя працэдуры адмалёўваюць графічныя элементы адпаведныя кантэксту.
Як вы ўжо маглі заўважыць, формы падобныя па стылі - гэта і не дзіўна, бо яны выводзяцца адной працэдурай, дакладней асноўны каркас формы (акно, кнопкі, малюнак, пазнака), назва працэдуры AddTopLevel
proc AddToplevel {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name $lbl
wm iconphoto $win_name tcl
# метка с иконкой
ttk::label $win_name.lbl -image $img
# фрейм с полями ввода
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
# фрейм и кнопки
set frm_btn [frame $win_name.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $win_name.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 $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
return $frm
}
Параметры выкліку: загаловак, назва выявы для абразка з бібліятэкі (lib/images.tcl) і апцыянальны параметр імя акна (па змаўчанні .add). Такім чынам, калі браць вышэйпрыведзеныя прыклады для дадання асноўнага сервера і кластара, то выклік будзе адпаведна:
AddToplevel "Добавление основного сервера" server_grey_64або
AddToplevel "Добавление кластера" cluster_grey_64Ну і працягнуўшы з гэтым прыкладамі пакажу працэдуры, якія выводзяць дыялогі дадання для сервера ці кластара.
Add::server
proc Add::server {} {
global default
# выводим основную форму
set frm [AddToplevel "Добавление основного сервера" server_grey_64]
# добавляем етки и поля ввода на эту форму
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 columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
# переопределяем обработчик нажатия кнопки
.add.frm_btn.btn_ok configure -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
}
return $frm
}Add::cluster
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
# устанавливаем глобальные переменные ()
set lifetime_limit $default(lifetime_limit)
set expiration_timeout $default(expiration_timeout)
set session_fault_tolerance_level $default(session_fault_tolerance_level)
set max_memory_size $default(max_memory_size)
set max_memory_time_limit $default(max_memory_time_limit)
set errors_count_threshold $default(errors_count_threshold)
set security_level [lindex $default(security_level) 0]
set load_balancing_mode [lindex $default(load_balancing_mode) 0]
set frm [AddToplevel "Добавление кластера" cluster_grey_64]
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)
label $frm.lbl_name -text "Название кластера"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Защищённое соединение"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Рабочие процессы:"
label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
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_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
# переопределяем обработчик
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster insert
--host=[.add.frm.ent_host get]
--port=[.add.frm.ent_port get]
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
return $frm
}Пры параўнанні кода гэтых працэдур, розніца бачная не ўзброеным вокам, увага завастру на апрацоўшчыку кнопкі «Ок». У Tk уласцівасці графічных элементаў можна перавызначаць падчас выканання праграмы пры дапамозе опцыі. канфігураваць. Напрыклад, першапачатковая каманда вываду кнопкі:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }Але а ў нашых формах каманда залежыць ад патрабаванай функцыянальнасці:
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster insert
--host=[.add.frm.ent_host get]
--port=[.add.frm.ent_port get]
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
У прыведзеным вышэй прыкладзе на кнопку "забіты" запуск працэдуры дадання кластара.
Тут варта зрабіць адступленне ў бок працы з графічнымі элементамі ў Tk - для розных элементаў уводу дадзеных (entry, combobox, checkbutton і г.д.) уведзены такі параметр як тэкставая пераменная (textvariable):
entry $frm.ent_lifetime_limit -textvariable lifetime_limitГэтая зменная вызначана ў глабальнай прасторы імёнаў і змяшчае бягучае ўведзенае значэнне. Г.зн. каб атрымаць уведзены тэкст з поля трэба проста лічыць значэнне, якая адпавядае зменнай (вядома пры ўмове, што яна вызначана пры стварэнні элемента).
Другі метад атрымання ўведзенага тэксту (для элементаў тыпу entry) - гэта выкарыстанне каманды get:
.add.frm.ent_name getАбодва гэтыя метады можна ўбачыць у вышэйпрыведзеным кодзе.
Націск гэтай кнопкі, у дадзеным выпадку, запускае працэдуру RunCommand са сфармаваным радком каманды дадання кластара ў тэрмінах rac:
/opt/1C/v8.3/x86_64/rac cluster insert --host=localhost --port=1540 --name=dsdsds --expiration-timeout=0 --lifetime-limit=0 --max-memory-size=0 --max-memory-time-limit=0 --security-level=0 --session-fault-tolerance-level=0 --load-balancing-mode=performance --errors-count-threshold=0 --kill-problem-processes=no localhost:1545Вось і падышлі да асноўнай каманды, якая і кіруе запускам rac з патрэбнымі нам параметрамі, таксама разбірае выснову каманд на спісы і вяртае, калі гэта патрабуецца:
RunCommand
proc RunCommand {root par} {
global dir rac_cmd cluster work_list_row_count agent_user agent_pwd cluster_user cluster_pwd
puts "$rac_cmd $par"
set work_list_row_count 0
# открываем канал в неблокирующем режиме
# $rac - команда с полным путём
# $par - сформированные ключи запуска и опции
set pipe [open "|$rac_cmd $par" "r"]
try {
set lst ""
set l ""
# вывод команды добавляем в список списков
while {[gets $pipe line]>=0} {
#puts $line
if {$line eq ""} {
lappend l $lst
set lst ""
} else {
lappend lst [string trim $line]
}
}
close $pipe
return $l
} on error {result options} {
# Запуск обработчика ошибок
ErrorParcing $result $options
return ""
}
}Пасля ўводу дадзеных асноўнага сервера ён будзе дададзены ў дрэва, за гэта, у вышэй прыведзенай працэдуры Add:server, адказвае наступны код:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Зараз пстрыкнуўшы па імі сервера ў дрэве, мы атрымаем спіс кластараў кіраваных гэтым серверам, а пстрыкнуўшы на кластары, атрымаем спіс элементаў кластара (сервераў, інфармацыйных баз і т.д.). Рэалізавана гэта ў працэдуры TreePress (файл lib/function.tcl):
proc TreePress {tree} {
global host server active_cluster infobase
# определяем выделенный элемент
set id [$tree selection]
# устанавливаем нужные глобальные переменные
SetGlobalVarFromTreeItems $tree $id
# Определяем ключ и значение, т.е. именно тип выбранного элемента
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
# и в зависимости от того что выбрали будет запущена соответствующая процедура
# в пространстве имён Run
Run::$key $tree $host $values
}Адпаведна, для асноўнага сервера запусціцца Run::server (для кластара - Run::cluster, для працоўнага сервера - Run::work_server і г.д.). Г.зн. значэнне зменнай $key гэта частка імя элемента дрэва, які задаецца опцыяй -id.
Звернем увагу на працэдуру
Run::server
proc Run::server {tree host values} {
# получаем список кластеров требуемого сервера
set lst [RunCommand server::$host "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
# удаляем лишнее из списка
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
# читаем список
foreach cluster_list $lst {
# Заполняем список полученными значениями
InsertItemsWorkList $cluster_list
# обрабатываем вывод (список) для добавления данных в дерево
foreach i $cluster_list {
#puts $i
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
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
#InsertClusterItems $tree $id
}
}Дадзеная працэдура апрацоўвае тое, што было атрымана ад сервера праз каманду RunCommand, і дадае ўсякае-рознае ў дрэва - кластары, розныя каранёвыя элементы (базы, працоўныя серверы, сеансы і гэтак далей). Калі прыгледзецца, то ўсярэдзіне можна заўважыць выклік працэдуры InsertItemsWorkList. Яна выкарыстоўваецца для дадання элементаў у графічны спіс, апрацоўваючы выснову кансольнай утыліты rac, які раней быў у выглядзе спісу вернуты ў зменную $lst. Гэта спіс спісаў, які змяшчае пары элементаў падзеленыя двукроп'ем.
Напрыклад, спіс злучэнняў кластара:
svk@svk ~]$ /opt/1C/v8.3/x86_64/rac connection list --cluster=783d2170-56c3-11e8-c586-fc75165efbb2 localhost:1545
connection : dcf5991c-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:49:51
session-number : 0
blocked-by-ls : 0
connection : b993293a-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:48:52
session-number : 0
blocked-by-ls : 0
У графічным выглядзе гэта будзе выглядаць прыкладна так:
Вышэйазначаная працэдура вылучае найменні элементаў для загалоўка і дадзеныя для запаўнення табліцы:
InsertItemsWorkList
proc InsertItemsWorkList {lst} {
global work_list_row_count
# установка чередования цвета для строки
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
}
# разбор строк на пары ключ - значение
foreach i $lst {
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
lappend column_list [string trim $param]
lappend value_list [string trim $value]
}
}
# заполнение таблицы
.frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
.frm_work.tree_work insert {} end -values $value_list -tags $tag
.frm_work.tree_work column #0 -stretch
# установка заголовков
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}Тут замест простай каманды [split $str «:»], якая разбівае радок на элементы падзеленыя «:» і вяртае спіс, ужыта рэгулярнае выраз, бо некаторыя элементы таксама ўтрымоўваюць двукроп'е.
Працэдура InsertClusterItems (адна з некалькіх падобных) проста дадае ў дрэва да патрабаванага элемента cluster спіс даччыных элементаў з адпаведнымі ідэнтыфікатарамі.
InsertClusterItems
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 $id
$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 $id
}
Можна разгледзець яшчэ два варыянты рэалізацыі падобнай працэдуры, дзе будзе наглядна відаць як можна аптымізаваць і пазбавіцца ад паўтаральных каманд:
У дадзенай працэдуры даданне і праверка вырашаны ў ілоб:
InsertBaseItems
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"
}
}
А тут падыход больш правільны:
InsertProfileItems
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{dir "Виртуальные каталоги"}
{com "Разрешённые COM-классы"}
{addin "Внешние компоненты"}
{module "Внешние отчёты и обработки"}
{app "Разрешённые приложения"}
{inet "Ресурсы интернет"}
}
foreach i $lst {
append item [lindex $i 0] "::$id"
if { [$tree exists $item] == 0 } {
$tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
}
unset item
}
}Розніца паміж імі ва ўжыванні цыклу, у якім і выконваецца паўтаральная каманда (каманды). Які падыход прымяняць - гэта ўжо на меркаванне распрацоўніка.
Даданне элементаў і атрыманне даных мы разгледзелі, самы час спыніцца на рэдагаванні. Бо, у асноўным, для рэдагавання і даданні выкарыстоўваюцца адны і тыя ж параметры (выключэнне складае інфармацыйная база), то і дыялогавыя формы выкарыстоўваюцца аднолькавыя. Алгарытм выкліку працэдур для дадання выглядае так:
Add::$key->AddToplevel
А для рэдагавання так:
Edit::$key->Add::$key->AddTopLevel
Для прыкладу возьмем рэдагаванне кластара, г.зн. пстрыкнуўшы ў дрэве на назве кластара, націскаем кнопку рэдагавання ў панэлі прылад (аловак) і на экран будзе выведзена адпаведная форма:
Edit::cluster
proc Edit::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes active_cluster
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
# рисуем форму для кластера
set frm [Add::cluster $tree $host $values]
# меняем текст на метке
$frm configure -text "Редактирование кластера"
set active_cluster $values
# получаем данные по выделенному кластеру
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
# заполняем поля
FormFieldsDataInsert $frm $lst
# выключаем поля, редактирование которых запрещено
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
# переназначаем обработчик
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster update
--cluster=$active_cluster $auth
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth $host"
$tree delete "cluster::$active_cluster"
Run::server $tree $host ""
destroy .add
}
}Па каментарах у кодзе, у прынцыпе, усё зразумела, акрамя таго, што код апрацоўшчыка кнопкі перавызначаны і прысутнічае працэдура FormFieldsDataInsert, якая запаўняе палі дадзенымі і ініцыялізуе зменныя:
FormFieldsDataInsert
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
# получаем список параметров и значений
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
# меняем символы
regsub -all -- "-" [string trim $param] "_" entry_name
# заполняем данными
if [winfo exists $frm.ent_$entry_name] {
$frm.ent_$entry_name delete 0 end
$frm.ent_$entry_name insert end [string trim $value """]
}
if [winfo exists $frm.cb_$entry_name] {
global $entry_name
set $entry_name [string trim $value """]
}
# для чекбоксов меняем значения
if [winfo exists $frm.check_$entry_name] {
global $entry_name
if {$value eq "0"} {
set $entry_name no
} elseif {$value eq "1"} {
set $entry_name yes
} else {
set $entry_name $value
}
}
}
}
}
У дадзенай працэдуры ўсплыў яшчэ адзін плюс tcl - у якасці імёнаў зменных падстаўляюцца значэнні іншых зменных. Г.зн. для аўтаматызацыі запаўнення формаў і ініцыялізацыі зменных наймення палёў і зменных, адпавядаюць ключам каманднага радка ўтыліты rac і найменням параметраў высновы каманд з некаторым выключэннем - працяжнік заменена на подчерк. Напрыклад scheduled-jobs-deny адпавядае полю ent_scheduled_jobs_deny і зменнай scheduled_jobs_deny.
Формы дадання і рэдагавання могуць адрознівацца складам палёў, напрыклад, праца з інфармацыйнай базай:
Даданне ИБ
Рэдагаванне ИБ
У працэдуры рэдагавання Edit::infobase на форму дадаюцца патрабаваныя палі, код аб'ёмны таму тут не прыводжу.
Па аналогіі рэалізаваны працэдуры дадання, рэдагаванні, выдаленні і для астатніх элементаў.
Бо праца ўтыліты мае на ўвазе неабмежаваную колькасць сервераў, кластараў, інфармацыйных баз і да т.п., то для вызначэння да якога кластара ставіцца які сервер або ИБ, уведзены некалькі глабальных зменных, значэнні якіх усталёўваюцца пры кожнай пстрычцы па элементах дрэва. Г.зн. працэдура рэкурсіўна прабягае па ўсіх бацькоўскіх элементах і выстаўляе зменныя:
SetGlobalVarFromTreeItems
proc SetGlobalVarFromTreeItems {tree id} {
global host server active_cluster infobase
set parent [$tree parent $id]
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
switch -- $key {
server {set host $values}
work_server {set server $values}
cluster {set active_cluster $values}
infobase {set infobase $values}
}
if {$parent eq ""} {
return
} else {
SetGlobalVarFromTreeItems $tree $parent
}
}
Кластар 1С дазваляе працу як з аўтарызацыяй так і без. Існуе два віды адміністратараў - адміністратар агента кластара і адміністратар кластара. Адпаведна для карэктнай працы ўведзены яшчэ 4 глабальных зменных, якія змяшчаюць лагін і пароль адміністратара. Г.зн. калі ў кластары прысутнічае ўліковы запіс адміністратара, то будзе выведзены дыялог для ўводу лагіна і пароля, дадзеныя будуць захаваны ў памяці і падставяцца ў кожную каманду для адпаведнага кластара.
За гэта адказвае працэдура апрацоўкі памылак
ErrorParcing
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Central server administrator is not authenticated" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
"Администратор кластера не аутентифицирован" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Администратор центрального сервера не аутентифицирован" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
(.+) {
tk_messageBox -type ok -icon error -message "$err"
}
}
}Г.зн. у залежнасці ад таго, што вяртае каманда, будзе адпаведна і рэакцыя.
Зараз функцыянальнасць рэалізаваная адсоткаў гэтак на 95, засталося прадаць працу з профілямі бяспекі і адтэставаць =). На гэтым усё. Прашу прабачэння за скамечанае апавяданне.
Код, па традыцыі даступны .
Абнаўленне: Дарабіў працу з профілямі бяспекі. Цяпер функцыянальнасць рэалізавана на 100 працэнтаў.
Абнаўленне 2: дададзена лакалізацыя на англійскую і рускую, праверана работа ў win7
Крыніца: habr.com