Док смо улазили у тему како 1Ц производи функционишу у Линук окружењу, откривен је један недостатак - недостатак згодног графичког алата за више платформи за управљање кластером 1Ц сервера. И одлучено је да се овај недостатак исправи писањем ГУИ-а за услужни програм рац конзоле. Тцл/тк је изабран као развојни језик као, по мом мишљењу, најпогоднији за овај задатак. И тако, желео бих да представим неке занимљиве аспекте решења у овом материјалу.
За рад ће вам требати тцл/тк и 1Ц дистрибуције. А пошто сам одлучио да максимално искористим могућности основне тцл/тк испоруке без коришћења пакета треће стране, биће ми потребна верзија 8.6.7, која укључује ттк – пакет са додатним графичким елементима, од којих нам је углавном потребан ттк ::ТрееВиев, омогућава приказ података како у облику структуре стабла тако и у облику табеле (листе). Такође, у новој верзији је прерађен рад са изузецима (команда три, која се користи у пројекту приликом покретања спољних команди).
Пројекат се састоји од неколико датотека (иако вас ништа не спречава да урадите све у једном):
рац_гуи.цфг - подразумевана конфигурација
рац_гуи.тцл - главна скрипта за покретање
Либ директоријум садржи датотеке које се аутоматски учитавају при покретању:
фунцтион.тцл - датотека са процедурама
гуи.тцл - главни графички интерфејс
имагес.тцл - басе64 библиотека слика
Датотека рац_гуи.тцл, у ствари, покреће интерпретер, иницијализује променљиве, учитава модуле, конфигурације итд. Садржај датотеке са коментарима:
рац_гуи.тцл
#!/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"
}
}Након што преузмете све што је потребно и проверите присуство рац услужног програма, отвориће се графички прозор. Интерфејс програма се састоји од три елемента:
Трака са алаткама, дрво и листа
Учинио сам садржај „дрвета“ што сличнијим стандардној Виндовс опреми из 1Ц.
Главни код који формира овај прозор се налази у датотеци
либ/гуи.тцл
# установка размера и положения основного окна
# можно установить в переменную 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. Прво, потребно је да додате главни сервер кластера (тј. сервер за управљање кластерима (у Линуку управљање се покреће командом „/опт/1Ц/в8.3/к86_64/рас цлустер —даемон“)).
Да бисте то урадили, кликните на дугме „+“ и у прозору који се отвори унесите адресу сервера и порт:
Након тога, наш сервер ће се појавити у стаблу кликом на њега, отвориће се листа кластера или ће се приказати грешка везе.
2. Кликом на име кластера отвориће се листа функција које су му доступне.
3. ...
И тако даље, тј. да бисте додали нови кластер, изаберите било који доступан на листи и притисните дугме „+“ на траци са алаткама и биће приказан дијалог за додавање новог:
Дугмад на траци са алаткама обављају функције у зависности од контекста, тј. У зависности од тога који елемент стабла или листе је изабран, извршиће се једна или друга процедура.
Погледајмо пример дугмета за додавање („+“):
Код за генерисање дугмета:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Овде видимо да када се притисне дугме, биће извршена процедура „Додај“, њен код:
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То је, на пример, ако покажемо на главни сервер и притиснемо „+“, тада ће се покренути процедура Адд::сервер, ако је на кластеру - Адд::цлустер и тако даље (писаћу где је неопходни „кључеви“ долазе мало испод), наведене процедуре цртају графичке елементе који одговарају контексту.
Као што сте можда већ приметили, обрасци су слични по стилу - то није изненађујуће, јер их приказује једна процедура, тачније главни оквир форме (прозор, дугмад, слика, ознака), назив процедуре АддТопЛевел
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
}
Параметри позива: наслов, име слике за икону из библиотеке (либ/имагес.тцл) и опциони параметар имена прозора (подразумевано .адд). Дакле, ако узмемо горње примере за додавање главног сервера и кластера, позив ће бити у складу са тим:
AddToplevel "Добавление основного сервера" server_grey_64или
AddToplevel "Добавление кластера" cluster_grey_64Па, настављајући са овим примерима, показаћу процедуре које приказују дијалоге за додавање за сервер или кластер.
Додај::сервер
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
}Додај::кластер
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
}Када упоредимо шифре ових процедура, разлика је видљива голим оком; фокусираћу се на руковалац дугмета „Ок“. У Тк, својства графичких елемената могу се заменити током извршавања програма помоћу опције конфигурисати. На пример, почетна команда за приказ дугмета:
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
}
У горњем примеру, дугме „зачепљено“ покреће процедуру за додавање кластера.
Овде вреди направити дигресију ка раду са графичким елементима у Тк - за различите елементе уноса података (унос, комбобокс, дугме за потврду, итд.) уведен је параметар као текстуална променљива:
entry $frm.ent_lifetime_limit -textvariable lifetime_limitОва променљива је дефинисана у глобалном именском простору и садржи тренутно унету вредност. Оне. да бисте из поља добили унети текст, потребно је само да прочитате вредност која одговара променљивој (наравно, под условом да је дефинисана приликом креирања елемента).
Други метод за преузимање унетог текста (за елементе типа уноса) је коришћење команде гет:
.add.frm.ent_name getОбе ове методе се могу видети у горњем коду.
Кликом на ово дугме, у овом случају, покреће се процедура РунЦомманд са генерисаном командном линијом за додавање кластера у смислу рац:
/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Сада долазимо до главне команде, која контролише покретање рац-а са параметрима који су нам потребни, такође анализира излаз команди у листе и враћа, ако је потребно:
РунЦомманд
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 ""
}
}Након уноса главних података сервера, биће додат у стабло, за то је у горњој Адд:сервер процедури одговоран следећи код:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Сада кликом на име сервера у стаблу добијамо листу кластера којима тај сервер управља, а кликом на кластер добијамо листу елемената кластера (сервери, инфобазе итд.). Ово је имплементирано у ТрееПресс процедури (датотека либ/фунцтион.тцл):
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
}Сходно томе, Рун::сервер ће бити покренут за главни сервер (за кластер - Рун::цлустер, за радни сервер - Рун::ворк_сервер, итд.). Оне. вредност променљиве $кеи је део имена елемента стабла наведеног опцијом -ид.
Обратимо пажњу на процедуру
Покрени::сервер
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
}
}Ова процедура обрађује оно што је примљено од сервера преко команде РунЦомманд и додаје све врсте ствари у стабло - кластере, разне коренске елементе (базе, радни сервери, сесије итд.). Ако пажљиво погледате, приметићете позив на процедуру ИнсертИтемсВоркЛист унутра. Користи се за додавање елемената графичкој листи обрадом излаза услужног програма конзоле рац, који је претходно враћен као листа у променљиву $лст. Ово је листа листа које садрже парове елемената раздвојених двотачком.
На пример, листа веза кластера:
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
У графичком облику то ће изгледати отприлике овако:
Горња процедура бира имена елемената за заглавље и податке за попуњавање табеле:
ИнсертИтемсВоркЛист
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
}Овде, уместо једноставне команде [сплит $стр ":"], која дели стринг на елементе одвојене са ":" и враћа листу, користи се регуларни израз, пошто неки елементи такође садрже двотачку.
Процедура ИнсертЦлустерИтемс (једна од неколико сличних) једноставно додаје листу подређених елемената са одговарајућим идентификаторима стаблу потребног елемента кластера
ИнсертЦлустерИтемс
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
}
Можете размотрити још две опције за имплементацију сличне процедуре, где ће бити јасно видљиво како можете оптимизовати и ослободити се команди које се понављају:
У овој процедури, додавање и провера се решавају директно:
ИнсертБасеИтемс
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 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
}
}Разлика између њих је употреба петље, у којој се извршавају поновљене команде. Који приступ користити је на дискрецији програмера.
Покрили смо додавање елемената и преузимање података, сада је време да се фокусирамо на уређивање. Пошто се, у основи, за уређивање и додавање користе исти параметри (са изузетком базе информација), користе се исте форме дијалога. Алгоритам за позивање процедура за додавање изгледа овако:
Адд::$кеи->АддТоплевел
А за овако уређивање:
Уреди::$кеи->Адд::$кеи->АддТопЛевел
На пример, узмимо уређивање кластера, тј. Након што кликнете на име кластера у стаблу, притисните дугме за уређивање на траци са алаткама (оловка) и на екрану ће се приказати одговарајући образац:
Едит::цлустер
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
}
}На основу коментара у коду, у принципу, све је јасно, осим што је код руковаоца дугмади замењен и постоји ФормФиелдсДатаИнсерт процедура која попуњава поља подацима и иницијализује променљиве:
ФормФиелдсДатаИнсерт
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
}
}
}
}
}
У овој процедури испливала је још једна предност тцл-а - вредности других променљивих се замењују као имена променљивих. Оне. за аутоматизацију попуњавања образаца и иницијализације променљивих, имена поља и променљивих одговарају прекидачима командне линије услужног програма рац и називима излазних параметара команде са неким изузетком - цртица је замењена доњом цртом. На пример заказани послови-одбијање одговара пољу ент_сцхедулед_јобс_дени и променљива заказани_јобс_дени.
Обрасци за додавање и уређивање могу се разликовати у саставу поља, на пример, рад са базом информација:
Додавање безбедности информација
Уређивање безбедности информација
У процедури уређивања Едит::инфобасе, у формулар се додају обавезна поља, код је обимни, па га овде не представљам.
По аналогији, процедуре за додавање, уређивање, брисање су имплементиране за остале елементе.
Пошто рад услужног програма подразумева неограничен број сервера, кластера, информационих база итд., да би се утврдило који кластер припада ком серверу или систему безбедности информација, уведено је неколико глобалних варијабли чије се вредности постављају за сваку када кликнете на елементе дрвета. Оне. процедура рекурзивно пролази кроз све родитељске елементе и поставља променљиве:
СетГлобалВарФромТрееИтемс
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 глобалне варијабле које садрже администраторски логин и лозинку. Оне. ако у кластеру постоји администраторски налог, приказаће се дијалог за унос ваше пријаве и лозинке, подаци ће бити сачувани у меморији и уметнути у сваку команду за одговарајући кластер.
Ово је одговорност процедуре руковања грешком.
ЕррорПарцинг
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: додата је локализација на енглески и руски, рад у вин7 је тестиран
Извор: ввв.хабр.цом