Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Sa pagtalakay namin sa paksa kung paano gumagana ang mga produkto ng 1C sa kapaligiran ng Linux, natuklasan ang isang disbentaha - ang kakulangan ng isang maginhawang graphical na multi-platform na tool para sa pamamahala ng isang kumpol ng mga 1C server. At napagpasyahan na itama ang disbentaha na ito sa pamamagitan ng pagsulat ng isang GUI para sa rac console utility. Napili ang Tcl/tk bilang wika ng pag-unlad bilang, sa palagay ko, ang pinaka-angkop para sa gawaing ito. At kaya, nais kong ipakita ang ilang mga kagiliw-giliw na aspeto ng solusyon sa materyal na ito.

Upang gumana kakailanganin mo ang tcl/tk at 1C distribution. At dahil napagpasyahan kong sulitin ang mga kakayahan ng pangunahing paghahatid ng tcl/tk nang hindi gumagamit ng mga third-party na pakete, kakailanganin ko ang bersyon 8.6.7, na kinabibilangan ng ttk - isang pakete na may karagdagang mga elemento ng graphic, kung saan higit na kailangan natin ang ttk ::TreeView, pinapayagan nito ang pagpapakita ng data kapwa sa anyo ng istraktura ng puno at sa anyo ng isang talahanayan (listahan). Gayundin, sa bagong bersyon, ang gawaing may mga pagbubukod ay muling ginawa (ang try command, na ginagamit sa proyekto kapag nagpapatakbo ng mga panlabas na utos).

Ang proyekto ay binubuo ng ilang mga file (bagaman walang pumipigil sa iyo na gawin ang lahat sa isa):

rac_gui.cfg - default na config
rac_gui.tcl - pangunahing script ng paglulunsad
Ang direktoryo ng lib ay naglalaman ng mga file na awtomatikong na-load sa pagsisimula:
function.tcl - file na may mga pamamaraan
gui.tcl - pangunahing graphical na interface
images.tcl - base64 image library

Ang rac_gui.tcl file, sa katunayan, ay nagsisimula sa interpreter, nagpapasimula ng mga variable, naglo-load ng mga module, config, at iba pa. Mga nilalaman ng file na may mga komento:

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

Pagkatapos i-download ang lahat ng kinakailangan at suriin kung mayroong rac utility, isang graphical na window ang ilulunsad. Ang interface ng programa ay binubuo ng tatlong elemento:

Toolbar, puno at listahan

Ginawa ko ang mga nilalaman ng "puno" bilang katulad hangga't maaari sa karaniwang kagamitan sa Windows mula sa 1C.

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Ang pangunahing code na bumubuo sa window na ito ay nakapaloob sa file
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

Ang algorithm para sa pagtatrabaho sa programa ay ang mga sumusunod:

1. Una, kailangan mong idagdag ang pangunahing cluster server (ibig sabihin, ang cluster management server (sa Linux, ang pamamahala ay inilunsad gamit ang command na “/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Upang gawin ito, mag-click sa pindutang "+" at sa window na bubukas, ipasok ang address at port ng server:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pagkatapos, lalabas ang aming server sa puno sa pamamagitan ng pag-click dito, magbubukas ang isang listahan ng mga kumpol o isang error sa koneksyon ang ipapakita.

2. Ang pag-click sa pangalan ng cluster ay magbubukas ng isang listahan ng mga function na magagamit para dito.

3. ...

At iba pa, i.e. upang magdagdag ng bagong cluster, pumili ng alinmang available sa listahan at pindutin ang "+" na button sa toolbar at ipapakita ang add new dialog:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Ang mga pindutan sa toolbar ay gumaganap ng mga function depende sa konteksto, i.e. Depende sa kung aling elemento ng puno o listahan ang pipiliin, isa o ibang pamamaraan ang isasagawa.

Tingnan natin ang halimbawa ng add button (“+”):

Code ng pagbuo ng button:

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

Dito makikita natin na kapag pinindot ang pindutan, ang "Magdagdag" na pamamaraan ay isasagawa, ang code nito:

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
}

Narito ang isa sa mga pakinabang ng kiliti: maaari mong ipasa ang halaga ng isang variable bilang pangalan ng pamamaraan:

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

Iyon ay, halimbawa, kung itinuro natin ang pangunahing server at pindutin ang "+", pagkatapos ay ilulunsad ang Add::server procedure, kung sa cluster - Add::cluster at iba pa (Isusulat ko kung saan ang ang mga kinakailangang "susi" ay nagmumula sa kaunti sa ibaba), ang mga nakalistang pamamaraan ay gumuhit ng mga graphic na elemento na naaangkop sa konteksto.

Tulad ng napansin mo na, ang mga form ay magkatulad sa istilo - hindi ito nakakagulat, dahil ipinapakita ang mga ito sa pamamagitan ng isang pamamaraan, mas tiyak ang pangunahing frame ng form (window, mga pindutan, imahe, label), ang pangalan ng pamamaraan. 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
}

Mga parameter ng tawag: pamagat, pangalan ng larawan para sa icon mula sa library (lib/images.tcl) at isang opsyonal na parameter ng pangalan ng window (default .add). Kaya, kung kukunin natin ang mga halimbawa sa itaas para sa pagdaragdag ng pangunahing server at kumpol, ang tawag ay magiging naaayon:

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

o

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

Well, sa pagpapatuloy sa mga halimbawang ito, ipapakita ko ang mga pamamaraan na nagpapakita ng mga add dialog para sa isang server o cluster.

Magdagdag ng::server

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
}

Magdagdag ng::kumpol

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
}

Kapag inihambing ang code ng mga pamamaraang ito, ang pagkakaiba ay makikita sa mata; ako ay tumutuon sa "Ok" na tagapangasiwa ng pindutan. Sa Tk, ang mga katangian ng mga graphic na elemento ay maaaring ma-override sa panahon ng pagpapatupad ng programa gamit ang opsyon i-configure ang. Halimbawa, ang paunang utos upang ipakita ang pindutan:

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

Ngunit sa aming mga form, ang utos ay nakasalalay sa kinakailangang pag-andar:

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

Sa halimbawa sa itaas, ang "barado" na buton ay magsisimula ng pamamaraan para sa pagdaragdag ng isang kumpol.

Narito ito ay nagkakahalaga ng paggawa ng isang digression patungo sa pagtatrabaho sa mga graphic na elemento sa Tk - para sa iba't ibang mga elemento ng input ng data (entry, combobox, checkbutton, atbp.) Ang isang parameter ay ipinakilala bilang isang variable ng teksto:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Ang variable na ito ay tinukoy sa pandaigdigang namespace at naglalaman ng kasalukuyang inilagay na halaga. Yung. upang makuha ang ipinasok na teksto mula sa patlang, kailangan mo lamang basahin ang halaga na naaayon sa variable (siyempre, sa kondisyon na ito ay tinukoy kapag lumilikha ng elemento).

Ang pangalawang paraan para sa pagkuha ng ipinasok na teksto (para sa mga elemento ng uri ng entry) ay ang paggamit ng get command:

.add.frm.ent_name get

Ang parehong mga pamamaraan na ito ay makikita sa code sa itaas.

Ang pag-click sa button na ito, sa kasong ito, ay naglulunsad ng RunCommand procedure na may nabuong command line para sa pagdaragdag ng cluster sa mga tuntunin ng 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

Ngayon ay napunta tayo sa pangunahing utos, na kumokontrol sa paglulunsad ng rac na may mga parameter na kailangan natin, pina-parse din ang output ng mga command sa mga listahan at pagbabalik, kung kinakailangan:

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

Matapos ipasok ang pangunahing data ng server, ito ay idaragdag sa puno, para dito, sa itaas na Add:server procedure, ang sumusunod na code ay may pananagutan:

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

Ngayon, sa pamamagitan ng pag-click sa pangalan ng server sa tree, nakakakuha kami ng listahan ng mga cluster na pinamamahalaan ng server na iyon, at sa pamamagitan ng pag-click sa isang cluster, nakakakuha kami ng listahan ng mga elemento ng cluster (mga server, infobase, atbp.). Ito ay ipinatupad sa pamamaraan ng TreePress (file 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
}

Alinsunod dito, ang Run::server ay ilulunsad para sa pangunahing server (para sa isang cluster - Run::cluster, para sa isang gumaganang server - Run::work_server, atbp.). Yung. ang halaga ng $key variable ay bahagi ng pangalan ng elemento ng puno na tinukoy ng opsyon -id.

Bigyang-pansin natin ang pamamaraan

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

Pinoproseso ng pamamaraang ito ang natanggap mula sa server sa pamamagitan ng utos ng RunCommand at idinaragdag ang lahat ng uri ng mga bagay sa puno - mga kumpol, iba't ibang elemento ng ugat (mga base, gumaganang server, session, at iba pa). Kung titingnan mong mabuti, mapapansin mo ang isang tawag sa pamamaraan ng InsertItemsWorkList sa loob. Ito ay ginagamit upang magdagdag ng mga elemento sa isang graphical na listahan sa pamamagitan ng pagproseso ng output ng rac console utility, na dati ay ibinalik bilang isang listahan sa $lst variable. Ito ay isang listahan ng mga listahan na naglalaman ng mga pares ng mga elemento na pinaghihiwalay ng isang tutuldok.

Halimbawa, isang listahan ng mga kumpol na koneksyon:

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

Sa graphical na anyo ito ay magiging ganito:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pinipili ng pamamaraan sa itaas ang mga pangalan ng mga elemento para sa header at data upang punan ang talahanayan:

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
}

Dito, sa halip na isang simpleng utos [split $str ":"], na naghahati sa string sa mga elemento na pinaghihiwalay ng ":" at nagbabalik ng listahan, isang regular na expression ang ginagamit, dahil ang ilang elemento ay naglalaman din ng colon.

Ang pamamaraan ng InsertClusterItems (isa sa ilang mga katulad) ay nagdaragdag lamang ng isang listahan ng mga elemento ng bata na may kaukulang mga identifier sa puno ng kinakailangang elemento ng cluster
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
}

Maaari mong isaalang-alang ang dalawa pang opsyon para sa pagpapatupad ng katulad na pamamaraan, kung saan malinaw na makikita kung paano mo ma-optimize at mapupuksa ang mga paulit-ulit na utos:

Sa pamamaraang ito, ang pagdaragdag at pagsuri ay malulutas nang direkta:

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

Narito ang isang mas tamang diskarte:

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

Ang pagkakaiba sa pagitan ng mga ito ay ang paggamit ng isang loop, kung saan ang (mga) paulit-ulit na command ay isinasagawa. Aling diskarte ang gagamitin ay nasa pagpapasya ng developer.

Sinakop namin ang pagdaragdag ng mga elemento at pagkuha ng data, ngayon ay oras na upang tumuon sa pag-edit. Dahil, karaniwang, ang parehong mga parameter ay ginagamit para sa pag-edit at pagdaragdag (maliban sa base ng impormasyon), ang parehong mga dialog form ay ginagamit. Ang algorithm para sa mga pamamaraan ng pagtawag para sa pagdaragdag ay ganito ang hitsura:

Magdagdag::$key->AddToplevel

At para sa pag-edit tulad nito:

I-edit::$key->Add::$key->AddTopLevel

Halimbawa, kunin natin ang pag-edit ng isang cluster, i.e. Ang pagkakaroon ng pag-click sa pangalan ng kumpol sa puno, pindutin ang pindutan ng pag-edit sa toolbar (lapis) at ang kaukulang form ay ipapakita sa screen:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk
I-edit::kumpol

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

Batay sa mga komento sa code, sa prinsipyo, ang lahat ay malinaw, maliban na ang button handler code ay na-override at mayroong FormFieldsDataInsert na pamamaraan na pumupuno sa mga field ng data at nagpapasimula ng mga variable:

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

Sa pamamaraang ito, lumitaw ang isa pang bentahe ng tcl - ang mga halaga ng iba pang mga variable ay pinalitan bilang mga pangalan ng variable. Yung. upang i-automate ang pagpuno ng mga form at pagsisimula ng mga variable, ang mga pangalan ng mga patlang at mga variable ay tumutugma sa mga command line switch ng rac utility at ang mga pangalan ng mga parameter ng output ng command na may ilang pagbubukod - ang gitling ay pinalitan ng isang underscore. Hal nakatakdang-trabaho-tanggihan tumutugma sa larangan ent_scheduled_jobs_deny at variable scheduled_jobs_deny.

Ang mga form para sa pagdaragdag at pag-edit ay maaaring magkakaiba sa komposisyon ng mga patlang, halimbawa, nagtatrabaho sa isang base ng impormasyon:

Pagdaragdag ng seguridad ng impormasyon

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pag-edit ng seguridad ng impormasyon

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Sa proseso ng pag-edit na Edit::infobase, ang mga kinakailangang field ay idinagdag sa form; ang code ay napakalaki, kaya hindi ko ito ipinakita dito.

Sa pamamagitan ng pagkakatulad, ang mga pamamaraan para sa pagdaragdag, pag-edit, pagtanggal ay ipinatupad para sa iba pang mga elemento.

Dahil ang pagpapatakbo ng utility ay nagpapahiwatig ng isang walang limitasyong bilang ng mga server, kumpol, base ng impormasyon, atbp., upang matukoy kung aling kumpol ang nabibilang sa kung aling server o sistema ng seguridad ng impormasyon, maraming mga pandaigdigang variable ang ipinakilala, ang mga halaga nito ay itinakda sa bawat isa. oras na nag-click ka sa mga elemento ng puno. Yung. ang pamamaraan ay paulit-ulit na tumatakbo sa lahat ng mga elemento ng magulang at nagtatakda ng mga variable:

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

Ang 1C cluster ay nagpapahintulot sa iyo na magtrabaho nang may pahintulot o walang pahintulot. Mayroong dalawang uri ng mga administrator—administrator ng ahente ng cluster at administrator ng cluster. Alinsunod dito, para sa tamang operasyon, 4 pang pandaigdigang variable ang ipinakilala na naglalaman ng administrator login at password. Yung. kung mayroong administrator account sa cluster, may ipapakitang dialog para ipasok ang iyong login at password, ang data ay ise-save sa memorya at ilalagay sa bawat command para sa kaukulang cluster.

Ito ang responsibilidad ng pamamaraan ng paghawak ng error.

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

Yung. depende sa kung ano ang ibabalik ng utos, ang reaksyon ay magiging naaayon.

Sa ngayon, humigit-kumulang 95 porsiyento ng pag-andar ang naipatupad na, ang natitira na lang ay ipatupad ang trabaho sa mga profile ng seguridad at subukan ito =). Iyon lang. Humihingi ako ng paumanhin para sa gusot na kuwento.

Ang code ay tradisyonal na magagamit dito.

Update: Natapos kong magtrabaho sa mga profile ng seguridad. Ngayon ang pag-andar ay 100% na ipinatupad.

Update 2: naidagdag na ang localization sa English at Russian, nasubok ang trabaho sa win7
Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pinagmulan: www.habr.com

Magdagdag ng komento