GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Iedziļinoties tēmā par to, kā 1C produkti darbojas Linux vidē, tika atklāts viens trūkums - ērta grafiskā daudzplatformu rīka trūkums 1C serveru klastera pārvaldīšanai. Un tika nolemts labot šo trūkumu, uzrakstot GUI rac konsoles utilītai. Tcl/tk kā izstrādes valoda tika izvēlēta kā, manuprāt, vispiemērotākā šim uzdevumam. Un tāpēc es vēlētos iepazīstināt ar dažiem interesantiem risinājuma aspektiem šajā materiālā.

Lai strādātu, jums būs nepieciešami tcl/tk un 1C sadalījumi. Un tā kā es nolēmu maksimāli izmantot pamata tcl/tk piegādes iespējas, neizmantojot trešo pušu pakotnes, man būs nepieciešama versija 8.6.7, kas ietver ttk - pakotni ar papildu grafiskajiem elementiem, no kuriem mums galvenokārt ir nepieciešams ttk ::TreeView, tas ļauj attēlot datus gan koka struktūras veidā, gan tabulas (saraksta) veidā. Tāpat jaunajā versijā ir pārstrādāts darbs ar izņēmumiem (komanda try, kas tiek izmantota projektā, izpildot ārējās komandas).

Projekts sastāv no vairākiem failiem (lai gan nekas neliedz jums visu darīt vienā):

rac_gui.cfg — noklusējuma konfigurācija
rac_gui.tcl — galvenais palaišanas skripts
Lib direktorijā ir faili, kas tiek automātiski ielādēti startēšanas laikā:
function.tcl - fails ar procedūrām
gui.tcl - galvenais grafiskais interfeiss
images.tcl — base64 attēlu bibliotēka

Fails rac_gui.tcl faktiski palaiž tulku, inicializē mainīgos, ielādē moduļus, konfigurācijas un tā tālāk. Faila saturs ar komentāriem:

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

Pēc visa nepieciešamā lejupielādes un rac utilīta pārbaudes, tiks atvērts grafiskais logs. Programmas saskarne sastāv no trim elementiem:

Rīkjosla, koks un saraksts

“Koka” saturu veidoju pēc iespējas līdzīgu standarta Windows aprīkojumam no 1C.

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Galvenais kods, kas veido šo logu, ir ietverts failā
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

Algoritms darbam ar programmu ir šāds:

1. Vispirms jāpievieno galvenais klastera serveris (t.i., klasteru pārvaldības serveris (operētājsistēmā Linux pārvaldība tiek palaista ar komandu “/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Lai to izdarītu, noklikšķiniet uz pogas “+” un atvērtajā logā ievadiet servera adresi un portu:

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Pēc tam mūsu serveris parādīsies kokā, noklikšķinot uz tā, tiks atvērts klasteru saraksts vai tiks parādīta savienojuma kļūda.

2. Noklikšķinot uz klastera nosaukuma, tiks atvērts tam pieejamo funkciju saraksts.

3. ...

Un tā tālāk, t.i. lai pievienotu jaunu klasteru, sarakstā atlasiet jebkuru no tiem un nospiediet pogu “+” rīkjoslā, un tiks parādīts dialoglodziņš Pievienot jaunu:

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Rīkjoslas pogas pilda funkcijas atkarībā no konteksta, t.i. Atkarībā no tā, kurš koka vai saraksta elements ir izvēlēts, tiks veikta viena vai otra procedūra.

Apskatīsim pievienošanas pogas (“+”) piemēru:

Pogu ģenerēšanas kods:

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

Šeit redzams, ka, nospiežot pogu, tiks izpildīta procedūra “Pievienot”, tās kods:

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
}

Šeit ir viena no kutināšanas priekšrocībām: mainīgā vērtību varat nodot kā procedūras nosaukumu:

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

Tas ir, piemēram, ja mēs norādīsim uz galveno serveri un nospiedīsim “+”, tad tiks palaista procedūra Add::server, ja klasterī - Add::cluster un tā tālāk (rakstīšu par to, kur nepieciešamās “atslēgas” nāk no nedaudz zemāk), uzskaitītās procedūras zīmē kontekstam atbilstošus grafiskos elementus.

Kā jau esat pamanījuši, veidlapas pēc stila ir līdzīgas - tas nav pārsteidzoši, jo tās tiek parādītas ar vienu procedūru, precīzāk, formas galvenais rāmis (logs, pogas, attēls, etiķete), procedūras nosaukums 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
}

Izsaukuma parametri: nosaukums, bibliotēkas ikonas attēla nosaukums (lib/images.tcl) un izvēles loga nosaukuma parametrs (noklusējums .add). Tādējādi, ja ņemam vērā iepriekš minētos piemērus galvenā servera un klastera pievienošanai, zvans būs attiecīgi:

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

vai

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

Nu, turpinot ar šiem piemēriem, es parādīšu procedūras, kas parāda pievienošanas dialoglodziņus serverim vai klasterim.

Pievienot::serveri

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
}

Pievienot::klasteri

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
}

Salīdzinot šo procedūru kodu, atšķirība ir redzama ar neapbruņotu aci; es koncentrēšos uz pogas “Ok” apstrādātāju. Programmā Tk grafisko elementu īpašības var ignorēt programmas izpildes laikā, izmantojot opciju konfigurēt. Piemēram, sākotnējā komanda, lai parādītu pogu:

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

Bet mūsu veidlapās komanda ir atkarīga no nepieciešamās funkcionalitātes:

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

Iepriekš minētajā piemērā poga “aizsērējusi” sāk klastera pievienošanas procedūru.

Šeit ir vērts izdarīt atkāpi attiecībā uz darbu ar grafiskajiem elementiem Tk - dažādiem datu ievades elementiem (ieraksts, kombinētais lodziņš, pārbaudes poga utt.) ir ieviests parametrs kā teksta mainīgais:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Šis mainīgais ir definēts globālajā nosaukumvietā un satur pašlaik ievadīto vērtību. Tie. lai no lauka dabūtu ievadīto tekstu, vajag tikai nolasīt mainīgajam atbilstošo vērtību (protams, ja tā ir definēta elementa veidošanā).

Otrā metode ievadītā teksta izgūšanai (ievadīšanas veida elementiem) ir izmantot komandu get:

.add.frm.ent_name get

Abas šīs metodes var redzēt iepriekš minētajā kodā.

Noklikšķinot uz šīs pogas, šajā gadījumā tiek palaista RunCommand procedūra ar ģenerētu komandrindu klastera pievienošanai rac ziņā:

/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

Tagad mēs nonākam pie galvenās komandas, kas kontrolē rac palaišanu ar mums nepieciešamajiem parametriem, arī parsē komandu izvadi sarakstos un atgriež, ja nepieciešams:

PalaistCommand

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

Pēc galvenā servera datu ievadīšanas tie tiks pievienoti kokam, par to iepriekš minētajā Add:server procedūrā ir atbildīgs šāds kods:

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

Tagad, noklikšķinot uz servera nosaukuma kokā, mēs iegūstam šī servera pārvaldīto klasteru sarakstu, un, noklikšķinot uz klastera, mēs iegūstam klastera elementu sarakstu (serveri, informācijas bāzes utt.). Tas tiek ieviests TreePress procedūrā (fails 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
}

Attiecīgi galvenajam serverim tiks palaists Run::server (klasterim - Run::cluster, strādājošam serverim - Run::work_server utt.). Tie. mainīgā $key vērtība ir daļa no opcijas norādītā koka elementa nosaukuma id.

Pievērsīsim uzmanību procedūrai

Palaist::serveris

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

Šī procedūra apstrādā to, kas tika saņemts no servera, izmantojot komandu RunCommand, un pievieno kokam visu veidu lietas - klasteri, dažādus saknes elementus (bāzes, darba serverus, sesijas utt.). Ja paskatās uzmanīgi, iekšpusē pamanīsit izsaukumu uz InsertItemsWorkList procedūru. To izmanto, lai pievienotu elementus grafiskajam sarakstam, apstrādājot rac konsoles utilīta izvadi, kas iepriekš tika atgriezta kā saraksts mainīgajam $lst. Šis ir sarakstu saraksts, kurā ir elementu pāri, kas atdalīti ar kolu.

Piemēram, klasteru savienojumu saraksts:

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

Grafiskā formā tas izskatīsies apmēram šādi:

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Iepriekš minētā procedūra atlasa elementu nosaukumus galvenei un datiem, lai aizpildītu tabulu:

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
}

Šeit vienkāršas komandas [split $str ":"] vietā, kas sadala virkni elementos, kas atdalīti ar ":" un atgriež sarakstu, tiek izmantota regulāra izteiksme, jo daži elementi satur arī kolu.

Procedūra InsertClusterItems (viena no vairākām līdzīgām) vienkārši pievieno bērnelementu sarakstu ar atbilstošiem identifikatoriem vajadzīgā klastera elementa kokam.
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
}

Varat apsvērt vēl divas iespējas līdzīgas procedūras ieviešanai, kur būs skaidri redzams, kā optimizēt un atbrīvoties no atkārtotām komandām:

Šajā procedūrā pievienošana un pārbaude tiek atrisināta uzreiz:

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

Šeit ir pareizāka pieeja:

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

Atšķirība starp tām ir cilpas izmantošana, kurā tiek izpildīta(-as) atkārtota(-as) komanda(-as). To, kuru pieeju izmantot, nosaka izstrādātājs.

Esam aplūkojuši elementu pievienošanu un datu izgūšanu, tagad ir laiks pievērsties rediģēšanai. Tā kā pamatā rediģēšanai un pievienošanai tiek izmantoti vieni un tie paši parametri (izņemot informācijas bāzi), tiek izmantotas vienas un tās pašas dialoga formas. Pievienošanas procedūru izsaukšanas algoritms izskatās šādi:

Add::$key->AddToplevel

Un rediģēšanai šādi:

Rediģēt::$key->Add::$key->AddTopLevel

Piemēram, pieņemsim klastera rediģēšanu, t.i. Noklikšķinot uz klastera nosaukuma kokā, nospiediet rediģēšanas pogu rīkjoslā (zīmulis), un ekrānā tiks parādīta atbilstošā forma:

GUI rakstīšana 1C RAC vai atkal par 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
    }
}

Pamatojoties uz komentāriem kodā, principā viss ir skaidrs, izņemot to, ka tiek ignorēts pogu apstrādātāja kods un ir FormFieldsDataInsert procedūra, kas aizpilda laukus ar datiem un inicializē mainīgos:

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

Šajā procedūrā parādījās vēl viena tcl priekšrocība - citu mainīgo vērtības tiek aizstātas kā mainīgo nosaukumi. Tie. lai automatizētu veidlapu aizpildīšanu un mainīgo inicializēšanu, lauku un mainīgo nosaukumi atbilst rac utilīta komandrindas slēdžiem un komandu izvades parametru nosaukumiem ar dažiem izņēmumiem - domuzīme tiek aizstāta ar pasvītrojumu. Piem ieplānots-darbs-liegts atbilst laukumam ent_scheduled_jobs_deny un mainīgs ieplānotie_darbi_aizliegt.

Pievienošanas un rediģēšanas veidlapas var atšķirties pēc lauku sastāva, piemēram, strādājot ar informācijas bāzi:

Informācijas drošības pievienošana

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Informācijas drošības rediģēšana

GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Rediģēšanas procedūrā Edit::infobase veidlapai tiek pievienoti nepieciešamie lauki, kods ir apjomīgs, tāpēc šeit to nesniedzu.

Pēc analoģijas citiem elementiem tiek ieviestas pievienošanas, rediģēšanas un dzēšanas procedūras.

Tā kā utilītas darbība nozīmē neierobežotu skaitu serveru, klasteru, informācijas bāzu utt., lai noteiktu, kurš klasteris kuram serverim vai informācijas drošības sistēmai pieder, ir ieviesti vairāki globālie mainīgie, kuru vērtības tiek iestatītas katrai. kad noklikšķināt uz koka elementiem. Tie. procedūra rekursīvi iet cauri visiem vecākelementiem un iestata mainīgos:

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 klasteris ļauj strādāt ar vai bez atļaujas. Ir divu veidu administratori — klastera aģenta administrators un klastera administrators. Attiecīgi pareizai darbībai tika ieviesti vēl 4 globālie mainīgie, kas satur administratora pieteikumvārdu un paroli. Tie. ja klasterī ir administratora konts, tiks parādīts dialoglodziņš, lai ievadītu pieteikumvārdu un paroli, dati tiks saglabāti atmiņā un ievietoti katrā attiecīgā klastera komandā.

Tā ir atbildība par kļūdu apstrādes procedūru.

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

Tie. atkarībā no tā, ko komanda atgriež, reakcija būs atbilstoša.

Šobrīd ir ieviesti aptuveni 95 procenti funkcionalitātes, atliek tikai ieviest darbu ar drošības profiliem un to pārbaudīt =). Tas ir viss. Es atvainojos par saburzīto stāstu.

Kods ir tradicionāli pieejams šeit.

Atjauninājums: esmu pabeidzis darbu ar drošības profiliem. Tagad funkcionalitāte ir 100% ieviesta.

2. atjauninājums: pievienota lokalizācija angļu un krievu valodā, pārbaudīts darbs win7
GUI rakstīšana 1C RAC vai atkal par Tcl/Tk

Avots: www.habr.com

Pievieno komentāru