Yayin da muka shiga cikin batun yadda samfuran 1C ke aiki a cikin mahallin Linux, an gano koma baya ɗaya - rashin ingantaccen kayan aikin dandamali da yawa don sarrafa gungu na sabar 1C. Kuma an yanke shawarar gyara wannan koma baya ta hanyar rubuta GUI don kayan aikin wasan bidiyo. An zaɓi Tcl/tk a matsayin harshen ci gaba kamar yadda, a ganina, ya fi dacewa da wannan aikin. Don haka, Ina so in gabatar da wasu abubuwa masu ban sha'awa na mafita a cikin wannan abu.
Don aiki kuna buƙatar tcl/tk da rarrabawar 1C. Kuma tun da na yanke shawarar yin amfani da mafi yawan damar isar da tcl/tk na asali ba tare da amfani da fakiti na ɓangare na uku ba, zan buƙaci sigar 8.6.7, wanda ya haɗa da ttk - fakiti tare da ƙarin abubuwan hoto, wanda galibi muna buƙatar ttk. ::TreeView, yana ba da damar bayanan nuni duka a cikin nau'in tsarin bishiyar da kuma ta hanyar tebur (jeri). Hakanan, a cikin sabon sigar, an sake yin aikin tare da keɓancewa (umarnin gwadawa, wanda ake amfani dashi a cikin aikin yayin gudanar da umarnin waje).
Aikin ya ƙunshi fayiloli da yawa (ko da yake babu abin da zai hana ku yin komai a ɗaya):
rac_gui.cfg - tsoho saitin
rac_gui.tcl - babban rubutun ƙaddamarwa
Littafin littafin lib ya ƙunshi fayiloli waɗanda ake loda su ta atomatik a farawa:
function.tcl - fayil tare da hanyoyin
gui.tcl - babban zane mai hoto
images.tcl - base64 image library
Fayil ɗin rac_gui.tcl, a zahiri, yana farawa mai fassara, yana farawa masu canji, ɗora kayayyaki, daidaitawa, da sauransu. Abubuwan da ke cikin fayil ɗin tare da sharhi:
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"
}
}Bayan zazzage duk abin da ake buƙata kuma bincika kasancewar rac utility, za a ƙaddamar da taga mai hoto. Tsarin tsarin shirin ya ƙunshi abubuwa uku:
Toolbar, itace da jeri
Na sanya abubuwan da ke cikin "itace" kamar yadda zai yiwu da daidaitattun kayan aikin Windows daga 1C.
Babban lambar da ta samar da wannan taga yana ƙunshe a cikin fayil ɗin
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
Algorithm don aiki tare da shirin shine kamar haka:
1. Da farko, kuna buƙatar ƙara babban uwar garken cluster (watau uwar garken cluster management (a cikin Linux, ana ƙaddamar da gudanarwa tare da umurnin "/opt/1C/v8.3/x86_64/ras cluster —daemon")).
Don yin wannan, danna maɓallin "+" kuma a cikin taga da ke buɗewa, shigar da adireshin uwar garken da tashar jiragen ruwa:
Bayan haka, uwar garken namu zai bayyana a cikin bishiyar ta danna kan shi, jerin gungu zai buɗe ko kuma a nuna kuskuren haɗin gwiwa.
2. Danna sunan cluster zai buɗe jerin ayyuka da ake da su.
3.…
Da sauransu, i.e. don ƙara sabon gungu, zaɓi kowane ɗaya da ke cikin jerin kuma danna maɓallin "+" a cikin kayan aiki kuma ƙara sabon maganganu za a nuna:
Maɓallan da ke cikin mashaya kayan aiki suna yin ayyuka dangane da mahallin, watau. Dangane da abin da aka zaɓa na bishiyar ko jeri, za a yi ɗaya ko wata hanya.
Bari mu kalli misalin maɓallin ƙara ("+"):
Lambar tsara maɓalli:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Anan mun ga cewa lokacin da aka danna maɓallin, za a aiwatar da hanyar "Ƙara", lambar sa:
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
}Anan ga ɗaya daga cikin fa'idodin tickle: zaku iya ƙaddamar da ƙimar canji azaman sunan hanya:
Add::$key .frm_tree.tree $host $valuesWato, alal misali, idan muka nuna babban uwar garken kuma danna “+”, to, za a ƙaddamar da tsarin Add:: uwar garken, idan a cluster - Add:: cluster da sauransu (Zan rubuta game da inda “maɓallai” masu mahimmanci sun zo daga ɗan ƙasa), hanyoyin da aka jera suna zana abubuwan da suka dace da mahallin.
Kamar yadda ka riga ka lura, siffofin suna kama da salon - wannan ba abin mamaki ba ne, saboda ana nuna su ta hanyar hanya ɗaya, mafi daidai daidai da babban tsarin tsari (taga, maɓalli, hoto, lakabin), sunan hanyar. ƘaraTopLevel
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
}
Sigar kira: take, sunan hoton gunkin daga ɗakin karatu (lib/images.tcl) da sigar sunan taga na zaɓi (tsoho .add). Don haka, idan muka ɗauki misalan da ke sama don ƙara babban uwar garken da tari, kiran zai kasance kamar haka:
AddToplevel "Добавление основного сервера" server_grey_64ko
AddToplevel "Добавление кластера" cluster_grey_64Da kyau, ci gaba da waɗannan misalan, zan nuna hanyoyin da ke nuna ƙara maganganu don sabar ko tari.
Ƙara:: uwar garken
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
}Ƙara:: tari
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
}Lokacin kwatanta lambar waɗannan hanyoyin, bambancin yana bayyane ga ido tsirara; Zan mai da hankali kan mai sarrafa maɓallin “Ok”. A cikin Tk, ana iya soke kaddarorin abubuwa masu hoto yayin aiwatar da shirin ta amfani da zaɓi saita. Misali, umarnin farko don nuna maɓallin:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }Amma a cikin siffofin mu, umarnin ya dogara da aikin da ake buƙata:
.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
}
A cikin misalin da ke sama, maɓallin “kulle” yana fara tsarin ƙara tari.
Anan yana da daraja yin digression don yin aiki tare da abubuwa masu hoto a cikin Tk - don abubuwan shigar da bayanai daban-daban (shigarwa, akwatin haɗawa, maɓalli, da sauransu) an gabatar da siga azaman madaidaicin rubutu:
entry $frm.ent_lifetime_limit -textvariable lifetime_limitAn bayyana wannan madaidaicin a cikin sararin suna na duniya kuma ya ƙunshi ƙimar da aka shigar a halin yanzu. Wadancan. Domin samun rubutun da aka shigar daga filin, kawai kuna buƙatar karanta ƙimar da ta dace da ma'auni (tabbas, idan an bayyana shi lokacin ƙirƙirar kashi).
Hanya ta biyu don dawo da rubutun da aka shigar (na nau'in nau'in shigarwa) shine amfani da umarnin samun:
.add.frm.ent_name getAna iya ganin waɗannan hanyoyin guda biyu a cikin lambar da ke sama.
Danna wannan maɓallin, a wannan yanayin, yana ƙaddamar da hanyar RunCommand tare da layin umarni da aka samar don ƙara gungu dangane da 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:1545Yanzu mun zo ga babban umarni, wanda ke sarrafa ƙaddamar da rac tare da sigogin da muke buƙata, kuma yana rarraba fitar da umarni cikin jeri da dawowa, idan an buƙata:
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 ""
}
}Bayan shigar da babban bayanan uwar garken, za a ƙara shi zuwa itacen, don wannan, a cikin hanyar Add: uwar garken da ke sama, lambar mai zuwa tana da alhakin:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Yanzu, ta danna sunan uwar garken da ke cikin bishiyar, muna samun jerin gungu waɗanda uwar garken ke sarrafa, kuma ta danna gungu, muna samun jerin abubuwan cluster (sabar, infobases, da sauransu). Ana aiwatar da wannan a cikin hanyar TreePress (fayil 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
}Saboda haka, Run :: uwar garken za a ƙaddamar da babban uwar garken (don cluster - Run :: cluster, don uwar garken aiki - Run :: work_server, da dai sauransu). Wadancan. darajar maɓalli na $ shine ɓangare na sunan ɓangaren bishiyar da aka ƙayyade ta zaɓi -n.
Bari mu kula da hanya
Run:: uwar garken
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
}
}Wannan hanya tana aiwatar da abin da aka karɓa daga uwar garken ta hanyar umarnin RunCommand kuma yana ƙara kowane nau'in abubuwa zuwa itace - gungu, abubuwan tushen daban-daban (tushen, sabar aiki, zaman, da sauransu). Idan kun duba da kyau, zaku lura da kira zuwa tsarin InsertItemsWorkList a ciki. Ana amfani da shi don ƙara abubuwa zuwa lissafin zane ta hanyar sarrafa kayan aikin rac console, wanda a baya aka dawo dashi azaman jeri zuwa madaidaicin $lst. Wannan jerin jeri ne masu ƙunshe da nau'i-nau'i na abubuwa da hanji ya rabu.
Misali, jerin hanyoyin haɗin kai:
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
A cikin hoto mai hoto zai yi kama da wani abu kamar haka:
Hanyar da ke sama tana zaɓar sunayen abubuwa don taken da bayanai don cika tebur:
Saka AbubuwanAikiList
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
}Anan, maimakon umarni mai sauƙi [raba $str ":"], wanda ke raba kirtani zuwa abubuwan da aka raba da ":" kuma ya dawo da jeri, ana amfani da furci na yau da kullum, tun da wasu abubuwa kuma suna ɗauke da hanji.
Hanyar InsertClusterItems (ɗayan ɗaya daga cikin ire-iren ire-iren su) kawai yana ƙara jerin abubuwan yara tare da masu gano daidai ga bishiyar abubuwan da ake buƙata ta gungu.
SakaClusterAbubuwa
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
}
Kuna iya la'akari da ƙarin zaɓuɓɓuka guda biyu don aiwatar da irin wannan hanya, inda za'a iya gani a sarari yadda zaku iya ingantawa da kawar da maimaita umarni:
A cikin wannan hanya, ƙarawa da dubawa ana warware gaba-gaba:
SakaBase Items
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"
}
}
Ga ingantacciyar hanya:
Saka Bayanan Bayani
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
}
}Bambance-bambancen da ke tsakanin su shine amfani da madauki, wanda ake aiwatar da maimaita umarnin (s). Wace hanya za a yi amfani da ita bisa ga ra'ayin mai haɓakawa.
Mun rufe ƙara abubuwa da dawo da bayanai, yanzu lokaci ya yi da za a mai da hankali kan gyarawa. Tunda, a zahiri, ana amfani da sigogi iri ɗaya don gyarawa da ƙarawa (banda tushen bayanan), ana amfani da nau'ikan maganganu iri ɗaya. Algorithm don hanyoyin kira don ƙara yayi kama da haka:
Ƙara ::$key-> ƘaraToplevel
Kuma ga editan kamar haka:
Shirya::$key->Ƙara::$key->AddTopLevel
Misali, bari mu dauki gyara gungu, watau. Bayan danna sunan gungu a cikin bishiyar, danna maɓallin gyarawa a cikin kayan aiki (fensir) kuma za a nuna nau'i mai dacewa akan allon:
Gyara:: tari
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
}
}Dangane da sharhin da ke cikin lambar, bisa ƙa'ida, komai a bayyane yake, sai dai cewa lambar mai sarrafa maɓalli an soke shi kuma akwai hanyar FormFieldsDataInsert wanda ke cike filayen da bayanai kuma ya fara canza masu canji:
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
}
}
}
}
}
A cikin wannan hanya, wani fa'ida na tcl ya fito - ana canza dabi'un wasu masu canji a matsayin sunaye masu canzawa. Wadancan. Don sarrafa kayan aikin da kuma fara masu canji, sunayen filaye da kuma masu canji sun yi daidai da layin RAC da kuma sunayen bayanan fitarwa tare da wasu abubuwan fitarwa - an maye gurbinsu da ba a taɓa ɗaukar hoto ba. Misali shirye-shiryen aikin- ƙaryatãwa yayi daidai da filin ent_wanda aka tsara_aiki_ ƙaryatãwa da m hana aikin_yi.
Forms don ƙarawa da gyarawa na iya bambanta a cikin abun da ke cikin filayen, misali, aiki tare da tushen bayanai:
Ƙara tsaro na bayanai
Tsaron bayanan gyara
A cikin hanyar gyara Edit :: infobase, ana ƙara filayen da ake buƙata zuwa fom; lambar tana da girma, don haka ban gabatar da shi anan ba.
Ta hanyar misali, ana aiwatar da hanyoyin ƙarawa, gyarawa, sharewa don wasu abubuwa.
Tun da aikin mai amfani yana nuna adadin sabar mara iyaka, gungu, tushen bayanai, da sauransu, don sanin wane gungu ne na uwar garken ko tsarin tsaro na bayanai, an gabatar da masu canji da yawa na duniya, waɗanda aka saita ƙimar kowannensu. lokacin da ka danna abubuwan da ke cikin itacen. Wadancan. Hanyar tana gudana akai-akai ta duk abubuwan iyaye kuma tana saita masu canji:
SaitaGlobalVarFromTreeItems
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
}
}
Tarin 1C yana ba ku damar aiki tare da ko ba tare da izini ba. Akwai nau'ikan masu gudanarwa guda biyu - mai kula da wakilai na cluster da mai kula da tari. Saboda haka, don aiki daidai, an gabatar da ƙarin masu canji na duniya guda 4 waɗanda ke ɗauke da login mai gudanarwa da kalmar sirri. Wadancan. idan akwai asusun gudanarwa a cikin cluster, za a nuna maganganu don shigar da shiga da kalmar sirri, za a adana bayanan a cikin ƙwaƙwalwar ajiya kuma a saka cikin kowane umarni don gungu mai dacewa.
Wannan shine alhakin tsarin tafiyar da kuskure.
KuskureParcing
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"
}
}
}Wadancan. dangane da abin da umarnin ya dawo, martani zai kasance daidai.
A halin yanzu, an aiwatar da kusan kashi 95 na ayyukan, duk abin da ya rage shine aiwatar da aiki tare da bayanan martaba da gwada shi =). Shi ke nan. Ina neman afuwar muguwar labarin.
Lambar tana samuwa a al'ada .
Sabuntawa: Na gama aiki tare da bayanan martaba. Yanzu an aiwatar da aikin 100%.
Sabuntawa na 2: an ƙara ganowa cikin Ingilishi da Rashanci, an gwada aikin win7
source: www.habr.com