Докато се задълбочихме в темата за това как продуктите на 1C работят в средата на Linux, беше открит един недостатък - липсата на удобен графичен мултиплатформен инструмент за управление на 1C сървърен клъстер. И беше решено да се коригира този недостатък, като се напише GUI за помощната програма на конзолата rac. Езикът за разработка беше tcl/tk като според мен най-подходящ за тази задача. И сега искам да представя някои интересни аспекти на решението в този материал.
За да работите, ще ви трябва tcl / tk и 1C дистрибуции. И тъй като реших да се възползвам максимално от възможностите на основната доставка на tcl / tk, без да използвам пакети на трети страни, имаме нужда от версия 8.6.7, която включва ttk - пакет с допълнителни графични елементи, от които се нуждаем главно от ttk :: TreeView, позволява извеждане на данни както под формата на дървовидна структура, така и под формата на таблица (списък). Също така, работата с изключения е преработена в новата версия (команда try, която се използва в проекта при изпълнение на външни команди).
Проектът се състои от няколко файла (въпреки че нищо не пречи всичко да бъде едно):
rac_gui.cfg - конфигурация по подразбиране
rac_gui.tcl - основен стартиращ скрипт
Директорията lib съдържа файлове, автоматично заредени при стартиране:
function.tcl - файл с процедури
gui.tcl - основен GUI
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, ще се стартира графичен прозорец. Интерфейсът на програмата се състои от три елемента:
Лента с инструменти, дърво и списък
Направих съдържанието на "дървото" възможно най-подобно на обикновените прозорци от 1C.
Основният код, който формира този прозорец, се съдържа във файла
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Тук виждаме, че при натискане на бутона ще се изпълни процедурата „Добавяне“, кодът й е:
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Е, продължавайки с тези примери, ще покажа процедурите, които показват диалоговите прозорци за добавяне за сървър или клъстер.
Добавете :: сървър
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
}Когато сравнявам кода на тези процедури, разликата се вижда с невъоръжено око, ще се съсредоточа върху манипулатора на бутона OK. В 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 - за различни елементи за въвеждане на данни (вписване, комбинирано поле, бутон за отметка и т.н.) се въвежда такъв параметър като текстова променлива (textvariable):
entry $frm.ent_lifetime_limit -textvariable lifetime_limitТази променлива е дефинирана в глобалното пространство от имена и съдържа текущо въведената стойност. Тези. за да получите въведения текст от полето, трябва само да прочетете стойността, съответстваща на променливата (разбира се, при условие че е дефинирана при създаването на елемента).
Вторият метод за получаване на въведения текст (за елементи от тип enter) е да използвате командата 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 е част от името на дървовидния елемент, дадено от опцията -документ за самоличност.
Нека да разгледаме процедурата
стартирайте :: сървър
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 (една от няколко подобни) просто добавя списък от дъщерни елементи със съответните идентификатори към необходимия клъстерен елемент в дървото
Вмъкване на ClusterItems
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
}
}Разликата между тях е прилагането на цикъла, при който се изпълняват повтарящите се команди. Кой подход да се използва е по преценка на разработчика.
Добавянето на елементи и получаването на данни обмислихме, време е да спрем с редактирането. Тъй като по принцип се използват едни и същи параметри за редактиране и добавяне (изключение прави информационната база), диалоговите форми се използват по същия начин. Алгоритъмът за извикване на процедури за добавяне изглежда така:
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 и имената на изходните параметри на командите с известно изключение - тирето беше заменено с долна черта. напр отказване на планирани работни места съответства на полето ent_scheduled_jobs_deny и променлива планирани_задачи_отказ.
Формулярите за добавяне и редактиране могат да се различават по състава на полетата, например работа с информационна база:
Добавяне на IB
IB редакция
В процедурата за редактиране Edit::infobase задължителните полета се добавят към формуляра, така че не давам кода тук.
По аналогия се изпълняват процедури за добавяне, редактиране, изтриване и за други елементи.
Тъй като работата на помощната програма включва неограничен брой сървъри, клъстери, информационни бази и т.н., за да се определи към кой клъстер принадлежи сървър или IS, се въвеждат няколко глобални променливи, чиито стойности се задават всеки път, когато щракнете върху елементите на дървото. Тези. процедурата преминава рекурсивно през всички родителски елементи и задава променливи:
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
}
}
Cluster 1C ви позволява да работите с или без разрешение. Има два вида администратори - администратор на клъстерен агент и администратор на клъстер. Съответно за коректна работа са въведени още 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: добавена локализация на английски и руски, тествана работа в win7
Източник: www.habr.com