Докато се запознах с темата за работата на продуктите на 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 "Нiveau на отказоустойчивост"
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 свойствата на графичните елементи могат да бъдат преопределяни по време на изпълнението на програмата чрез опцията configure. Например, първоначалната команда за изход на бутона:
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: добавена е локализация на английски и руски, проверена е работата в Windows 7.
Източник: habr.com
