Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

Dum ni enprofundiĝis en la temon pri kiel 1C-produktoj funkcias en la Linukso-medio, unu malavantaĝo estis malkovrita - la manko de oportuna grafika plurplatforma ilo por administri areton de 1C-serviloj. Kaj estis decidite korekti ĉi tiun malavantaĝon skribante GUI por la rac-konzola ilo. Tcl/tk estis elektita kiel la evolulingvo kiel, laŭ mi, la plej taŭga por tiu ĉi tasko. Kaj do, mi ŝatus prezenti kelkajn interesajn aspektojn de la solvo en ĉi tiu materialo.

Por funkcii vi bezonos distribuojn tcl/tk kaj 1C. Kaj ĉar mi decidis utiligi la plej multajn kapablojn de la baza tcl/tk-livero sen uzi triapartajn pakaĵojn, mi bezonos version 8.6.7, kiu inkluzivas ttk - pakaĵon kun pliaj grafikaj elementoj, el kiuj ni ĉefe bezonas ttk. ::TreeView, ĝi permesas montri datumojn kaj en formo de arba strukturo kaj en formo de tabelo (listo). Ankaŭ, en la nova versio, la laboro kun esceptoj estis reverkita (la try-komando, kiu estas uzata en la projekto dum rulado de eksteraj komandoj).

La projekto konsistas el pluraj dosieroj (kvankam nenio malhelpas vin fari ĉion en unu):

rac_gui.cfg - defaŭlta agordo
rac_gui.tcl - ĉefa lanĉa skripto
La lib-dosierujo enhavas dosierojn, kiuj estas aŭtomate ŝargitaj ĉe ekfunkciigo:
function.tcl - dosiero kun proceduroj
gui.tcl - ĉefa grafika interfaco
images.tcl - baza64 bildbiblioteko

La rac_gui.tcl-dosiero, fakte, lanĉas la interpretiston, pravalorigas variablojn, ŝargas modulojn, agordojn, ktp. Enhavo de la dosiero kun komentoj:

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

Post elŝuto de ĉio, kio necesas kaj kontroli la ĉeeston de la rac-utilo, grafika fenestro estos lanĉita. La programinterfaco konsistas el tri elementoj:

Ilobreto, arbo kaj listo

Mi faris la enhavon de la "arbo" kiel eble plej simila al la norma Vindoza ekipaĵo de 1C.

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

La ĉefa kodo kiu formas ĉi tiun fenestron estas enhavita en la dosiero
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

La algoritmo por labori kun la programo estas kiel sekvas:

1. Unue, vi devas aldoni la ĉefan grapolservilon (t.e., la cluster-administra servilo (en Linukso, administrado estas lanĉita per la komando "/opt/1C/v8.3/x86_64/ras cluster —daemon")).

Por fari tion, alklaku la butonon "+" kaj en la fenestro kiu malfermiĝas, enigu la servilan adreson kaj havenon:

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

Poste, nia servilo aperos en la arbo klakante sur ĝi, listo de aretoj malfermiĝos aŭ konekto-eraro aperos.

2. Alklakante la cluster-nomon malfermos liston de disponeblaj funkcioj por ĝi.

3. ...

Kaj tiel plu, t.e. por aldoni novan areton, elektu iun ajn disponeblan en la listo kaj premu la butonon "+" en la ilobreto kaj la aldonu novan dialogon aperos:

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

La butonoj en la ilobreto plenumas funkciojn depende de la kunteksto, t.e. Depende de kiu elemento de la arbo aŭ listo estas elektita, unu aŭ alia proceduro estos farita.

Ni rigardu la ekzemplon de la aldona butono ("+"):

Butongenera kodo:

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

Ĉi tie ni vidas, ke kiam la butono estas premata, la proceduro "Aldoni" estos ekzekutita, ĝia kodo:

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
}

Jen unu el la avantaĝoj de tiklado: vi povas pasi la valoron de variablo kiel procedurnomo:

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

Tio estas, ekzemple, se ni montras al la ĉefa servilo kaj premas “+”, tiam la proceduro Aldoni::servilo estos lanĉita, se ĉe la areto - Aldoni::grupo kaj tiel plu (mi skribos pri kie la necesaj "ŝlosiloj" venas de iom malsupre), la listigitaj proceduroj desegnas grafikajn elementojn taŭgajn al la kunteksto.

Kiel vi eble jam rimarkis, la formoj estas similaj laŭ stilo - tio ne estas surpriza, ĉar ili estas montrataj per unu proceduro, pli precize la ĉefa kadro de la formo (fenestro, butonoj, bildo, etikedo), la nomo de la proceduro. Aldoni Supran Nivelon

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
}

Vokaj parametroj: titolo, bildonomo por la ikono el la biblioteko (lib/images.tcl) kaj laŭvola fenestra nomo parametro (defaŭlte .add). Tiel, se ni prenas la suprajn ekzemplojn por aldoni la ĉefan servilon kaj areton, la alvoko estos laŭe:

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

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

Nu, daŭrigante kun ĉi tiuj ekzemploj, mi montros la procedurojn, kiuj montras aldoni dialogojn por servilo aŭ areto.

Aldoni::servilo

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
}

Aldoni::cluster

proc Add::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes 
    agent_user agent_pwd cluster_user cluster_pwd auth_agent
    if {$agent_user ne "" && $agent_pwd ne ""} {
        set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
    } else {
        set auth_agent ""
    }
    # устанавливаем глобальные переменные ()
    set lifetime_limit $default(lifetime_limit)
    set expiration_timeout $default(expiration_timeout)
    set session_fault_tolerance_level $default(session_fault_tolerance_level)
    set max_memory_size $default(max_memory_size)
    set max_memory_time_limit $default(max_memory_time_limit)
    set errors_count_threshold $default(errors_count_threshold)
    set security_level [lindex $default(security_level) 0]
    set load_balancing_mode [lindex $default(load_balancing_mode) 0]
    
    set frm [AddToplevel "Добавление кластера" cluster_grey_64]
    
    label $frm.lbl_host -text "Адрес основного сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Название кластера"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Защищённое соединение"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
    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
}

Komparante la kodon de ĉi tiuj proceduroj, la diferenco estas videbla al la nuda okulo; mi koncentriĝos sur la butontraktilo "Ok". En Tk, la propraĵoj de grafikaj elementoj povas esti anstataŭitaj dum la ekzekuto de la programo uzante la opcion agordi. Ekzemple, la komenca komando por montri la butonon:

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

Sed en niaj formoj, la komando dependas de la bezonata funkcio:

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

En la supra ekzemplo, la "ŝtopiĝinta" butono komencas la proceduron por aldoni areton.

Ĉi tie indas fari deturniĝon por labori kun grafikaj elementoj en Tk - por diversaj enigelementoj de datumoj (eniro, kombokesto, kontrolbutono, ktp.) parametro estis enkondukita kiel teksta variablo:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Ĉi tiu variablo estas difinita en la tutmonda nomspaco kaj enhavas la nuntempe enigitan valoron. Tiuj. por ricevi la enigitan tekston el la kampo, vi nur bezonas legi la valoron respondan al la variablo (kompreneble, kondiĉe ke ĝi estas difinita dum kreado de la elemento).

La dua metodo por retrovi la enigitan tekston (por elementoj de enirtipo) estas uzi la get komandon:

.add.frm.ent_name get

Ambaŭ ĉi tiuj metodoj povas esti viditaj en la supra kodo.

Alklakante ĉi tiun butonon, en ĉi tiu kazo, lanĉas la proceduron RunCommand kun la generita komandlinio por aldoni areton laŭ 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

Nun ni venas al la ĉefa komando, kiu kontrolas la lanĉon de rac kun la parametroj kiujn ni bezonas, ankaŭ analizas la eliron de komandoj en listojn kaj revenas, se necese:

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

Post enirado de la ĉefaj servilaj datumoj, ĝi estos aldonita al la arbo, por tio, en la supra Aldoni:servila proceduro respondecas la sekva kodo:

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

Nun, alklakante la servilnomon en la arbo, ni ricevas liston de aretoj administritaj de tiu servilo, kaj klakante sur areto, ni ricevas liston de aretelementoj (serviloj, informbazoj, ktp.). Ĉi tio estas efektivigita en la TreePress-proceduro (dosiero 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
}

Sekve, Run::server estos lanĉita por la ĉefa servilo (por areto - Run::cluster, por funkcianta servilo - Run::work_server, ktp.). Tiuj. la valoro de la $key-variablo estas parto de la nomo de la arbelemento specifita de la opcio -id.

Ni atentu la proceduron

Run::server

proc Run::server {tree host values} {
    # получаем список кластеров требуемого сервера
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # удаляем лишнее из списка
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # читаем список
    foreach cluster_list $lst {
        # Заполняем список полученными значениями
        InsertItemsWorkList $cluster_list
        # обрабатываем вывод (список) для добавления данных в дерево
        foreach i $cluster_list {
            #puts $i
            set cluster_list [split $i ":"]
            if  {[string trim [lindex $cluster_list 0]] eq "cluster"} {
                set cluster_id [string trim [lindex $cluster_list 1]]
                lappend cluster($cluster_id) $cluster_id
            }
            if  {[string trim [lindex $cluster_list 0]] eq "name"} {
                lappend  cluster($cluster_id) [string trim [lindex $cluster_list 1]]
            }
        }
    }
    # добавляем кластеры в дерево
    foreach x [array names cluster] {
        set id [lindex $cluster($x) 0]
        if { [$tree exists "cluster::$id"] == 0 } {
            $tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
            # добавляем элементы в кластер
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Ĉi tiu proceduro prilaboras tion, kio estis ricevita de la servilo per la komando RunCommand kaj aldonas ĉiajn aferojn al la arbo - aretoj, diversaj radikaj elementoj (bazoj, laborserviloj, sesioj ktp). Se vi rigardas atente, vi rimarkos alvokon al la proceduro InsertItemsWorkList interne. Ĝi estas uzata por aldoni elementojn al grafika listo per prilaborado de la eligo de la rac-konzola ilo, kiu antaŭe estis resendita kiel listo al la $lst variablo. Ĉi tio estas listo de listoj enhavantaj parojn da elementoj apartigitaj per dupunkto.

Ekzemple, listo de aretkonektoj:

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

En grafika formo ĝi aspektos kiel ĉi tio:

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

La supra proceduro elektas la nomojn de elementoj por la kaplinio kaj datumoj por plenigi la tabelon:

EnmetuItemsWorkList

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
}

Ĉi tie, anstataŭ simpla komando [dividi $str ":"], kiu dividas la ĉenon en elementojn apartigitajn per ":" kaj redonas liston, oni uzas regulan esprimon, ĉar iuj elementoj ankaŭ enhavas dupunkton.

La proceduro InsertClusterItems (unu el pluraj similaj) simple aldonas liston de infanelementoj kun respondaj identigiloj al la arbo de la bezonata grapolelemento
Enmetu 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
}

Vi povas konsideri du pliajn eblojn por efektivigi similan proceduron, kie estos klare videbla kiel vi povas optimumigi kaj forigi ripetajn komandojn:

En ĉi tiu proceduro, aldonado kaj kontrolo estas solvitaj rekte:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
    }
}

Jen pli ĝusta aliro:

Enmetu ProfileImojn

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

La diferenco inter ili estas la uzo de buklo, en kiu la ripeta(j) komando(j) estas ekzekutita(j). Kiun aliron uzi estas laŭ la bontrovo de la programisto.

Ni kovris aldoni elementojn kaj retrovi datumojn, nun estas tempo koncentriĝi pri redaktado. Ĉar, esence, la samaj parametroj estas uzataj por redaktado kaj aldono (krom la informbazo), la samaj dialogformoj estas uzataj. La algoritmo por voki procedurojn por aldoni aspektas jene:

Aldoni::$key->AddToplevel

Kaj por redaktado tiel:

Redakti::$key->Aldoni::$key->AddTopLevel

Ekzemple, ni prenu redaktadon de aro, t.e. Klakinte la nomon de la areto en la arbo, premu la redaktan butonon en la ilobreto (krajono) kaj la responda formo aperos sur la ekrano:

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk
Redakti::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
    }
}

Surbaze de la komentoj en la kodo, principe, ĉio estas klara, krom ke la butontraktilo-kodo estas anstataŭita kaj ekzistas FormFieldsDataInsert proceduro kiu plenigas la kampojn kun datumoj kaj pravalorigas la variablojn:

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

En ĉi tiu proceduro, alia avantaĝo de tcl ekaperis - la valoroj de aliaj variabloj estas anstataŭigitaj kiel variablo-nomoj. Tiuj. por aŭtomatigi la plenigon de formoj kaj inicialigon de variabloj, la nomoj de kampoj kaj variabloj respondas al la komandliniaj ŝaltiloj de la rac-utilo kaj la nomoj de komandaj eligparametroj kun iu escepto - la streketo estas anstataŭigita per substreko. Ekz planita-laborpostenoj-nei kongruas kun la kampo ent_planitaj_laboroj_nei kaj varia planitaj_laboroj_nei.

Formoj por aldoni kaj redakti povas malsami en la konsisto de la kampoj, ekzemple, laborante kun informa bazo:

Aldonante informan sekurecon

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

Redaktado de informa sekureco

Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

En la redakta procedo Edit::infobase, la bezonataj kampoj estas aldonitaj al la formularo; la kodo estas granda, tial mi ne prezentas ĝin ĉi tie.

Analogie, proceduroj por aldoni, redakti, forigi estas efektivigitaj por aliaj elementoj.

Ĉar la funkciado de la utileco implicas senliman nombron da serviloj, aretoj, informaj bazoj ktp., por determini kiu areto apartenas al kiu servilo aŭ informa sekureca sistemo, pluraj tutmondaj variabloj estas enkondukitaj, kies valoroj estas fiksitaj ĉiu. tempo kiam vi klakas sur la elementoj de la arbo. Tiuj. la proceduro rekursie trairas ĉiujn gepatrajn elementojn kaj metas la variablojn:

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

La 1C areto permesas vin labori kun aŭ sen rajtigo. Estas du specoj de administrantoj - administranto de la grapo-agento kaj administranto de la cluster. Sekve, por ĝusta funkciado, 4 pliaj tutmondaj variabloj estis enkondukitaj enhavantaj la administran ensaluton kaj pasvorton. Tiuj. se estas administranta konto en la areto, dialogo estos montrata por enigi vian ensaluton kaj pasvorton, la datumoj estos konservitaj en memoro kaj enmetitaj en ĉiun komandon por la responda grapolo.

Ĉi tio estas la respondeco de la procedo pri eraro-traktado.

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

Tiuj. depende de tio, kion revenas la komando, la reago estos laŭe.

Nuntempe, ĉirkaŭ 95 procentoj de la funkcieco estis efektivigita, nur restas efektivigi laboron kun sekurecaj profiloj kaj testi ĝin =). Tio estas ĉio. Mi pardonpetas pro la ĉifita rakonto.

La kodo estas tradicie havebla tie.

Ĝisdatigo: Mi finis labori kun sekurecaj profiloj. Nun la funkcieco estas 100% efektivigita.

Ĝisdatigo 2: lokalizo en la anglan kaj rusan estis aldonita, laboro en win7 estis provita
Skribante GUI por 1C RAC, aŭ denove pri Tcl/Tk

fonto: www.habr.com

Aldoni komenton