Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Ndërsa hulumtuam në temën se si funksionojnë produktet 1C në mjedisin Linux, u zbulua një pengesë - mungesa e një mjeti të përshtatshëm grafik me shumë platforma për menaxhimin e një grupi serverësh 1C. Dhe u vendos që të korrigjohej kjo pengesë duke shkruar një GUI për programin e konsolës rac. Tcl/tk u zgjodh si gjuha e zhvillimit si, për mendimin tim, më e përshtatshme për këtë detyrë. Dhe kështu, unë do të doja të paraqes disa aspekte interesante të zgjidhjes në këtë material.

Për të punuar do t'ju duhen shpërndarje tcl/tk dhe 1C. Dhe meqenëse vendosa të shfrytëzoj në maksimum aftësitë e dërgesës bazë tcl/tk pa përdorur paketa të palëve të treta, do të më duhet versioni 8.6.7, i cili përfshin ttk - një paketë me elementë grafikë shtesë, nga të cilat na duhen kryesisht ttk ::TreeView, lejon shfaqjen e të dhënave si në formën e një strukture peme ashtu edhe në formën e një tabele (liste). Gjithashtu, në versionin e ri, puna me përjashtime është ripunuar (komandë try, e cila përdoret në projekt kur ekzekutohen komandat e jashtme).

Projekti përbëhet nga disa skedarë (megjithëse asgjë nuk ju pengon të bëni gjithçka në një):

rac_gui.cfg - konfigurimi i paracaktuar
rac_gui.tcl - skript kryesor i nisjes
Drejtoria lib përmban skedarë që ngarkohen automatikisht në fillim:
funksion.tcl - skedar me procedura
gui.tcl - ndërfaqja kryesore grafike
images.tcl - biblioteka e imazheve base64

Skedari rac_gui.tcl, në fakt, nis interpretuesin, inicializon variablat, ngarkon modulet, konfigurimet, etj. Përmbajtja e skedarit me komente:

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

Pas shkarkimit të gjithçkaje që kërkohet dhe kontrollimit të pranisë së mjetit rac, do të hapet një dritare grafike. Ndërfaqja e programit përbëhet nga tre elementë:

Shiriti i veglave, pema dhe lista

E bëra përmbajtjen e "pemës" sa më të ngjashme me pajisjet standarde të Windows nga 1C.

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Kodi kryesor që formon këtë dritare gjendet në skedar
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

Algoritmi për të punuar me programin është si më poshtë:

1. Së pari, duhet të shtoni serverin kryesor të grupit (d.m.th. serverin e menaxhimit të grupeve (në Linux, menaxhimi niset me komandën “/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Për ta bërë këtë, klikoni në butonin "+" dhe në dritaren që hapet, vendosni adresën dhe portin e serverit:

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Më pas, serveri ynë do të shfaqet në pemë duke klikuar mbi të, do të hapet një listë grupesh ose do të shfaqet një gabim lidhjeje.

2. Duke klikuar mbi emrin e grupit do të hapet një listë e funksioneve të disponueshme për të.

3.

Dhe kështu me radhë, d.m.th. për të shtuar një grup të ri, zgjidhni cilindo që është i disponueshëm në listë dhe shtypni butonin "+" në shiritin e veglave dhe dialogu "Shto të ri" do të shfaqet:

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Butonat në shiritin e veglave kryejnë funksione në varësi të kontekstit, d.m.th. Varësisht se cili element i pemës ose listës është zgjedhur, do të kryhet një ose një procedurë tjetër.

Le të shohim shembullin e butonit shto ("+"):

Kodi i gjenerimit të butonit:

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

Këtu shohim që kur shtypet butoni, do të ekzekutohet procedura "Shto", kodi i tij:

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
}

Këtu është një nga avantazhet e gudulisjes: ju mund të kaloni vlerën e një ndryshoreje si emër të procedurës:

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

Kjo do të thotë, për shembull, nëse drejtojmë serverin kryesor dhe shtypim "+", atëherë procedura Add::server do të hapet, nëse në grup - Add::cluster dhe kështu me radhë (do të shkruaj se ku "çelësat" e nevojshëm vijnë nga pak më poshtë), procedurat e listuara vizatojnë elemente grafike të përshtatshme për kontekstin.

Siç mund ta keni vënë re tashmë, format janë të ngjashëm në stil - kjo nuk është për t'u habitur, sepse ato shfaqen nga një procedurë, më saktësisht korniza kryesore e formularit (dritarja, butonat, imazhi, etiketa), emri i procedurës. 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
}

Parametrat e thirrjes: titulli, emri i imazhit për ikonën nga biblioteka (lib/images.tcl) dhe një parametër opsional i emrit të dritares (parazgjedhja .add). Kështu, nëse marrim shembujt e mësipërm për shtimin e serverit dhe grupit kryesor, thirrja do të jetë në përputhje me rrethanat:

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

ose

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

Epo, duke vazhduar me këta shembuj, unë do të tregoj procedurat që shfaqin dialogët e shtimit për një server ose grup.

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

Shto::klaster

proc Add::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes 
    agent_user agent_pwd cluster_user cluster_pwd auth_agent
    if {$agent_user ne "" && $agent_pwd ne ""} {
        set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
    } else {
        set auth_agent ""
    }
    # устанавливаем глобальные переменные ()
    set lifetime_limit $default(lifetime_limit)
    set expiration_timeout $default(expiration_timeout)
    set session_fault_tolerance_level $default(session_fault_tolerance_level)
    set max_memory_size $default(max_memory_size)
    set max_memory_time_limit $default(max_memory_time_limit)
    set errors_count_threshold $default(errors_count_threshold)
    set security_level [lindex $default(security_level) 0]
    set load_balancing_mode [lindex $default(load_balancing_mode) 0]
    
    set frm [AddToplevel "Добавление кластера" cluster_grey_64]
    
    label $frm.lbl_host -text "Адрес основного сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Название кластера"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Защищённое соединение"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Рабочие процессы:"
    label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
    checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no    
    
    grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
    # переопределяем обработчик
    .add.frm_btn.btn_ok configure -command {
        RunCommand "" "cluster insert 
        --host=[.add.frm.ent_host get] 
        --port=[.add.frm.ent_port get] 
        --name=[.add.frm.ent_name get] 
        --expiration-timeout=$expiration_timeout 
        --lifetime-limit=$lifetime_limit 
        --max-memory-size=$max_memory_size 
        --max-memory-time-limit=$max_memory_time_limit 
        --security-level=$security_level 
        --session-fault-tolerance-level=$session_fault_tolerance_level 
        --load-balancing-mode=$load_balancing_mode 
        --errors-count-threshold=$errors_count_threshold 
        --kill-problem-processes=$kill_problem_processes 
        $auth_agent $host"
        Run::server $tree $host ""
        destroy .add
    }
    return $frm
}

Kur krahasojmë kodin e këtyre procedurave, ndryshimi është i dukshëm me sy të lirë, unë do të fokusohem në mbajtësin e butonit "Ok". Në Tk, vetitë e elementeve grafikë mund të anashkalohen gjatë ekzekutimit të programit duke përdorur opsionin konfiguroni. Për shembull, komanda fillestare për të shfaqur butonin:

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

Por në format tona, komanda varet nga funksionaliteti i kërkuar:

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

Në shembullin e mësipërm, butoni "i bllokuar" fillon procedurën për shtimin e një grupi.

Këtu ia vlen të bëni një digresion drejt punës me elementë grafikë në Tk - për elementë të ndryshëm të futjes së të dhënave (hyrja, kutia e kombinuar, butoni i kontrollit, etj.) Një parametër është futur si një variabël teksti:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Kjo variabël është përcaktuar në hapësirën globale të emrave dhe përmban vlerën e futur aktualisht. Ato. për të marrë tekstin e futur nga fusha, thjesht duhet të lexoni vlerën që korrespondon me variablin (natyrisht, me kusht që të përcaktohet kur krijoni elementin).

Metoda e dytë për marrjen e tekstit të futur (për elementët e tipit të hyrjes) është përdorimi i komandës get:

.add.frm.ent_name get

Të dyja këto metoda mund të shihen në kodin e mësipërm.

Duke klikuar këtë buton, në këtë rast, nis procedurën RunCommand me linjën e gjeneruar të komandës për shtimin e një grupi në terma 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

Tani kemi ardhur te komanda kryesore, e cila kontrollon nisjen e rac me parametrat që na duhen, gjithashtu analizon daljen e komandave në lista dhe kthen, nëse kërkohet:

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

Pas futjes së të dhënave kryesore të serverit, ato do të shtohen në pemë, për këtë, në procedurën e mësipërme Add:server, është përgjegjës kodi i mëposhtëm:

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

Tani, duke klikuar mbi emrin e serverit në pemë, marrim një listë të grupimeve të menaxhuara nga ai server, dhe duke klikuar në një grup, marrim një listë të elementeve të grupimit (serverët, bazat e informacionit, etj.). Kjo zbatohet në procedurën TreePress (skedari 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
}

Prandaj, Run::server do të lansohet për serverin kryesor (për një grup - Run::cluster, për një server që funksionon - Run::work_server, etj.). Ato. vlera e ndryshores $key është pjesë e emrit të elementit të pemës të specifikuar nga opsioni -id.

Le t'i kushtojmë vëmendje procedurës

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

Kjo procedurë përpunon atë që është marrë nga serveri përmes komandës RunCommand dhe shton të gjitha llojet e gjërave në pemë - grupe, elementë të ndryshëm rrënjë (bazat, serverët e punës, sesionet, e kështu me radhë). Nëse shikoni nga afër, do të vini re një thirrje për procedurën InsertItemsWorkList brenda. Përdoret për të shtuar elementë në një listë grafike duke përpunuar daljen e programit të konsolës rac, e cila më parë ishte kthyer si listë në ndryshoren $lst. Kjo është një listë e listave që përmbajnë çifte elementesh të ndara me dy pika.

Për shembull, një listë e lidhjeve të grupimeve:

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

Në formë grafike do të duket diçka si kjo:

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Procedura e mësipërme zgjedh emrat e elementeve për kokën dhe të dhënat për të plotësuar tabelën:

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
}

Këtu, në vend të një komande të thjeshtë [split $str ":"], e cila ndan vargun në elementë të ndarë me ":" dhe kthen një listë, përdoret një shprehje e rregullt, pasi disa elementë përmbajnë gjithashtu një dy pika.

Procedura InsertClusterItems (një nga disa të ngjashme) thjesht shton një listë të elementeve fëmijë me identifikuesit përkatës në pemën e elementit të kërkuar të grupimit
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
}

Ju mund të konsideroni dy opsione të tjera për zbatimin e një procedure të ngjashme, ku do të jetë qartë e dukshme se si mund të optimizoni dhe të shpëtoni nga komandat e përsëritura:

Në këtë procedurë, shtimi dhe kontrollimi zgjidhen kokë më kokë:

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

Këtu është një qasje më e saktë:

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

Dallimi midis tyre është përdorimi i një cikli, në të cilin ekzekutohen komandat e përsëritura. Cila qasje për t'u përdorur është në diskrecionin e zhvilluesit.

Ne kemi mbuluar shtimin e elementeve dhe marrjen e të dhënave, tani është koha të përqendrohemi te redaktimi. Meqenëse, në thelb, të njëjtat parametra përdoren për redaktim dhe shtim (me përjashtim të bazës së informacionit), përdoren të njëjtat forma dialogu. Algoritmi për thirrjen e procedurave për shtimin duket si ky:

Add::$key->AddToplevel

Dhe për redaktim si ky:

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

Për shembull, le të marrim redaktimin e një grupi, d.m.th. Pasi të keni klikuar mbi emrin e grupit në pemë, shtypni butonin redakto në shiritin e veglave (laps) dhe forma përkatëse do të shfaqet në ekran:

Shkrimi i një GUI për 1C RAC, ose përsëri për 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
    }
}

Bazuar në komentet në kod, në parim, gjithçka është e qartë, përveç se kodi i mbajtësit të butonit është anashkaluar dhe ekziston një procedurë FormFieldsDataInsert që mbush fushat me të dhëna dhe inicializon variablat:

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

Në këtë procedurë, u shfaq një avantazh tjetër i tcl - vlerat e variablave të tjerë zëvendësohen si emra të ndryshoreve. Ato. për të automatizuar plotësimin e formularëve dhe inicializimin e variablave, emrat e fushave dhe variablave korrespondojnë me çelsat e linjës komanduese të mjetit rac dhe emrat e parametrave të daljes së komandës me disa përjashtime - viza zëvendësohet me një nënvizim. P.sh programuar-punë-mohoj përputhet me fushën ent_scheduled_jobs_deny dhe e ndryshueshme planifikuar_punë_mohohet.

Format për shtimin dhe modifikimin mund të ndryshojnë në përbërjen e fushave, për shembull, duke punuar me një bazë informacioni:

Shtimi i sigurisë së informacionit

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Redaktimi i sigurisë së informacionit

Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Në procedurën e redaktimit Edit::infobase, në formular shtohen fushat e kërkuara, prandaj nuk e paraqes këtu;

Për analogji zbatohen procedurat për shtimin, modifikimin, fshirjen dhe për elementë të tjerë.

Meqenëse funksionimi i programit nënkupton një numër të pakufizuar serverësh, grupesh, bazash informacioni, etj., Për të përcaktuar se cili grup i përket cilit server ose sistem të sigurisë së informacionit, janë futur disa variabla globalë, vlerat e të cilave vendosen secili kur klikoni mbi elementet e pemës. Ato. procedura kalon në mënyrë rekursive nëpër të gjithë elementët prindër dhe vendos variablat:

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

Grupi 1C ju lejon të punoni me ose pa autorizim. Ekzistojnë dy lloje administratorësh - administratori i agjentit të grupimit dhe administratori i grupit. Prandaj, për funksionimin e saktë, u prezantuan 4 variabla të tjerë globalë që përmbajnë hyrjen dhe fjalëkalimin e administratorit. Ato. nëse ka një llogari administratori në grup, do të shfaqet një dialog për të futur hyrjen dhe fjalëkalimin tuaj, të dhënat do të ruhen në memorie dhe do të futen në secilën komandë për grupin përkatës.

Kjo është përgjegjësi e procedurës së trajtimit të gabimeve.

GabimParcing

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

Ato. në varësi të asaj që kthen komanda, reagimi do të jetë në përputhje me rrethanat.

Për momentin, rreth 95 për qind e funksionalitetit është zbatuar, gjithçka që mbetet është të zbatohet puna me profilet e sigurisë dhe të testohet =). Kjo eshte e gjitha. Kërkoj falje për historinë e rrëmujshme.

Kodi është tradicionalisht i disponueshëm këtu.

Përditësimi: Kam përfunduar punën me profilet e sigurisë. Tani funksionaliteti është zbatuar 100%.

Përditësimi 2: është shtuar lokalizimi në anglisht dhe rusisht, puna në win7 është testuar
Shkrimi i një GUI për 1C RAC, ose përsëri për Tcl/Tk

Burimi: www.habr.com

Shto një koment