Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Þegar við kafaði ofan í efnið hvernig 1C vörur virka í Linux umhverfinu, kom einn galli í ljós - skortur á þægilegu grafísku multi-palla tóli til að stjórna þyrping af 1C netþjónum. Og það var ákveðið að leiðrétta þennan galla með því að skrifa GUI fyrir rac console gagnsemina. Tcl/tk var valið sem þróunarmálið sem hentaði að mínu mati best í þetta verkefni. Og svo vil ég kynna nokkrar áhugaverðar hliðar lausnarinnar í þessu efni.

Til að vinna þarftu tcl/tk og 1C dreifingar. Og þar sem ég ákvað að nýta sem mest getu tcl/tk sendingarinnar án þess að nota þriðja aðila pakka, þarf ég útgáfu 8.6.7, sem inniheldur ttk - pakka með viðbótar grafískum þáttum, sem við þurfum aðallega ttk af. ::TreeView, það gerir kleift að birta gögn bæði í formi trébyggingar og í formi töflu (lista). Einnig, í nýju útgáfunni, hefur vinnan með undantekningum verið endurunnin (reyna skipunin, sem er notuð í verkefninu þegar ytri skipanir eru keyrðar).

Verkefnið samanstendur af nokkrum skrám (þó ekkert komi í veg fyrir að þú gerir allt í einu):

rac_gui.cfg - sjálfgefin stilling
rac_gui.tcl - aðalræsingarforskrift
Lib möppan inniheldur skrár sem eru sjálfkrafa hlaðnar við ræsingu:
function.tcl - skrá með verklagsreglum
gui.tcl - grafískt aðalviðmót
images.tcl - base64 myndasafn

Rac_gui.tcl skráin ræsir reyndar túlkinn, frumstillir breytur, hleður einingar, stillingar og svo framvegis. Innihald skráar með athugasemdum:

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

Eftir að hafa hlaðið niður öllu sem þarf og athugað hvort rac tólið sé til staðar mun grafískur gluggi opnast. Viðmót forritsins samanstendur af þremur þáttum:

Tækjastika, tré og listi

Ég gerði innihald „trésins“ eins líkt og hægt var og venjulegum Windows búnaði frá 1C.

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Aðalkóðinn sem myndar þennan glugga er að finna í skránni
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

Reikniritið til að vinna með forritið er sem hér segir:

1. Fyrst þarftu að bæta við aðal klasaþjóninum (þ.e. klasastjórnunarþjóninum (í Linux er stjórnun ræst með skipuninni “/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Til að gera þetta, smelltu á „+“ hnappinn og í glugganum sem opnast, sláðu inn heimilisfang netþjóns og höfn:

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Eftir það mun þjónninn okkar birtast í trénu með því að smella á hann, listi yfir klasa opnast eða tengingarvilla birtist.

2. Með því að smella á nafn klasans opnast listi yfir aðgerðir sem eru tiltækar fyrir hann.

3.…

Og svo framvegis, þ.e. til að bæta við nýjum klasa, veldu einhvern sem er tiltækur á listanum og ýttu á „+“ hnappinn á tækjastikunni og þá birtist glugginn bæta við nýjum:

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Hnapparnir á tækjastikunni framkvæma aðgerðir eftir samhengi, þ.e. Það fer eftir því hvaða þáttur trésins eða lista er valinn, ein eða önnur aðferð verður framkvæmd.

Við skulum skoða dæmið um bæta við hnappinn (“+”):

Kóði fyrir hnappagerð:

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

Hér sjáum við að þegar ýtt er á hnappinn verður „Bæta við“ ferlinu fram, kóði þess:

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
}

Hér er einn af kostunum við kitla: þú getur sent gildi breytu sem aðferðarheiti:

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

Það er, til dæmis, ef við bendum á aðalþjóninn og ýtum á “+”, þá verður Add::server aðferðin ræst, ef við þyrpinguna - Add::cluster og svo framvegis (ég mun skrifa um hvar nauðsynlegir „lyklar“ koma aðeins hér að neðan), teikna upptaldar aðferðir grafíska þætti sem hæfa samhenginu.

Eins og þú hefur kannski þegar tekið eftir eru eyðublöðin svipuð í stíl - þetta kemur ekki á óvart, vegna þess að þau eru birt með einni aðferð, nánar tiltekið aðalramma eyðublaðsins (gluggi, hnappar, mynd, merki), heiti aðferðarinnar. 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
}

Símtalsfæribreytur: titill, myndheiti fyrir táknið úr bókasafninu (lib/images.tcl) og valfrjáls færibreyta fyrir gluggaheiti (sjálfgefið .add). Þannig, ef við tökum ofangreind dæmi til að bæta við aðalþjóninum og þyrpingunni, mun símtalið vera í samræmi við það:

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

eða

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

Jæja, áfram með þessi dæmi mun ég sýna verklagsreglurnar sem birta viðbótarglugga fyrir netþjón eða þyrping.

Bæta við::þjón

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
}

Bæta við::þyrping

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
}

Þegar þú berð saman kóða þessara aðferða er munurinn sýnilegur með berum augum; ég mun einbeita mér að „Ok“ hnappastjórnun. Í Tk er hægt að hnekkja eiginleikum grafískra þátta við framkvæmd forritsins með því að nota valkostinn stilla. Til dæmis, upphafsskipunin til að birta hnappinn:

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

En í eyðublöðum okkar fer skipunin eftir nauðsynlegri virkni:

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

Í dæminu hér að ofan byrjar „stíflaður“ hnappurinn ferlið við að bæta við klasa.

Hér er þess virði að víkja að því að vinna með grafíska þætti í Tk - fyrir ýmsa gagnainnsláttarþætti (innsláttur, combobox, gáthnappur o.s.frv.) hefur breytu verið kynnt sem textabreyta:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Þessi breyta er skilgreind í hinu alþjóðlega nafnrými og inniheldur gildið sem nú er slegið inn. Þeir. til þess að ná inn textanum úr reitnum þarftu bara að lesa gildið sem samsvarar breytunni (að sjálfsögðu að því gefnu að það sé skilgreint þegar frumefnið er búið til).

Önnur aðferðin til að sækja inn textann (fyrir þætti af færslugerð) er að nota get skipunina:

.add.frm.ent_name get

Báðar þessar aðferðir má sjá í kóðanum hér að ofan.

Með því að smella á þennan hnapp, í þessu tilviki, ræsir RunCommand málsmeðferðina með myndaðri skipanalínunni til að bæta við þyrpingu hvað varðar 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

Nú komum við að aðalskipuninni, sem stjórnar ræsingu rac með þeim breytum sem við þurfum, greinir einnig úttak skipana í lista og skilar, ef þess er krafist:

Run Command

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

Eftir að aðalmiðlaragögnin eru slegin inn verður þeim bætt við tréð, fyrir þetta, í ofangreindu Add:server ferlinu, er eftirfarandi kóði ábyrgur:

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

Nú, með því að smella á netþjónnafnið í trénu fáum við lista yfir klasa sem stjórnað er af þeim netþjóni og með því að smella á klasa fáum við lista yfir klasaþætti (þjóna, upplýsingabasa osfrv.). Þetta er útfært í TreePress ferlinu (skrá 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
}

Í samræmi við það verður Run::þjónn ræstur fyrir aðalþjóninn (fyrir klasa - Run::cluster, fyrir virkan netþjón - Run::work_server o.s.frv.). Þeir. gildi $key breytunnar er hluti af nafni tréþáttarins sem valkosturinn tilgreinir -kenni.

Við skulum gefa gaum að málsmeðferðinni

Keyra::þjónn

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

Þessi aðferð vinnur úr því sem barst frá þjóninum í gegnum RunCommand skipunina og bætir alls kyns hlutum við tréð - klösum, ýmsum rótarþáttum (basar, starfandi netþjónar, lotur og svo framvegis). Ef þú lítur vel, munt þú taka eftir því að hringt er í InsertItemsWorkList málsmeðferðina inni. Það er notað til að bæta þáttum við myndrænan lista með því að vinna úttak rac console tólsins, sem áður var skilað sem listi í $lst breytuna. Þetta er listi yfir lista sem innihalda pör af þáttum aðskilin með tvípunkti.

Til dæmis, listi yfir klasatengingar:

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

Í myndrænu formi mun það líta einhvern veginn svona út:

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Aðferðin hér að ofan velur nöfn þátta fyrir hausinn og gögnin til að fylla út töfluna:

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
}

Hér, í stað einfaldrar skipunar [split $str ":"], sem skiptir strengnum í þætti aðskilin með ":" og skilar lista, er notuð regluleg segð, þar sem sumir þættir innihalda einnig tvípunkt.

Aðferðin InsertClusterItems (ein af nokkrum svipuðum) bætir einfaldlega lista yfir undireiningar með samsvarandi auðkennum við tréð á nauðsynlegum klasaeiningum
Settu inn ClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Информационные базы" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Рабочие серверы" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Администраторы" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Менеджеры кластера" -values $id
    $tree insert $parent end -id "processes::$id" -text "Рабочие процессы" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Соединения" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Профили безопасности" -values $id
}

Þú getur íhugað tvo möguleika til viðbótar til að innleiða svipaða aðferð, þar sem það verður greinilega sýnilegt hvernig þú getur fínstillt og losað þig við endurteknar skipanir:

Í þessu ferli er bætt við og athugað leyst beint:

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

Hér er réttari nálgun:

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

Munurinn á þeim er notkun lykkju, þar sem endurteknar skipanir eru framkvæmdar. Hvaða nálgun á að nota er á valdi framkvæmdaraðila.

Við höfum fjallað um að bæta við þáttum og sækja gögn, nú er kominn tími til að einbeita sér að klippingum. Þar sem í grundvallaratriðum eru sömu færibreytur notaðar til að breyta og bæta við (að undanskildum upplýsingagrunninum), eru sömu gluggaformin notuð. Reikniritið fyrir að hringja í verklagsreglur til að bæta við lítur svona út:

Bæta við::$key->AddToplevel

Og fyrir að breyta svona:

Breyta::$key->Add::$key->AddTopLevel

Tökum sem dæmi að breyta klasa, þ.e. Eftir að hafa smellt á nafn klasans í trénu, ýttu á edit hnappinn á tækjastikunni (blýantur) og samsvarandi eyðublað birtist á skjánum:

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk
Edit::cluster

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

Miðað við athugasemdirnar í kóðanum er í grundvallaratriðum allt skýrt, nema að hnappastjórnunarkóði er hnekkt og það er FormFieldsDataInsert ferli sem fyllir reitina af gögnum og frumstillir breyturnar:

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

Í þessari aðferð kom annar kostur við tcl upp á yfirborðið - gildum annarra breyta er skipt út fyrir breytuheiti. Þeir. til að gera sjálfvirkan útfyllingu eyðublaða og frumstilla breytur samsvara nöfn reita og breyta skipanalínurofum rac tólsins og nöfnum á úttaksbreytum skipana með einhverjum undantekningum - strikinu er skipt út fyrir undirstrik. Td áætlað-störf-neita passar við völlinn ent_scheduled_jobs_ney og breytilegt áætlað_störf_neita.

Eyðublöð til að bæta við og breyta geta verið mismunandi í samsetningu reitanna, til dæmis þegar unnið er með upplýsingagrunn:

Bætir við upplýsingaöryggi

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Breyta upplýsingaöryggi

Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Í klippingarferlinu Edit::infobase er nauðsynlegum reitum bætt við eyðublaðið; kóðinn er umfangsmikill, þess vegna legg ég hann ekki fram hér.

Á hliðstæðan hátt eru verklagsreglur til að bæta við, breyta, eyða útfærðar fyrir aðra þætti.

Þar sem rekstur tólsins felur í sér ótakmarkaðan fjölda netþjóna, klasa, upplýsingagrunna o.s.frv., til að ákvarða hvaða klasi tilheyrir hvaða netþjóni eða upplýsingaöryggiskerfi, hafa nokkrar alþjóðlegar breytur verið kynntar, gildin sem eru stillt á hvern þegar þú smellir á þætti trésins. Þeir. aðferðin keyrir endurkvæmt í gegnum alla foreldraþætti og setur breyturnar:

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 þyrpingin gerir þér kleift að vinna með eða án heimildar. Það eru tvenns konar stjórnendur - klasaumboðsstjóri og klasastjórnandi. Í samræmi við það, fyrir rétta notkun, voru 4 fleiri alþjóðlegar breytur kynntar sem innihalda innskráningu stjórnanda og lykilorð. Þeir. ef það er stjórnandi reikningur í þyrpingunni birtist gluggi til að slá inn notandanafnið þitt og lykilorð, gögnin verða vistuð í minni og sett inn í hverja skipun fyrir samsvarandi þyrping.

Þetta er á ábyrgð villumeðferðarferlisins.

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

Þeir. eftir því hverju skipunin skilar verða viðbrögðin í samræmi við það.

Í augnablikinu er búið að innleiða um 95 prósent af virkninni, það eina sem er eftir er að innleiða vinnu með öryggissnið og prófa það =). Það er allt og sumt. Ég biðst afsökunar á krumpuðu sögunni.

Kóðinn er venjulega fáanlegur hér.

Uppfærsla: Ég kláraði að vinna með öryggissnið. Nú er virknin 100% útfærð.

Uppfærsla 2: staðfærsla á ensku og rússnesku hefur verið bætt við, vinna í win7 hefur verið prófuð
Að skrifa GUI fyrir 1C RAC, eða aftur um Tcl/Tk

Heimild: www.habr.com

Bæta við athugasemd