Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Nalika urang nalungtik topik kumaha produk 1C tiasa dianggo dina lingkungan Linux, hiji kalemahan kapanggih - kurangna alat multi-platform grafis anu merenah pikeun ngatur klaster server 1C. Sarta eta ieu mutuskeun pikeun ngabenerkeun aral ieu ku nulis GUI pikeun utiliti konsol rac. Tcl/tk dipilih salaku basa pangwangunan, dina pamanggih kuring, anu paling cocog pikeun tugas ieu. Janten, kuring hoyong nampilkeun sababaraha aspék anu pikaresepeun ngeunaan solusi dina bahan ieu.

Pikeun damel anjeun peryogi distribusi tcl/tk sareng 1C. Sareng saprak kuring mutuskeun pikeun ngamangpaatkeun kamampuan pangiriman tcl/tk dasar tanpa nganggo pakét pihak katilu, kuring peryogi versi 8.6.7, anu kalebet ttk - pakét sareng elemen grafis tambahan, anu utamina urang peryogi ttk ::TreeView, ngamungkinkeun tampilan data boh dina wangun struktur tangkal jeung dina bentuk tabel (daptar). Ogé, dina vérsi énggal, padamelan sareng pengecualian parantos didamel deui (paréntah try, anu dianggo dina proyék nalika ngajalankeun paréntah éksternal).

Proyék diwangun ku sababaraha file (sanaos teu aya anu ngahalangan anjeun pikeun ngalakukeun sadayana dina hiji):

rac_gui.cfg - config standar
rac_gui.tcl - naskah peluncuran utama
Diréktori lib ngandung file anu otomatis dimuat nalika ngamimitian:
function.tcl - file kalawan prosedur
gui.tcl - panganteur grafis utama
images.tcl - perpustakaan gambar base64

The rac_gui.tcl file, kanyataanna, dimimitian juru, initializes variabel, beban modul, configs, jeung saterusna. Eusi file kalayan komentar:

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

Saatos unduh sadaya anu diperyogikeun sareng mariksa ayana utilitas rac, jandela grafis bakal diluncurkeun. Antarbeungeut program diwangun ku tilu elemen:

Toolbar, tangkal jeung daptar

Kuring ngadamel eusi "tangkal" sabisa-gancang sareng alat Windows standar tina 1C.

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Kodeu utama anu ngabentuk jandela ieu aya dina 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

Algoritma pikeun gawé bareng program nyaéta kieu:

1. Kahiji, anjeun kudu nambahkeun server klaster utama (ie, server manajemén klaster (dina Linux Ubuntu, manajemén dibuka kalayan paréntah "/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Jang ngalampahkeun ieu, klik tombol "+" sareng dina jandela anu muka, lebetkeun alamat server sareng port:

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Saatos éta, server kami bakal muncul dina tangkal ku ngaklik éta, daptar klaster bakal dibuka atanapi kasalahan sambungan bakal ditingalikeun.

2. Ngaklik dina ngaran klaster bakal muka daptar fungsi sadia pikeun eta.

3.

Jeung saterusna, i.e. pikeun nambahkeun klaster anyar, pilih nu mana wae nu sadia dina daptar tur pencét tombol "+" dina toolbar jeung dialog nambahkeun anyar bakal dipintonkeun:

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Tombol dina tulbar ngalakukeun fungsi gumantung kana konteks, i.e. Gumantung kana unsur tangkal atanapi daptar anu dipilih, hiji atanapi prosedur anu sanés bakal dilakukeun.

Hayu urang tingali conto tombol tambihan ("+"):

Kode generasi tombol:

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

Di dieu urang ningali yén nalika tombol dipencet, prosedur "Tambahkeun" bakal dieksekusi, kode na:

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
}

Ieu salah sahiji kaunggulan tickle: anjeun tiasa ngalangkungan nilai variabel salaku nami prosedur:

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

Nyaéta, contona, upami urang nunjuk ka server utama sareng pencét "+", maka prosedur Add::server bakal diluncurkeun, upami dina klaster - Add::cluster sareng saterasna (Kuring bakal nyerat ngeunaan dimana perlu "konci" asalna di bit handap), prosedur didaptarkeun ngagambar elemen grafis luyu jeung konteks.

Sakumaha anjeun parantos terang, bentukna sami dina gaya - ieu henteu heran, sabab ditampilkeun ku hiji prosedur, langkung tepatna pigura utama bentuk (jandela, tombol, gambar, labél), nami prosedur. 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
}

parameter panggero: judul, Ngaran gambar pikeun ikon ti perpustakaan (lib / images.tcl) sarta parameter ngaran jandela pilihan (standar .add). Janten, upami urang nyandak conto di luhur pikeun nambihan server utama sareng klaster, sauran bakal sasuai:

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

atawa

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

Nya, neraskeun conto ieu, kuring bakal nunjukkeun prosedur anu nampilkeun dialog tambahan pikeun server atanapi klaster.

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

Tambahkeun:: klaster

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
}

Nalika ngabandingkeun kodeu prosedur ieu, bédana katingali ku mata taranjang; Dina Tk, sipat elemen grafis tiasa ditimpa nalika palaksanaan program nganggo pilihan ngonpigurasikeun. Contona, paréntah awal pikeun mintonkeun tombol:

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

Tapi dina bentuk kami, paréntahna gumantung kana fungsionalitas anu diperyogikeun:

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

Dina conto di luhur, tombol "clogged" dimimitian prosedur pikeun nambahkeun klaster.

Di dieu perlu nyieun digression nuju gawé bareng elemen grafis dina Tk - pikeun sagala rupa elemen input data (entry, combobox, checkbutton, jsb) parameter geus diwanohkeun salaku variabel téks:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Variabel ieu dihartikeun dina spasi ngaran global sarta ngandung nilai ayeuna diasupkeun. Jelema. Dina raraga neangan téks diasupkeun ti sawah, anjeun ngan perlu maca nilai pakait jeung variabel (tangtu, disadiakeun yén éta dihartikeun nalika nyieun unsur).

Metodeu kadua pikeun nyandak téks anu dilebetkeun (pikeun unsur jinis éntri) nyaéta nganggo paréntah get:

.add.frm.ent_name get

Duanana métode ieu bisa ditempo dina kode luhur.

Ngaklik tombol ieu, dina hal ieu, ngajalankeun prosedur RunCommand kalawan garis paréntah dihasilkeun pikeun nambahkeun klaster dina watesan 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

Ayeuna urang sumping ka paréntah utama, anu ngatur peluncuran rac kalayan parameter anu urang peryogikeun, ogé ngémutan kaluaran paréntah kana daptar sareng uih deui, upami diperyogikeun:

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

Saatos ngasupkeun data server utama, éta bakal ditambahkeun kana tangkal, pikeun ieu, di luhur Add:prosedur server, kode handap tanggung jawab:

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

Ayeuna, ku ngaklik nami server dina tangkal, urang nampi daptar klaster anu diurus ku server éta, sareng ku ngaklik klaster, urang nampi daptar elemen klaster (server, infobases, jsb.). Ieu dilaksanakeun dina prosedur 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
}

Sasuai, Run :: server bakal dijalankeun pikeun server utama (pikeun klaster - Run :: klaster, pikeun server kerja - Run :: work_server, jsb). Jelema. nilai variabel $ konci mangrupa bagian tina ngaran unsur tangkal dieusian ku pilihan -id.

Hayu urang nengetan prosedur

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

Prosedur ieu ngolah naon anu ditampi ti server ngaliwatan paréntah RunCommand sareng nambihan sagala rupa hal kana tangkal - klaster, rupa-rupa elemen akar (dasar, server kerja, sesi, sareng saterasna). Lamun neuteup taliti, anjeun bakal aya bewara nelepon kana prosedur InsertItemsWorkList jero. Hal ieu dipaké pikeun nambahkeun elemen kana daptar grafis ku cara ngolah kaluaran tina utilitas konsol rac, nu saméméhna balik salaku daptar kana variabel $lst. Ieu daptar daptar anu ngandung pasangan elemen anu dipisahkeun ku titik dua.

Contona, daptar sambungan klaster:

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

Dina bentuk grafis bakal katingali sapertos kieu:

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Prosedur di luhur milih nami elemen pikeun lulugu sareng data pikeun ngeusian tabél:

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
}

Di dieu, tinimbang paréntah basajan [split $str ":"], anu ngabagi string kana elemen anu dipisahkeun ku ":" sareng mulangkeun daptar, ekspresi biasa dianggo, sabab sababaraha elemen ogé ngandung titik dua.

Prosedur InsertClusterItems (salah sahiji tina sababaraha anu sami) ngan saukur nambihan daptar elemen anak sareng identifier anu saluyu kana tangkal unsur klaster anu diperyogikeun.
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
}

Anjeun tiasa mertimbangkeun dua pilihan deui pikeun ngalaksanakeun prosedur anu sami, dimana éta bakal katingali jelas kumaha anjeun tiasa ngaoptimalkeun sareng nyingkirkeun paréntah repetitive:

Dina prosedur ieu, nambahkeun jeung mariksa direngsekeun head-on:

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

Ieu pendekatan anu langkung leres:

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

Beda antara aranjeunna nyaéta pamakéan loop a, nu diulang paréntah (s) anu dieksekusi. Pendekatan mana anu dianggo nyaéta dina kawijaksanaan pamekar.

Kami parantos nutupan nambihan elemen sareng nyandak data, ayeuna waktosna pikeun difokuskeun ngédit. Kusabab, dasarna, parameter anu sami dianggo pikeun ngédit sareng nambihan (iwal dasar inpormasi), bentuk dialog anu sami dianggo. Algoritma pikeun nelepon prosedur pikeun nambahkeun Sigana mah kieu:

Tambahkeun::$key->AddToplevel

Sareng pikeun ngedit sapertos kieu:

Edit::$key->Add::$key->AddTopLevel

Contona, hayu urang nyandak ngédit klaster, i.e. Saatos ngaklik nami klaster dina tangkal, pencét tombol édit dina tulbar (pensil) sareng bentuk anu saluyu bakal ditingalikeun dina layar:

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk
Edit:: klaster

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

Dumasar kana koméntar dina kode, prinsipna mah, sagalana jelas, iwal kodeu Handler tombol ieu overridden sarta aya prosedur FormFieldsDataInsert nu ngeusi widang data sarta initializes variabel:

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

Dina prosedur ieu, kaunggulan sejen tina tcl surfaced - nilai variabel séjén diganti salaku ngaran variabel. Jelema. Pikeun ngajadikeun otomatis ngeusian formulir sareng initialization variabel, nami widang sareng variabel pakait sareng saklar garis paréntah tina utiliti rac sareng nami parameter kaluaran paréntah kalayan sababaraha pengecualian - dash diganti ku underscore. Misalna dijadwalkeun-proyek-mungkir cocog lapangan ent_scheduled_jobs_deny jeung variabel scheduled_jobs_deny.

Formulir pikeun nambihan sareng ngédit tiasa bénten dina komposisi widang, contona, damel sareng pangkalan inpormasi:

Nambahan kaamanan informasi

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Ngédit kaamanan inpormasi

Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

Dina prosedur ngedit Edit:: infobase, widang diperlukeun ditambahkeun kana formulir nu kode téh voluminous, ku kituna kuring teu nampilkeun dieu.

Ku analogi, prosedur pikeun nambahkeun, ngédit, ngahapus dilaksanakeun pikeun elemen séjén.

Kusabab operasi utilitas nunjukkeun jumlah anu henteu terbatas tina server, klaster, pangkalan inpormasi, sareng sajabana, pikeun nangtoskeun klaster mana milik server atanapi sistem kaamanan inpormasi, sababaraha variabel global parantos diwanohkeun, nilai-nilai anu disetél masing-masing. waktos Anjeun klik dina elemen tangkal. Jelema. prosedur recursively ngalir ngaliwatan sakabeh elemen indungna sarta susunan variabel:

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

Kluster 1C ngamungkinkeun anjeun damel sareng atanapi henteu nganggo otorisasi. Aya dua jinis pangurus - administrator agén klaster sareng administrator klaster. Sasuai, pikeun operasi anu leres, 4 langkung variabel global diwanohkeun anu ngandung login administrator sareng kecap akses. Jelema-jelema. lamun aya hiji akun administrator dina klaster, dialog bakal dipintonkeun pikeun asupkeun login sareng kecap akses Anjeun, data bakal disimpen dina mémori jeung diselapkeun kana unggal paréntah pikeun klaster pakait.

Ieu tanggung jawab prosedur penanganan kasalahan.

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

Jelema. gumantung kana naon paréntah mulih, réaksi bakal sasuai.

Ayeuna, sakitar 95 persén pungsionalitasna parantos dilaksanakeun, anu sésana nyaéta ngalaksanakeun padamelan sareng profil kaamanan sareng nguji éta =). Éta hungkul. Hapunten tina carita anu kusut.

Kodeu sacara tradisional sayogi di dieu.

Update: Kuring réngsé gawé bareng propil kaamanan. Ayeuna pungsionalitasna 100% dilaksanakeun.

Update 2: lokalisasi kana basa Inggris jeung Rusia geus ditambahkeun, karya dina win7 geus diuji
Urang nulis GUI pikeun 1C RAC, atawa deui ngeunaan Tcl / Tk

sumber: www.habr.com

Tambahkeun komentar