Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Како што навлегувавме во темата како функционираат производите 1C во околината на Linux, беше откриен еден недостаток - недостатокот на пригодна графичка мултиплатформска алатка за управување со кластер од сервери 1C. И беше одлучено да се поправи овој недостаток со пишување GUI за алатката rac конзола. Tcl/tk беше избран како јазик за развој како, според мое мислење, најсоодветен за оваа задача. И така, би сакал да презентирам неколку интересни аспекти на решението во овој материјал.

За да работите, ќе ви требаат дистрибуции tcl/tk и 1C. И бидејќи решив максимално да ги искористам можностите на основната испорака tcl/tk без да користам пакети од трети страни, ќе ми треба верзија 8.6.7, која вклучува ttk - пакет со дополнителни графички елементи, од кои главно ни треба ttk ::TreeView, овозможува прикажување на податоците и во форма на структура на дрво и во форма на табела (листа). Исто така, во новата верзија, работата со исклучоци е преработена (командата try, која се користи во проектот при извршување на надворешни команди).

Проектот се состои од неколку датотеки (иако ништо не ве спречува да направите сè во едно):

rac_gui.cfg - стандардна конфигурација
rac_gui.tcl - главната скрипта за лансирање
Директориумот lib содржи датотеки што автоматски се вчитуваат при стартување:
function.tcl - датотека со процедури
gui.tcl - главен графички интерфејс
images.tcl - библиотека со слики base64

Датотеката rac_gui.tcl, всушност, го стартува толкувачот, иницијализира променливи, вчитува модули, конфигурации итн. Содржина на датотеката со коментари:

rac_gui.tcl

#!/bin/sh
exec wish "$0" -- "$@"

# Устанавливаем текущий каталог
set dir(root) [pwd]
# Устанавливаем рабочий каталог, если его нет то создаём
set dir(work) [file join $env(HOME) .rac_gui]
if {[file exists $dir(work)] == 0 } {
    file mkdir $dir(work)    
}
# каталог с модулями
set dir(lib) "[file join $dir(root) lib]"

# загружаем пользовательский конфиг, если он отсутствует, то копируем дефолтный
if {[file exists [file join $dir(work) rac_gui.cfg]] ==0} {
    file copy [file join [pwd] rac_gui.cfg] [file join $dir(work) rac_gui.cfg]
} 
source [file join $dir(work) rac_gui.cfg]
# Код проверки наличия rac и правильности указания пути в конфиге
# если программа не найдена то будет выведен диалог для указания корректного пути
# и этот путь будет записан в пользовательский конфиг
if {[file exists $rac_cmd] == 0} {
    set rac_cmd [tk_getOpenFile -initialdir $env(HOME) -parent . -title "Укажите путь до rac" -initialfile rac]
    file copy [file join $dir(work) rac_gui.cfg] [file join $dir(work) rac_gui.cfg.bak] 
    set orig_file [open [file join $dir(work) rac_gui.cfg.bak] "r"]
    set file [open [file join $dir(work) rac_gui.cfg] "w"]
    while {[gets $orig_file line] >=0 } {
        if {[string match "set rac_cmd*" $line]} {
            puts $file "set rac_cmd $rac_cmd"
        } else {
            puts $file $line
        }
    }
    close $file
    close $orig_file
    #return "$host:$port"
    file delete [file join $dir(work) 1c_srv.cfg.bak] 
} else {
    puts "Found $rac_cmd"
}

set cluster_user ""
set cluster_pwd ""
set agent_user ""
set agent_pwd ""
## LOAD FILE ##
# Загружаем модули кроме gui.tcl так как его надо загрузить последним
foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
    if {[file tail $modFile] ne "gui.tcl"} {
        source $modFile
        puts "Loaded module $modFile"
    }
}
source [file join $dir(lib) gui.tcl]
source [file join $dir(work) rac_gui.cfg]

# Читаем файл со списком серверов 1С
# и добавляем в дерево
if [file exists [file join $dir(work) 1c_srv.cfg]] {
    set f [open [file join $dir(work) 1c_srv.cfg] "RDONLY"]
    while {[gets $f line] >=0} {
        .frm_tree.tree insert {} end -id "server::$line" -text "$line" -values "$line"
    }    
}

Откако ќе преземете сè што е потребно и ќе проверите за присуство на алатката rac, ќе се отвори графички прозорец. Програмскиот интерфејс се состои од три елементи:

Лента со алатки, дрво и листа

Ја направив содржината на „дрвото“ колку што е можно слична на стандардната опрема на Windows од 1C.

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Главниот код што го формира овој прозорец е содржан во датотеката
lib/gui.tcl

# установка размера и положения основного окна
# можно установить в переменную topLevelGeometry в конфиг программы
if {[info exists topLevelGeometry]} {
    wm geometry . $topLevelGeometry
} else {
    wm geometry . 1024x768
}
# Заголовок окна
wm title . "1C Rac GUI"
wm iconname . "1C Rac Gui"
# иконка окна (берется из файла lib/imges.tcl)
wm iconphoto . tcl
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user

ttk::style theme use clam

# Панель инсрументов
set frm_tool [frame .frm_tool]
pack $frm_tool -side left -fill y 
ttk::panedwindow .panel -orient horizontal -style TPanedwindow
pack .panel -expand true -fill both
pack propagate .panel false

ttk::button $frm_tool.btn_add  -command Add  -image add_grey_32
ttk::button $frm_tool.btn_del  -command Del -image del_grey_32
ttk::button $frm_tool.btn_edit  -command Edit -image edit_grey_32
ttk::button $frm_tool.btn_quit -command Quit -image quit_grey_32

pack $frm_tool.btn_add $frm_tool.btn_del $frm_tool.btn_edit -side top -padx 5 -pady 5
pack $frm_tool.btn_quit  -side bottom -padx 5 -pady 5

# Дерево с полосами прокрутки
set frm_tree [frame .frm_tree]

ttk::scrollbar $frm_tree.hsb1 -orient horizontal -command [list $frm_tree.tree xview]
ttk::scrollbar $frm_tree.vsb1 -orient vertical -command [list $frm_tree.tree yview]
set tree [ttk::treeview $frm_tree.tree -show tree 
-xscrollcommand [list $frm_tree.hsb1 set] -yscrollcommand [list $frm_tree.vsb1 set]]

grid $tree -row 0 -column 0 -sticky nsew
grid $frm_tree.vsb1 -row 0 -column 1 -sticky nsew
grid $frm_tree.hsb1 -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_tree 0 -weight 1
grid rowconfigure $frm_tree 0 -weight 1

# назначение обработчика нажатия кнопкой мыши
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"

# Список для данных (таблица)
set frm_work [frame .frm_work]
ttk::scrollbar $frm_work.hsb -orient horizontal -command [list $frm_work.tree_work xview]
ttk::scrollbar $frm_work.vsb -orient vertical -command [list $frm_work.tree_work yview]
set tree_work [
    ttk::treeview $frm_work.tree_work 
    -show headings  -columns "par val" -displaycolumns "par val"
    -xscrollcommand [list $frm_work.hsb set] 
    -yscrollcommand [list $frm_work.vsb set]
]
# Установка цветов для чередования в таблице
$tree_work tag configure dark -background $color(dark_table_bg)
$tree_work tag configure light -background $color(light_table_bg)

# Размещение элементов на форме
grid $tree_work -row 0 -column 0 -sticky nsew
grid $frm_work.vsb -row 0 -column 1 -sticky nsew
grid $frm_work.hsb -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_work 0 -weight 1
grid rowconfigure $frm_work 0 -weight 1
pack $frm_tree $frm_work -side left -expand true -fill both

#.panel add $frm_tool -weight 1
.panel add $frm_tree -weight 1 
.panel add $frm_work -weight 1

Алгоритмот за работа со програмата е како што следува:

1. Прво, треба да го додадете главниот сервер за кластери (т.е. серверот за управување со кластери (во Linux, управувањето се активира со командата „/opt/1C/v8.3/x86_64/ras кластер —демон“)).

За да го направите ова, кликнете на копчето „+“ и во прозорецот што се отвора, внесете ја адресата и портата на серверот:

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Потоа, нашиот сервер ќе се појави во дрвото со кликнување на него, ќе се отвори список со кластери или ќе се прикаже грешка во врската.

2. Со кликнување на името на кластерот ќе се отвори список со функции достапни за него.

3.

И така натаму, т.е. за да додадете нов кластер, изберете кој било достапен во списокот и притиснете го копчето „+“ во лентата со алатки и ќе се прикаже дијалогот за додавање нов:

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Копчињата во лентата со алатки извршуваат функции во зависност од контекстот, т.е. Во зависност од тоа кој елемент од дрвото или списокот е избран, ќе се изврши една или друга постапка.

Да го погледнеме примерот на копчето за додавање („+“):

Код за генерирање на копчиња:

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

Овде гледаме дека кога ќе се притисне копчето, ќе се изврши постапката „Додај“, нејзиниот код:

proc Add {} {
    global active_cluster host
    # Определяем идентификатор выделенного элемента
    set id  [.frm_tree.tree selection] 
    # Определяем значение этого элемента
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # в зависимости от того что выделили будет запущена нужная процедура
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Еве една од предностите на скокоткање: можете да ја пренесете вредноста на променливата како име на процедурата:

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

Тоа е, на пример, ако насочиме кон главниот сервер и притиснете „+“, тогаш ќе се активира процедурата Add::server, ако во кластерот - Add::cluster и така натаму (ќе пишувам за тоа каде потребните „клучеви“ доаѓаат од малку подолу), наведените постапки цртаат графички елементи соодветни на контекстот.

Како што веќе забележавте, формите се слични по стил - тоа не е изненадувачки, бидејќи тие се прикажуваат со една постапка, поточно главната рамка на формуларот (прозорец, копчиња, слика, етикета), името на постапката AddTopLevel

proc AddToplevel {lbl img {win_name .add}} {
    set cmd "destroy $win_name"
    if [winfo exists $win_name] {destroy $win_name}
    toplevel $win_name
    wm title $win_name $lbl
    wm iconphoto $win_name tcl
    # метка с иконкой
    ttk::label $win_name.lbl -image $img
    # фрейм с полями ввода
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # фрейм и кнопки
    set frm_btn [frame $win_name.frm_btn -border 0]
    ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
    ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24 
    grid $win_name.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
    grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
    grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
    pack  $frm_btn.btn_cancel  -side right
    pack  $frm_btn.btn_ok  -side right -padx 10
    return $frm
}

Параметри на повикот: наслов, име на сликата за иконата од библиотеката (lib/images.tcl) и опционален параметар за име на прозорецот (стандардно .add). Така, ако ги земеме горните примери за додавање на главниот сервер и кластер, повикот ќе биде соодветно:

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

или

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

Па, продолжувајќи со овие примери, ќе ги покажам процедурите што ги прикажуваат дијалозите за додавање за сервер или кластер.

Додај::сервер

proc Add::server {} {
    global default
    # выводим основную форму
    set frm [AddToplevel "Добавление основного сервера" server_grey_64]
    # добавляем етки и поля ввода на эту форму
    label $frm.lbl_host -text "Адрес сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    #set frm_btn [frame .add.frm_btn -border 0]
    # переопределяем обработчик нажатия кнопки
    .add.frm_btn.btn_ok configure -command {
        set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
        .frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
        destroy .add
        return $host
    }
    return $frm
}

Додај::кластер

proc Add::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes 
    agent_user agent_pwd cluster_user cluster_pwd auth_agent
    if {$agent_user ne "" && $agent_pwd ne ""} {
        set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
    } else {
        set auth_agent ""
    }
    # устанавливаем глобальные переменные ()
    set lifetime_limit $default(lifetime_limit)
    set expiration_timeout $default(expiration_timeout)
    set session_fault_tolerance_level $default(session_fault_tolerance_level)
    set max_memory_size $default(max_memory_size)
    set max_memory_time_limit $default(max_memory_time_limit)
    set errors_count_threshold $default(errors_count_threshold)
    set security_level [lindex $default(security_level) 0]
    set load_balancing_mode [lindex $default(load_balancing_mode) 0]
    
    set frm [AddToplevel "Добавление кластера" cluster_grey_64]
    
    label $frm.lbl_host -text "Адрес основного сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Название кластера"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Защищённое соединение"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Рабочие процессы:"
    label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
    checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no    
    
    grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
    # переопределяем обработчик
    .add.frm_btn.btn_ok configure -command {
        RunCommand "" "cluster insert 
        --host=[.add.frm.ent_host get] 
        --port=[.add.frm.ent_port get] 
        --name=[.add.frm.ent_name get] 
        --expiration-timeout=$expiration_timeout 
        --lifetime-limit=$lifetime_limit 
        --max-memory-size=$max_memory_size 
        --max-memory-time-limit=$max_memory_time_limit 
        --security-level=$security_level 
        --session-fault-tolerance-level=$session_fault_tolerance_level 
        --load-balancing-mode=$load_balancing_mode 
        --errors-count-threshold=$errors_count_threshold 
        --kill-problem-processes=$kill_problem_processes 
        $auth_agent $host"
        Run::server $tree $host ""
        destroy .add
    }
    return $frm
}

Кога се споредува кодот на овие постапки, разликата е видлива со голо око; ќе се фокусирам на управувачот со копчињата „Ок“. Во Tk, својствата на графичките елементи може да се отфрлат за време на извршувањето на програмата користејќи ја опцијата конфигурирате. На пример, почетната команда за прикажување на копчето:

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

Но, во нашите форми, командата зависи од потребната функционалност:

  .add.frm_btn.btn_ok configure -command {
        RunCommand "" "cluster insert 
        --host=[.add.frm.ent_host get] 
        --port=[.add.frm.ent_port get] 
        --name=[.add.frm.ent_name get] 
        --expiration-timeout=$expiration_timeout 
        --lifetime-limit=$lifetime_limit 
        --max-memory-size=$max_memory_size 
        --max-memory-time-limit=$max_memory_time_limit 
        --security-level=$security_level 
        --session-fault-tolerance-level=$session_fault_tolerance_level 
        --load-balancing-mode=$load_balancing_mode 
        --errors-count-threshold=$errors_count_threshold 
        --kill-problem-processes=$kill_problem_processes 
        $auth_agent $host"
        Run::server $tree $host ""
        destroy .add
    }

Во горниот пример, копчето „затнато“ ја започнува процедурата за додавање кластер.

Овде вреди да се направи дигресија кон работа со графички елементи во Tk - за различни елементи за внесување податоци (влез, комбинирано поле, копче за проверка, итн.) воведен е параметар како текстуална променлива:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Оваа променлива е дефинирана во глобалниот именски простор и ја содржи моментално внесената вредност. Оние. за да го добиете внесениот текст од полето, само треба да ја прочитате вредноста што одговара на променливата (се разбира, под услов таа да е дефинирана при креирањето на елементот).

Вториот метод за преземање на внесениот текст (за елементи од типот на запис) е да се користи командата get:

.add.frm.ent_name get

И двата од овие методи може да се видат во горниот код.

Со кликнување на ова копче, во овој случај, се активира постапката RunCommand со генерирана командна линија за додавање кластер во однос на rac:

/opt/1C/v8.3/x86_64/rac cluster insert  --host=localhost  --port=1540  --name=dsdsds  --expiration-timeout=0  --lifetime-limit=0  --max-memory-size=0  --max-memory-time-limit=0  --security-level=0  --session-fault-tolerance-level=0  --load-balancing-mode=performance  --errors-count-threshold=0  --kill-problem-processes=no   localhost:1545

Сега доаѓаме до главната команда, која го контролира стартувањето на rac со параметрите што ни се потребни, исто така го анализира излезот на командите во списоци и враќа, доколку е потребно:

RunCommand

proc RunCommand {root par} {
    global dir rac_cmd cluster work_list_row_count agent_user agent_pwd cluster_user cluster_pwd
    puts "$rac_cmd $par"
    set work_list_row_count 0
    # открываем канал в неблокирующем режиме
    # $rac - команда с полным путём
    # $par - сформированные ключи запуска и опции    
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # вывод команды добавляем в список списков
        while {[gets $pipe line]>=0} {
            #puts $line
            if {$line eq ""} {
                lappend l $lst
                set lst ""
            } else {
                lappend lst [string trim $line]
            }
        }
        close $pipe
        return $l
    } on error {result options} {
        # Запуск обработчика ошибок
        ErrorParcing $result $options
        return ""
    }
}

Откако ќе ги внесете податоците за главниот сервер, тие ќе бидат додадени на дрвото, за ова, во горната постапка Add:server, одговорен е следниот код:

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

Сега, со кликнување на името на серверот во дрвото, добиваме листа на кластери управувани од тој сервер, а со кликнување на кластер добиваме листа на елементи на кластерот (сервери, инфобази итн.). Ова е имплементирано во постапката TreePress (датотека lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # определяем выделенный элемент
    set id  [$tree selection]
   # устанавливаем нужные глобальные переменные
    SetGlobalVarFromTreeItems $tree $id
   # Определяем ключ и значение, т.е. именно тип выбранного элемента
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # и в зависимости от того что выбрали будет запущена соответствующая процедура 
   # в пространстве имён Run
    Run::$key $tree $host $values
}

Според тоа, Run::server ќе биде лансиран за главниот сервер (за кластер - Run::cluster, за работен сервер - Run::work_server, итн.). Оние. вредноста на променливата $key е дел од името на елементот на дрвото одредено со опцијата -ид.

Ајде да обрнеме внимание на постапката

Стартувај::сервер

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

Оваа постапка го обработува она што е примено од серверот преку командата RunCommand и додава секакви работи во дрвото - кластери, различни коренски елементи (бази, работни сервери, сесии итн.). Ако погледнете внимателно, ќе забележите повик до процедурата InsertItemsWorkList внатре. Се користи за додавање елементи на графичка листа со обработка на излезот од алатката rac конзола, која претходно беше вратена како листа на променливата $lst. Ова е листа на списоци што содржат парови на елементи одделени со две точки.

На пример, листа на кластер врски:

svk@svk ~]$ /opt/1C/v8.3/x86_64/rac connection list --cluster=783d2170-56c3-11e8-c586-fc75165efbb2 localhost:1545
connection     : dcf5991c-7d24-11e8-1690-fc75165efbb2
conn-id        : 0
host           : svk.home
process        : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase       : 00000000-0000-0000-0000-000000000000
application    : "JobScheduler"
connected-at   : 2018-07-01T14:49:51
session-number : 0
blocked-by-ls  : 0

connection     : b993293a-7d24-11e8-1690-fc75165efbb2
conn-id        : 0
host           : svk.home
process        : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase       : 00000000-0000-0000-0000-000000000000
application    : "JobScheduler"
connected-at   : 2018-07-01T14:48:52
session-number : 0
blocked-by-ls  : 0

Во графичка форма ќе изгледа вака:

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Горенаведената постапка ги избира имињата на елементите за заглавието и податоците за пополнување на табелата:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # установка чередования цвета для строки
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # разбор строк на пары ключ - значение
    foreach i $lst {
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            lappend column_list [string trim $param]
            lappend value_list [string trim $value]
        }
    }
     # заполнение таблицы
    .frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
    .frm_work.tree_work insert {} end  -values $value_list -tags $tag
    .frm_work.tree_work column #0 -stretch
    # установка заголовков
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Овде, наместо едноставна команда [split $str ":"], која ја дели низата на елементи одделени со ":" и враќа листа, се користи регуларен израз, бидејќи некои елементи содржат и две точки.

Процедурата InsertClusterItems (една од неколкуте слични) едноставно додава листа на дет-елементи со соодветни идентификатори на стеблото на потребниот кластер елемент
InsertClusterItems

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
}

Можете да разгледате уште две опции за спроведување на слична процедура, каде што ќе биде јасно видливо како можете да оптимизирате и да се ослободите од повторувачките команди:

Во оваа постапка, додавањето и проверката се решаваат директно:

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

Еве еден поточен пристап:

InsertProfileItems

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

Разликата меѓу нив е употребата на јамка, во која се извршуваат повторените команди. Кој пристап да се користи е на дискреција на развивачот.

Опфативме додавање елементи и преземање податоци, сега е време да се фокусираме на уредувањето. Бидејќи, во основа, истите параметри се користат за уредување и додавање (со исклучок на базата на информации), се користат истите дијалози. Алгоритмот за повикување процедури за додавање изгледа вака:

Додај::$key->AddToplevel

И за вака уредување:

Уреди::$key->Add::$key->AddTopLevel

На пример, да земеме уредување на кластер, т.е. Откако ќе кликнете на името на кластерот во дрвото, притиснете го копчето за уредување во лентата со алатки (молив) и соодветната форма ќе се прикаже на екранот:

Пишување GUI за 1C RAC, или повторно за Tcl/Tk
Уреди::кластер

proc Edit::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes active_cluster 
    agent_user agent_pwd cluster_user cluster_pwd auth
    if {$cluster_user ne "" && $cluster_pwd ne ""} {
        set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
    } else {
        set auth ""
    }
    # рисуем форму для кластера
    set frm [Add::cluster $tree $host $values]
    # меняем текст на метке
    $frm configure -text "Редактирование кластера"
    
    set active_cluster $values
    # получаем данные по выделенному кластеру
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # заполняем поля
    FormFieldsDataInsert $frm $lst
    # выключаем поля, редактирование которых запрещено
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # переназначаем обработчик
    .add.frm_btn.btn_ok configure -command {
        RunCommand "" "cluster update 
        --cluster=$active_cluster $auth 
        --name=[.add.frm.ent_name get] 
        --expiration-timeout=$expiration_timeout 
        --lifetime-limit=$lifetime_limit 
        --max-memory-size=$max_memory_size 
        --max-memory-time-limit=$max_memory_time_limit 
        --security-level=$security_level 
        --session-fault-tolerance-level=$session_fault_tolerance_level 
        --load-balancing-mode=$load_balancing_mode 
        --errors-count-threshold=$errors_count_threshold 
        --kill-problem-processes=$kill_problem_processes 
        $auth $host"
        $tree delete "cluster::$active_cluster"
        Run::server $tree $host ""
        destroy .add
    }
}

Врз основа на коментарите во кодот, во принцип, сè е јасно, освен што кодот на управувачот на копчињата е отфрлен и постои процедура FormFieldsDataInsert која ги пополнува полињата со податоци и ги иницијализира променливите:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # получаем список параметров и значений
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # меняем символы
            regsub -all -- "-" [string trim $param] "_" entry_name
            # заполняем данными
            if [winfo exists $frm.ent_$entry_name] {
                $frm.ent_$entry_name delete 0 end
                $frm.ent_$entry_name insert end [string trim $value """]
            }
            if [winfo exists $frm.cb_$entry_name] {
                global $entry_name
                set $entry_name [string trim $value """]
            }
            # для чекбоксов меняем значения
            if [winfo exists $frm.check_$entry_name] {
                global $entry_name
                if {$value eq "0"} {
                    set $entry_name no
                } elseif {$value eq "1"} {
                    set $entry_name yes
                } else {
                    set $entry_name $value
                }
            }
        }
    }
}

Во оваа постапка, се појави уште една предност на tcl - вредностите на другите променливи се заменуваат како имиња на променливи. Оние. за автоматизирање на пополнувањето на формуларите и иницијализацијата на променливите, имињата на полињата и променливите одговараат на прекинувачите на командната линија на алатката rac и имињата на излезните параметри на командата со одреден исклучок - цртичката се заменува со долна цртичка. На пр закажано-работа-одбива одговара на теренот ent_scheduled_jobs_deny и променлива закажани_работа_одбива.

Формите за додавање и уредување може да се разликуваат во составот на полињата, на пример, работа со информативна база:

Додавање безбедност на информации

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Уредување на безбедноста на информациите

Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Во процедурата за уредување Edit::infobase, потребните полиња се додаваат во формуларот, кодот е обемен, затоа не го прикажувам овде.

По аналогија, процедурите за додавање, уредување, бришење се спроведуваат за други елементи.

Бидејќи работата на алатката подразбира неограничен број на сервери, кластери, бази на информации итн., за да се утврди кој кластер припаѓа на кој сервер или систем за безбедност на информации, воведени се неколку глобални променливи, чии вредности се поставени секоја време кога ќе кликнете на елементите на дрвото. Оние. постапката рекурзивно се протега низ сите родителски елементи и ги поставува променливите:

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 ви овозможува да работите со или без овластување. Постојат два вида администратори - администратор на агенти за кластери и администратори на кластери. Според тоа, за правилно функционирање, беа воведени уште 4 глобални променливи кои ги содржат администраторскиот најава и лозинката. Оние. ако има администраторска сметка во кластерот, ќе се прикаже дијалог за внесување на најавување и лозинка, податоците ќе се зачуваат во меморијата и ќе се вметнат во секоја команда за соодветниот кластер.

Ова е одговорност на постапката за справување со грешки.

Грешка за парење

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

Оние. во зависност од тоа што ќе врати командата, реакцијата ќе биде соодветна.

Во моментов, околу 95 проценти од функционалноста е имплементирана, останува само да се спроведе работа со безбедносни профили и да се тестира =). Тоа е се. Се извинувам за стутканата приказна.

Кодот е традиционално достапен тука.

Ажурирање: завршив со работа со безбедносни профили. Сега функционалноста е 100% имплементирана.

Ажурирање 2: додадена е локализација на англиски и руски, работата во win7 е тестирана
Пишување GUI за 1C RAC, или повторно за Tcl/Tk

Извор: www.habr.com

Додадете коментар