1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

1C produktuek Linux ingurunean nola funtzionatzen duten gaian sakondu ahala, eragozpen bat aurkitu zen: 1C zerbitzarien multzoa kudeatzeko plataforma anitzeko tresna grafiko eroso baten falta. Eta eragozpen hori zuzentzea erabaki zen rac kontsolaren utilitaterako GUI bat idatziz. Tcl/tk aukeratu zen garapen hizkuntza gisa, nire ustez, zeregin honetarako egokiena. Beraz, material honetan irtenbidearen alderdi interesgarri batzuk aurkeztu nahiko nituzke.

Lan egiteko tcl/tk eta 1C banaketak beharko dituzu. Eta oinarrizko tcl/tk entregaren gaitasunak hirugarrenen paketerik erabili gabe aprobetxatzea erabaki nuenez, ttk barne hartzen duen 8.6.7 bertsioa beharko dut - elementu grafiko osagarriak dituen paketea, ttk behar duguna batez ere. ::TreeView, datuak bistaratzeko aukera ematen du bai zuhaitz-egitura moduan bai taula (zerrenda) moduan. Gainera, bertsio berrian, salbuespenak dituen lana berritu egin da (try komandoa, proiektuan erabiltzen dena kanpoko komandoak exekutatzen direnean).

Proiektua hainbat fitxategiz osatuta dago (nahiz eta ezerk eragozten dizu dena bakarrean egitea):

rac_gui.cfg - konfigurazio lehenetsia
rac_gui.tcl - abiarazteko gidoia nagusia
lib direktorioak abiaraztean automatikoki kargatzen diren fitxategiak ditu:
function.tcl - prozedurak dituen fitxategia
gui.tcl - interfaze grafiko nagusia
images.tcl - base64 irudien liburutegia

rac_gui.tcl fitxategiak, hain zuzen ere, interpretea abiarazten du, aldagaiak hasieratzen ditu, moduluak, konfigurazioak eta abar kargatzen ditu. Fitxategiaren edukia iruzkinekin:

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"
    }    
}

Behar den guztia deskargatu eta rac utilitatearen presentzia egiaztatu ondoren, leiho grafiko bat irekiko da. Programaren interfazeak hiru elementu ditu:

Tresna-barra, zuhaitza eta zerrenda

"Arbolaren" edukia 1C-ko Windows ekipamendu estandarraren antzekoena egin nuen.

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Leiho hau osatzen duen kode nagusia fitxategian dago
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

Programarekin lan egiteko algoritmoa honakoa da:

1. Lehenik eta behin, kluster zerbitzari nagusia gehitu behar duzu (hau da, kluster kudeaketa zerbitzaria (Linux-en, kudeaketa "/opt/1C/v8.3/x86_64/ras cluster —daemon") komandoarekin abiarazten da).

Horretarako, egin klik “+” botoian eta irekitzen den leihoan, sartu zerbitzariaren helbidea eta ataka:

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Ondoren, gure zerbitzaria zuhaitzean agertuko da gainean klik eginez, kluster zerrenda bat irekiko da edo konexio-errore bat agertuko da.

2. Kluster izenaren gainean klik eginez gero, erabilgarri dauden funtzioen zerrenda irekiko da.

3. ...

Eta abar, hau da. kluster berri bat gehitzeko, hautatu zerrendan eskuragarri dagoen edozein eta sakatu tresna-barrako "+" botoia eta gehitu berria elkarrizketa-koadroa bistaratuko da:

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Tresna-barrako botoiek testuinguruaren araberako funtzioak betetzen dituzte, hau da. Zuhaitz edo zerrendako zein elementu hautatzen den arabera, prozedura bat edo beste egingo da.

Ikus dezagun gehitzeko botoiaren adibidea (“+”):

Botoiak sortzeko kodea:

ttk::button $frm_tool.btn_add  -command Add  -image add_grey_32

Hemen ikusten dugu botoia sakatzean, "Gehitu" prozedura exekutatuko dela, bere kodea:

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
}

Hona hemen tickle-ren abantailetako bat: aldagai baten balioa prozedura-izen gisa pasa dezakezu:

Add::$key .frm_tree.tree $host $values

Hau da, adibidez, zerbitzari nagusia seinalatzen badugu eta “+” sakatzen badugu, Gehitu::zerbitzaria prozedura abiaraziko da, klusterrean bada - Gehitu::kluster eta abar (non idatziko dut). beharrezko "gakoak" azpitik datoz), zerrendatutako prozedurek testuingururako egokiak diren elementu grafikoak marrazten dituzte.

Dagoeneko ohartuko zinen bezala, inprimakiak estiloan antzekoak dira - hori ez da harritzekoa, prozedura baten bidez bistaratzen direlako, zehazkiago inprimakiaren marko nagusia (leihoa, botoiak, irudia, etiketa), prozeduraren izena. GehituTopLevel

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
}

Dei-parametroak: izenburua, liburutegiko ikonoaren irudiaren izena (lib/images.tcl) eta aukerako leiho-izenaren parametro bat (lehenetsia .add). Horrela, zerbitzari nagusia eta clusterra gehitzeko goiko adibideak hartzen baditugu, deia horren arabera izango da:

AddToplevel "Добавление основного сервера" server_grey_64

edo

AddToplevel "Добавление кластера" cluster_grey_64

Bada, adibide hauekin jarraituz, zerbitzari edo kluster baterako gehitzeko elkarrizketa-koadroak bistaratzen dituzten prozedurak erakutsiko ditut.

Gehitu::zerbitzaria

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
}

Gehitu::kluster

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
}

Prozedura hauen kodea alderatzean, aldea begi hutsez ikusten da; "Ok" botoiaren kudeatzailean zentratuko naiz. Tk-n, elementu grafikoen propietateak programaren exekuzioan zehar gainidatzi daitezke aukera erabiliz konfiguratzeko. Adibidez, botoia bistaratzeko hasierako komandoa:

ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }

Baina gure inprimakietan, komandoa beharrezko funtzionalitatearen araberakoa da:

  .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
    }

Goiko adibidean, "clogged" botoiak kluster bat gehitzeko prozedura hasten du.

Hemen merezi du Tk-ko elementu grafikoekin lan egiteko digresio bat egitea - hainbat datu sarrerako elementuetarako (sarrera, konbinazio-koadroa, kontrol-botoia, etab.) parametro bat sartu da testu-aldagai gisa:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Aldagai hau izen-espazio globalean definituta dago eta unean sartutako balioa dauka. Horiek. sartutako testua eremutik ateratzeko, aldagaiari dagokion balioa irakurri besterik ez duzu behar (noski, elementua sortzean zehaztuta badago).

Idatzitako testua berreskuratzeko bigarren metodoa (sarrera motako elementuetarako) get komandoa erabiltzea da:

.add.frm.ent_name get

Bi metodo hauek goiko kodean ikus daitezke.

Botoi honetan klik eginez gero, kasu honetan, RunCommand prozedura abiarazten da rac-aren arabera cluster bat gehitzeko sortutako komando-lerroarekin:

/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

Orain komando nagusira iritsiko gara, rac-en abiarazte behar ditugun parametroekin kontrolatzen duena, komandoen irteera ere zerrendetan analizatzen du eta itzultzen du, behar izanez gero:

Exekutatu komandoa

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 ""
    }
}

Zerbitzariaren datu nagusiak sartu ondoren, zuhaitzean gehituko dira, horretarako, goiko Gehitu:zerbitzariaren prozeduran, honako kode hau arduratzen da:

.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"

Orain, zuhaitzean dagoen zerbitzariaren izenaren gainean klik eginez, zerbitzari horrek kudeatzen dituen klusterren zerrenda jasoko dugu, eta kluster batean klik eginez, kluster elementuen zerrenda (zerbitzariak, infobaseak, etab.). Hau TreePress prozeduran inplementatzen da (fitxategia 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
}

Horren arabera, Run::server zerbitzari nagusirako abiaraziko da (kluster baterako - Run::cluster, laneko zerbitzari baterako - Run::work_server, etab.). Horiek. $key aldagaiaren balioa aukerak zehaztutako zuhaitz-elementuaren izenaren parte da -id.

Errepara diezaiogun prozedurari

Exekutatu::zerbitzaria

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
    }
}

Prozedura honek RunCommand komandoaren bidez zerbitzaritik jasotakoa prozesatzen du eta mota guztietako gauzak gehitzen dizkio zuhaitzari: klusterrak, hainbat erro-elementu (oinarriak, lan-zerbitzariak, saioak eta abar). Arreta begiratuz gero, barruan InsertItemsWorkList prozedurari dei bat ikusiko duzu. Zerrenda grafiko bati elementuak gehitzeko erabiltzen da rac console utilitatearen irteera prozesatzen, aurretik $lst aldagaiari zerrenda gisa itzultzen zena. Hau bi puntuz bereizitako elementu-pareak dituzten zerrenden zerrenda da.

Adibidez, cluster konexioen zerrenda:

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

Era grafikoan honelako itxura izango du:

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Goiko prozedurak elementuen izenak aukeratzen ditu goiburuko eta datuen taula betetzeko:

TxertatuItemsWorkList

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
}

Hemen, komando soil baten ordez [split $str ":"], katea ":" bidez bereizitako elementuetan zatitzen duena eta zerrenda bat itzultzen duena, adierazpen erregularra erabiltzen da, elementu batzuek bi puntuak ere baitituzte.

InsertClusterItems prozedurak (antzeko hainbatetako bat) beharrezko kluster elementuaren zuhaitzean dagozkien identifikatzaileak dituzten haurren elementuen zerrenda besterik ez du gehitzen.
Txertatu 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
}

Antzeko prozedura bat ezartzeko beste bi aukera kontuan hartu ditzakezu, non argi eta garbi ikusiko den komando errepikakorrak nola optimizatu eta ken ditzakezu:

Prozedura honetan, gehitzea eta egiaztatzea zuzenean konpontzen dira:

TxertatuBaseItems

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"
    }
}

Hona hemen ikuspegi zuzenagoa:

TxertatuProfileItems

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 
    }
}

Haien arteko aldea begizta baten erabilera da, bertan errepikatutako komandoa(k) exekutatzen diren. Zein ikuspegi erabili garatzailearen esku dago.

Elementuak gehitzea eta datuak berreskuratzea landu dugu, orain edizioan zentratzeko garaia da. Funtsean, editatzeko eta gehitzeko parametro berdinak erabiltzen direnez (informazio-oinarria izan ezik), elkarrizketa-forma berdinak erabiltzen dira. Gehitzeko prozeduretara deitzeko algoritmoak itxura hau du:

Gehitu::$gakoa->GehituToplevel

Eta honela editatzeko:

Editatu::$gakoa->Gehitu::$gakoa->GehituTopLevel

Adibidez, har dezagun kluster bat editatzea, hau da. Zuhaitzeko klusterraren izena sakatu ondoren, sakatu tresna-barrako editatzeko botoia (arkatza) eta dagokion formularioa agertuko da pantailan:

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz
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
    }
}

Kodeko iruzkinetan oinarrituta, printzipioz, dena argi dago, botoien kudeatzailearen kodea gainidazten dela eta eremuak datuz betetzen dituen eta aldagaiak hasieratzen dituen FormFieldsDataInsert prozedura bat dagoela izan ezik:

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
                }
            }
        }
    }
}

Prozedura honetan, tcl-ren beste abantaila bat agertu zen - beste aldagai batzuen balioak aldagai-izen gisa ordezkatzen dira. Horiek. inprimakiak betetzea eta aldagaien hasiera automatizatzeko, eremuen eta aldagaien izenak rac utilitatearen komando-lerroko etengailuei dagozkie eta komandoen irteerako parametroen izenak salbuespen batzuk izan ezik - marra azpimarraz ordezkatzen da. Adib programatutako-lanak-ukatu eremuarekin bat dator ent_programatutako_lanak_ukatu eta aldakorra programatutako_lanak_ukatzea.

Gehitzeko eta editatzeko inprimakiak eremuen osaeran desberdinak izan daitezke, adibidez, informazio-oinarri batekin lan egitea:

Informazioaren segurtasuna gehitzea

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Informazioaren segurtasuna editatzea

1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Edit::infobase editatzeko prozeduran, beharrezkoak diren eremuak gehitzen dira formularioan; kodea oso handia da, beraz, ez dut hemen aurkezten.

Analogiaz, gehitzeko, editatzeko, ezabatzeko prozedurak ezartzen dira beste elementu batzuetarako.

Erabilgarritasunaren funtzionamenduak zerbitzari, kluster, informazio-oinarri eta abar kopuru mugagabea suposatzen duenez, zein kluster zein zerbitzari edo informazio-segurtasun sistemari dagokion zehazteko, hainbat aldagai global sartu dira, bakoitzaren balioak ezartzen baitira. zuhaitzaren elementuetan klik egiten duzun denbora. Horiek. prozedurak errekurtsiboki exekutatzen ditu elementu nagusi guztiak eta aldagaiak ezartzen ditu:

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
    }
}

1C klusterrak baimenarekin edo gabe lan egiteko aukera ematen du. Bi administratzaile mota daude: kluster-agentearen administratzailea eta kluster-administratzailea. Horren arabera, funtzionamendu zuzena izan dadin, beste 4 aldagai global sartu ziren administratzailearen saio-hasiera eta pasahitza dutenak. Horiek. klusterrean administratzaile kontu bat badago, elkarrizketa-koadro bat bistaratuko da zure saio-hasiera eta pasahitza sartzeko, datuak memorian gordeko dira eta dagokion klustererako komando bakoitzean txertatuko dira.

Akatsak kudeatzeko prozeduraren ardura da.

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Cluster administrator is not authenticated" {
            AuthorisationDialog "Администратор кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set cluster_user [.auth_win.frm.ent_name get]
                set cluster_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
            #RunCommand $root $par
        }
        "Central server administrator is not authenticated" {
            AuthorisationDialog "Администратор агента кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set agent_user [.auth_win.frm.ent_name get]
                set agent_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
        }
        "Администратор кластера не аутентифицирован" {
            AuthorisationDialog "Администратор кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set cluster_user [.auth_win.frm.ent_name get]
                set cluster_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
            #RunCommand $root $par
        }
        "Администратор центрального сервера не аутентифицирован" {
            AuthorisationDialog "Администратор агента кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set agent_user [.auth_win.frm.ent_name get]
                set agent_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
        }
        (.+) {
            tk_messageBox -type ok -icon error -message "$err"
        }
    }
}

Horiek. komandoak itzultzen duenaren arabera, erreakzioa horren araberakoa izango da.

Momentuz, funtzionalitatearen ehuneko 95 inguru inplementatu da, segurtasun-profilekin lana ezartzea eta probatzea baino ez da geratzen. Hori da dena. Barkamena eskatzen dizut istorio zimurtuagatik.

Kodea tradizionalki eskuragarri dago Hemen.

Eguneraketa: Segurtasun profilekin lanean amaitu dut. Orain funtzionaltasuna % 100 inplementatuta dago.

2. eguneratzea: ingelesera eta errusierara lokalizazioa gehitu da, win7-n lana probatu da
1C RAC-rako GUI bat idaztea, edo berriro Tcl/Tk-i buruz

Iturria: www.habr.com

Gehitu iruzkin berria