Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Samtang among gisusi ang hilisgutan kung giunsa ang mga produkto sa 1C nagtrabaho sa palibot sa linux, usa ka disbentaha ang nadiskubre - ang kakulang sa usa ka kombenyente nga graphical multiplatform nga himan alang sa pagdumala sa usa ka 1C server cluster. Ug nakahukom nga ayohon kini nga kakulangan pinaagi sa pagsulat sa usa ka GUI alang sa rac console utility. Ang development language kay tcl/tk kay, sa akong opinyon, ang pinakahaom para ani nga buluhaton. Ug karon, gusto nakong ipresentar ang pipila ka makapaikag nga mga aspeto sa solusyon niini nga materyal.

Aron magtrabaho, kinahanglan nimo ang tcl / tk ug 1C nga pag-apod-apod. Ug tungod kay nakahukom ko nga pahimuslan ang kadaghanan sa mga posibilidad sa batakang paghatud sa tcl / tk nga walay paggamit sa mga third-party nga mga pakete, kinahanglan namon ang bersyon 8.6.7, nga naglakip sa ttk - usa ka pakete nga adunay dugang nga mga elemento sa graphic, diin kinahanglan namon ang panguna nga ttk :: TreeView, kini nagtugot sa output data sa duha sa porma sa usa ka kahoy nga gambalay ug sa porma sa usa ka lamesa (listahan). Usab, ang trabaho nga adunay mga eksepsiyon gidesinyo pag-usab sa bag-ong bersyon (ang pagsulay nga sugo, nga gigamit sa proyekto kung nagdagan sa gawas nga mga sugo).

Ang proyekto naglangkob sa daghang mga file (bisan kung wala’y makapugong sa tanan nga mahimong usa):

rac_gui.cfg - default config
rac_gui.tcl - panguna nga script sa pagsugod
Ang direktoryo sa lib naglangkob sa mga file nga awtomatikong gikarga sa pagsugod:
function.tcl - file nga adunay mga pamaagi
gui.tcl - nag-unang GUI
images.tcl - base64 image library

Ang rac_gui.tcl file, sa tinuud, naglansad sa tighubad, nag-initialize sa mga variable, nag-load sa mga module, mga config, ug uban pa. Ang sulod sa file nga adunay mga komento:

rac_gui.tcl

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

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

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

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

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

Human ma-download ang tanan nga gikinahanglan ug susihon ang presensya sa rac utility, usa ka window sa graphic ang ilunsad. Ang interface sa programa naglangkob sa tulo ka mga elemento:

Toolbar, kahoy ug lista

Gihimo nako ang sulod sa "kahoy" nga susama kutob sa mahimo sa regular nga windows-equipment gikan sa 1C.

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Ang nag-unang code nga nagporma niini nga bintana naa sa file
lib/gui.tcl

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

ttk::style theme use clam

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

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

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

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

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

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

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

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

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

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

Ang algorithm sa pagtrabaho kauban ang programa mao ang mga musunud:

1. Sa sinugdanan, kinahanglan nimong idugang ang main cluster server (ie ang cluster management server (sa linux, ang pagdumala gisugdan pinaagi sa command "/opt/1C/v8.3/x86_64/ras cluster -daemon")).

Aron mahimo kini, pag-klik sa "+" nga buton ug sa bintana nga magbukas, isulud ang adres sa server ug pantalan:

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Pagkahuman niana, ang among server makita sa kahoy pinaagi sa pag-klik niini, usa ka lista sa mga cluster ang maablihan o usa ka sayup sa koneksyon ang ipakita.

2. Ang pag-klik sa cluster name moabli sa listahan sa mga function nga magamit niini.

3.…

Aw, ug uban pa, i.e. aron makadugang ug bag-ong cluster, pilia ang bisan unsa nga anaa sa lista ug pindota ang "+" nga buton sa toolbar ug ang dialog para sa pagdugang ug bag-o ipakita:

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Ang mga buton sa toolbar naghimo sa mga gimbuhaton depende sa konteksto, i.e. depende kung unsang elemento sa kahoy o lista ang gipili, kini o kana nga pamaagi ipahigayon.

Tagda ang pananglitan sa add button (“+”):

Kodigo sa pagporma sa buton:

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

Dinhi atong makita nga kung ang buton gipugos, ang "Add" nga pamaagi ipatuman, ang code niini mao ang:

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
}

Dinhi ang usa sa mga plus sa mga tickle nga gisusi - mahimo nimong ipasa ang kantidad sa usa ka variable ingon nga ngalan sa pamaagi:

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

Kana mao, pananglitan, kon kita modukdok ngadto sa main server ug mopindot sa “+”, ang Add::server procedure ilusad, kon ngadto sa cluster — Add::cluster, ug uban pa (Ako mosulat og gamay mahitungod sa diin ang gikinahanglan nga "mga yawe" gikan sa ubos), ang nalista nga mga pamaagi nagdrowing og mga graphical nga elemento nga haom sa konteksto.

Sama sa imong namatikdan, ang mga porma parehas sa istilo - dili kini katingad-an, tungod kay gipakita kini sa usa ka pamaagi, labi ka tukma, ang panguna nga bayanan sa porma (bintana, butones, imahe, label), ang ngalan sa pamaagi AddTopLevel

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

Mga parameter sa pagtawag: titulo, ngalan sa imahe alang sa icon gikan sa librarya (lib/images.tcl) ug opsyonal nga parameter sa ngalan sa bintana (default .add). Busa, kung atong kuhaon ang mga pananglitan sa ibabaw aron idugang ang nag-unang server ug cluster, nan ang tawag mahimong, matag usa:

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

o

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

Aw, pagpadayon sa kini nga mga pananglitan, akong ipakita ang mga pamaagi nga nagpakita sa pagdugang mga diyalogo alang sa usa ka server o cluster.

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

Idugang::cluster

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
}

Kung itandi ang code niini nga mga pamaagi, ang kalainan makita sa hubo nga mata, ako mag-focus sa OK button handler. Sa Tk, ang mga kabtangan sa mga elemento sa grapiko mahimong ma-override sa runtime nga adunay kapilian i-configure. Pananglitan, ang inisyal nga buton output nga sugo:

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

Apan sa among mga porma, ang mando nagdepende sa gikinahanglan nga gamit:

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

Sa pananglitan sa ibabaw, ang buton nga "crammed" nagsugod sa pamaagi alang sa pagdugang usa ka cluster.

Dinhi angayan nga maghimo usa ka digression padulong sa pagtrabaho sa mga elemento sa grapiko sa Tk - alang sa lainlaing mga elemento sa pag-input sa data (entry, combobox, checkbutton, ug uban pa), ang ingon usa ka parameter ingon usa ka variable sa teksto (textvariable) gipaila:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Kini nga variable gihubit sa global namespace ug adunay sulod nga gisulod nga kantidad. Mga. aron makuha ang gisulod nga teksto gikan sa uma, kinahanglan nimo nga basahon ang kantidad nga katumbas sa variable (siyempre, kung kini gihubit kung ang elemento gihimo).

Ang ikaduha nga paagi sa pagkuha sa gisulod nga teksto (alang sa mga elemento sa type entry) mao ang paggamit sa get command:

.add.frm.ent_name get

Ang duha niini nga mga pamaagi makita sa code sa ibabaw.

Ang pagpindot niini nga buton, sa kini nga kaso, naglansad sa pamaagi sa RunCommand uban ang namugna nga cluster nga nagdugang sa command string sa termino sa 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

Mao nga nakaabut kami sa panguna nga mando, nga nagkontrol sa paglansad sa rac nga adunay mga parameter nga kinahanglan namon, gi-parse usab ang output sa mga mando sa mga lista ug pagbalik, kung kinahanglan:

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

Human sa pagsulod sa data sa nag-unang server, kini idugang sa kahoy, alang niini, sa Add:server nga pamaagi sa ibabaw, ang mosunod nga code mao ang responsable:

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

Karon, pinaagi sa pag-klik sa ngalan sa server sa kahoy, nakakuha kami usa ka lista sa mga cluster nga gidumala niini nga server, ug pinaagi sa pag-klik sa usa ka cluster, nakakuha kami usa ka lista sa mga elemento sa cluster (mga server, infobase, ug uban pa). Gipatuman kini sa pamaagi sa TreePress (lib/function.tcl file):

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
}

Subay niini, ang Run::server ilusad para sa main server (Run::cluster para sa cluster, Run::work_server para sa working server, etc.). Mga. ang bili sa $key variable kay kabahin sa ngalan sa kahoy nga elemento nga gihatag sa opsyon -id.

Atong tan-awon ang pamaagi

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

Kini nga pamaagi nagproseso sa nadawat gikan sa server pinaagi sa RunCommand nga sugo, ug nagdugang sa tanang matang sa mga butang ngadto sa kahoy - mga cluster, nagkalain-laing mga elemento sa gamut (mga base, nagtrabaho nga mga server, mga sesyon, ug uban pa). Kung tan-awon nimo pag-ayo, sa sulod makita nimo ang tawag sa pamaagi sa InsertItemsWorkList. Gigamit kini aron idugang ang mga butang sa usa ka graphical nga listahan pinaagi sa pagproseso sa output sa rac console utility nga kaniadto gibalik isip listahan sa $lst variable. Kini usa ka lista sa mga lista nga adunay mga pares sa mga elemento nga gibulag sa usa ka colon.

Pananglitan, usa ka lista sa mga koneksyon sa cluster:

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

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

Sa graphical kini tan-awon sama niini:

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Ang pamaagi sa ibabaw nagkuha sa mga ngalan sa elemento alang sa header ug ang datos aron mapuno ang lamesa:

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
}

Dinhi, imbes usa ka yano nga sugo [split $str ":"], nga nagbahin sa string ngadto sa mga elemento nga gibulag sa ":" ug nagbalik sa usa ka lista, usa ka regular nga ekspresyon ang gigamit, tungod kay ang pipila ka mga elemento adunay usa ka colon.

Ang pamaagi sa InsertClusterItems (usa sa daghang susama nga mga) nagdugang lang og lista sa mga elemento sa bata nga adunay katugbang nga mga identifier sa gikinahanglan nga elemento sa cluster sa kahoy.
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
}

Mahimo nimong ikonsiderar ang duha pa nga mga kapilian alang sa pagpatuman sa ingon nga pamaagi, diin klaro nga makita kung giunsa nimo ma-optimize ug matangtang ang mga nagbalikbalik nga mga mando:

Niini nga pamaagi, ang pagdugang ug pagsusi masulbad sa ulo-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"
    }
}

Ug ania ang usa ka mas maayo nga pamaagi:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Виртуальные каталоги"}
        {com "Разрешённые COM-классы"}
        {addin "Внешние компоненты"}
        {module "Внешние отчёты и обработки"}
        {app "Разрешённые приложения"}
        {inet "Ресурсы интернет"}
    }
    foreach i $lst {
        append item [lindex $i 0] "::$id"
        if { [$tree exists $item] == 0 } {
            $tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
        }
        unset item 
    }
}

Ang kalainan tali kanila mao ang paggamit sa siklo, diin ang gibalikbalik nga (mga) sugo gipatuman. Unsa nga pamaagi ang gamiton naa sa pagbuot sa developer.

Ang pagdugang sa mga elemento ug pagkuha sa datos, among gikonsiderar, panahon na nga mohunong sa pag-edit. Tungod kay, sa panguna, parehas nga mga parameter ang gigamit alang sa pag-edit ug pagdugang (ang eksepsiyon mao ang infobase), ang mga porma sa dialogo gigamit nga parehas. Ang algorithm alang sa mga pamaagi sa pagtawag aron idugang ingon niini:

Idugang::$key->AddTopLevel

Ug alang sa pag-edit sama niini:

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

Pananglitan, atong kuhaon ang cluster editing, i.e. pag-klik sa kahoy sa ngalan sa cluster, i-press ang edit button sa toolbar (pencil) ug ang katugbang nga porma ipakita sa screen:

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk
Edit::kumpol

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

Sumala sa mga komento sa code, sa prinsipyo, ang tanan klaro, gawas nga ang buton handler code gi-redefined ug adunay usa ka FormFieldsDataInsert nga pamaagi nga nagpuno sa mga natad sa datos ug nagsugod sa mga variable:

FormFieldsDataInsert

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

Sa kini nga pamaagi, usa pa nga dugang sa tcl ang mitumaw - ang mga kantidad sa ubang mga variable gipuli ingon mga variable nga ngalan. Mga. aron ma-automate ang pagpuno sa mga porma ug pagsugod sa mga variable, ang mga ngalan sa mga field ug variables katumbas sa command line switch sa rac utility ug ang mga ngalan sa command output parameters nga adunay pipila ka eksepsiyon - ang dash gipulihan sa underscore. Eg scheduled-jobs-deny katumbas sa kapatagan ent_scheduled_jobs_deny ug variable scheduled_jobs_deny.

Ang mga porma alang sa pagdugang ug pag-edit mahimong magkalainlain sa komposisyon sa mga natad, pananglitan, nagtrabaho kauban ang usa ka infobase:

Pagdugang sa IB

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Pag-edit sa IB

Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Sa pamaagi sa pag-edit Edit::infobase, ang gikinahanglan nga mga field gidugang sa porma, mao nga dili nako ihatag ang code dinhi.

Pinaagi sa analohiya, ang mga pamaagi alang sa pagdugang, pag-edit, pagtangtang gipatuman alang sa ubang mga elemento.

Tungod kay ang operasyon sa utility nagpasabot sa usa ka walay kutub nga gidaghanon sa mga server, clusters, infobases, ug uban pa, aron mahibal-an kung asa nga cluster ang usa ka server o IS iya, daghang mga global variable ang gipaila, ang mga kantidad niini gitakda sa matag higayon nga imong i-klik ang mga elemento sa kahoy. Mga. ang pamaagi balikbalik nga nagdagan sa tanan nga mga elemento sa ginikanan ug nagtakda mga variable:

SetGlobalVarFromTreeItems

proc SetGlobalVarFromTreeItems {tree id} {
    global host server active_cluster infobase
    set parent [$tree parent $id]
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
    switch -- $key {
        server {set host $values}
        work_server {set server $values}
        cluster {set active_cluster $values}
        infobase {set infobase $values}
    }
    if {$parent eq ""} {
        return
    } else {
        SetGlobalVarFromTreeItems $tree $parent
    }
}

Ang Cluster 1C nagtugot kanimo sa pagtrabaho nga adunay o wala’y pagtugot. Adunay duha ka matang sa mga administrador - cluster agent administrator ug cluster administrator. Tungod niini, alang sa husto nga operasyon, 4 pa nga global nga mga variable ang gipaila, nga adunay sulod nga login ug password sa tagdumala. Mga. kung adunay usa ka account sa administrador sa cluster, unya usa ka dialog ang ipakita alang sa pagsulod sa usa ka login ug password, ang data ma-save sa memorya ug ilisan sa matag command alang sa katugbang nga cluster.

Kini ang responsibilidad sa pamaagi sa pagdumala sa sayup.

Sayop sa Parcing

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

Mga. depende kung unsa ang ibalik sa mando, adunay usa ka reaksyon sumala niana.

Sa pagkakaron, ang pag-andar gipatuman sa mga 95 porsyento, kini nagpabilin nga ipatuman ang trabaho sa mga profile sa seguridad ug sulayan kini =). Mao ra. Nangayo kog pasaylo sa gusot nga istorya.

Code, tradisyonal nga magamit dinhi.

Pag-update: Natapos ang trabaho sa mga profile sa seguridad. Karon ang pag-andar 100% gipatuman.

Pag-update sa 2: gidugang ang lokalisasyon sa English ug Russian, gisulayan nga trabaho sa win7
Nagsulat kami usa ka GUI alang sa 1C RAC, o usab bahin sa Tcl / Tk

Source: www.habr.com

Idugang sa usa ka comment