Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Pe măsură ce m-am adâncit în tema lucrului cu produsele 1C în medii Linux, a devenit evident un dezavantaj — lipsa unui instrument grafic multiplatformă convenabil pentru gestionarea clusterului de servere 1C. Așa că s-a decis să corectăm această neajuns, prin scrierea unui GUI pentru utilitarul consolă rac. Limbajul ales pentru dezvoltare a fost tcl/tk, considerat de mine cel mai potrivit pentru această sarcină. Iată câteva aspecte interesante ale soluției pe care vreau să le prezint în acest material.

Pentru lucru, vor fi necesare distribuții de tcl/tk și 1C. Și deoarece am decis să folosesc la maximum capacitățile livrării de bază a tcl/tk fără utilizarea pachetelor externe, va fi necesară versiunea 8.6.7, care include ttk — un pachet cu elemente grafice suplimentare, dintre care ne va fi necesar, în principal, ttk::TreeView, care permite afișarea datelor atât sub formă de structură ierarhică cât și sub formă de tabel (listă). De asemenea, în noua versiune a fost refăcută gestionarea excepțiilor (comanda try, care este utilizată în proiect la rularea comenzilor externe).

Proiectul constă din mai multe fișiere (deși nimic nu împiedică realizarea totul într-unul singur):

rac_gui.cfg — configurația default
rac_gui.tcl — scriptul principal de lansare
În catalogul lib se află fișierele care sunt încărcate automat la start:
function.tcl — fișierul cu proceduri
gui.tcl — interfața grafică principală
images.tcl — bibliotecă de imagini în base64

Fișierul rac_gui.tcl, de fapt, lansează interpretul, inițializează variabilele, încarcă module, configurații și așa mai departe. Conținutul fișierului cu comentarii:

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

După ce sunt încărcate toate cele necesare și se verifică prezența utilitarului rac, va fi deschis un fereastra grafică. Interfața programului constă din trei elemente:

Bara de instrumente, arborele și lista

Conținutul „arborelui” l-am făcut cât mai asemănător cu un component standard Windows de la 1C.

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Codul principal care formează această fereastră se află în fișierul
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

Algoritmul de lucru cu programul este următorul:

1. La început, trebuie să adăugați serverul principal al clusterului (adică serverul de gestionare a clusterului (în linux gestionarea se deschide cu comanda „/opt/1C/v8.3/x86_64/ras cluster —daemon”)).

Pentru aceasta, apăsați pe butonul „+” și în fereastra care se deschide, introduceți adresa serverului și portul:

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

După aceasta, în arbore va apărea serverul nostru, pe care, dacă faceți clic, se va deschide o listă de clustere sau va apărea o eroare de conexiune.

2. Dând clic pe numele clusterului, se va deschide o listă de funcții disponibile pentru acesta.

3.…

Și așa mai departe, adică pentru a adăuga un nou cluster, selectăm orice element disponibil din listă și facem clic pe butonul „+” din panoul de instrumente, iar un dialog de adăugare a noului element va fi afișat:

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Butonul din panoul de instrumente îndeplinește funcții în funcție de context, adică în funcție de ce element din arbore sau din listă este selectat, va fi executată o anumită procedură.

Să luăm ca exemplu butonul de adăugare („+”):

Codul de formare a butonului:

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

Aici vedem că la apăsarea butonului va fi executată procedura „Add”, codul ei:

proc Add {} {
    global active_cluster host
    # Determinăm identificatorul elementului selectat
    set id  [.frm_tree.tree selection] 
    # Determinăm valoarea acestui element
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # în funcție de ceea ce am selectat, va fi lansată procedura corespunzătoare
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Iată, de asemenea, se vede un avantaj al tickler-ului — ca nume al procedurii poate fi transmisă o valoare a unei variabile:

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

Adică, de exemplu, dacă dăm clic pe serverul principal și apăsăm „+”, va fi lansată procedura Add::server, dacă pe cluster — Add::cluster și așa mai departe (despre de unde vin „cheile” necesare voi scrie mai jos), procedurile enumerate desenează elementele grafice corespunzătoare contextului.

După cum ați observat, formularele sunt asemănătoare ca stil — nu este surprinzător, deoarece sunt generate de aceeași procedură, mai exact cadrul principal al formularului (fereastră, butoane, imagine, etichetă), numele procedurii 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
    # eticheta cu iconiță
    ttk::label $win_name.lbl -image $img
    # cadru cu câmpuri de introducere
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # cadru și butoane
    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
}

Parametrii apelului: titular, numele imaginii pentru iconiță din bibliotecă (lib/images.tcl) și un parametru opțional pentru numele ferestrei (implicit .add). Astfel, dacă luăm exemplele anterioare pentru adăugarea unui server principal și a unui cluster, apelul va fi respectiv:

AddToplevel "Adăugare server principal" server_grey_64

sau

AddToplevel "Adăugare cluster" cluster_grey_64

Continuând cu aceste exemple, voi arăta procedurile care afișează dialogurile de adăugare pentru server sau cluster.

Add::server

proc Add::server {} {
    global default
    # afișăm formularul principal
    set frm [AddToplevel "Adăugare server principal" server_grey_64]
    # adăugăm etichete și câmpuri de introducere pe acest formular
    label $frm.lbl_host -text "Adresa serverului"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Port"
    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]
    # redefinim handler-ul pentru apăsarea butonului
    .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
}

Add::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ări globale ()
    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 "Adăugare cluster" cluster_grey_64]
    
    label $frm.lbl_host -text "Adresa serverului principal"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Port"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Numele cluster-ului"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Conexiune securizată"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Oprirea proceselor închise după:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Nivelul de toleranță la defecte"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Modul de distribuire a sarcinii"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Limită permisibilă a numărului de erori ai serverului, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Procesele în lucru:"
    label $frm.lbl_lifetime_limit -text "Perioada de repornire, sec."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Volumul maxim de memorie permis, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Intervalul de depășire a volumului maxim de memorie, sec."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Oprire forțată a proceselor problematice"
    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
    # redefinim handlerul
    .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
}

Comparând codul acestor proceduri, diferența este evidentă cu ochiul liber; atrag atenția asupra handler-ului butonului „Ok”. În Tk, proprietățile elementelor grafice pot fi redefinite în timpul execuției programului prin intermediul opțiunii configure. De exemplu, comanda inițială de afișare a butonului:

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

Dar, în formularele noastre, comanda depinde de funcționalitatea necesară:

  .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 exemplul dat mai sus, butonul „zabitat” inițiază procedura de adăugare a clusterului.

Aici este de menționat că lucrăm cu elemente grafice în Tk — pentru diferite elemente de introducere a datelor (entry, combobox, checkbutton etc.) a fost introdus un parametru numit variabilă text (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Această variabilă este definită în spațiul de nume global și conține valoarea actual introdusă. Adică, pentru a obține textul introdus în câmp, trebuie doar să citim valoarea variabilei corespunzătoare (bineînțeles, cu condiția ca aceasta să fie definită la crearea elementului).

A doua metodă de a obține textul introdus (pentru elemente de tip entry) este utilizarea comenzii get:

.add.frm.ent_name get

Ambele metode pot fi văzute în codul de mai sus.

Apăsarea acestui buton, în acest caz, inițiază procedura RunCommand cu comanda formată pentru a adăuga clusterul în termenii 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

Am ajuns la comanda principală care controlează inițierea rac cu parametrii necesari, de asemenea gestionează output-ul comenzilor în liste și returnează, dacă este necesar:

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
    # deschidem un canal în modul neblocat
    # $rac - comanda cu calea completă
    # $par - cheile de lansare și opțiunile generate
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # ieșirea comenzii este adăugată în lista listelor
        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} {
        # Execută gestionarul de erori
        ErrorParcing $result $options
        return ""
    }
}

După introducerea datelor serverului principal, acesta va fi adăugat în arbore, pentru care, în procedura de mai sus Add:server, răspunde următorul cod:

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

Acum, făcând clic pe numele serverului din arbore, vom obține o listă de clustere gestionate de acel server, iar făcând clic pe un cluster, vom obține lista elementelor clusterului (servere, baze de date informaționale etc.). Acest lucru este implementat în procedura TreePress (fișierul lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # definim elementul selectat
    set id  [$tree selection]
   # setăm variabilele globale necesare
    SetGlobalVarFromTreeItems $tree $id
   # Definim cheia și valoarea, adică tipul elementului selectat
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # și, în funcție de ceea ce am ales, va fi lansată procedura corespunzătoare
   # în spațiul numelui Run
    Run::$key $tree $host $values
}

Prin urmare, pentru serverul principal se va lansa Run::server (pentru cluster – Run::cluster, pentru serverul de lucru – Run::work_server etc.). Adică, valoarea variabilei $key este o parte din numele elementului arborelui, definită de opțiunea -id.

Să ne concentrăm asupra procedurii

Run::server

proc Run::server {tree host values} {
    # obținem lista clusterelor pentru serverul solicitat
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # ștergem elementele inutile din listă
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # citim lista
    foreach cluster_list $lst {
        # Umplem lista cu valorile obținute
        InsertItemsWorkList $cluster_list
        # procesăm ieșirea (lista) pentru a adăuga date în copac
        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]]
            }
        }
    }
    # adăugăm clusterele în copac
    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"
            # adăugăm elemente în cluster
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Administratori" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Această procedură prelucrează ceea ce a fost obținut de la server prin comanda RunCommand, adăugând diverse în copac — clustere, diferite elemente rădăcină (baze, servere de lucru, sesiuni și așa mai departe). Dacă privim mai atent, putem observa apelul procedurii InsertItemsWorkList. Aceasta este folosită pentru a adăuga elemente în lista grafică, procesând ieșirea utilitarului consolei rac, care a fost returnată anterior sub formă de listă în variabila $lst. Aceasta este o listă de liste, conținând perechi de elemente separate prin două puncte.

De exemplu, lista conexiunilor la 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

În formă grafică, aceasta ar arăta cam așa:

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Procedura menționată mai sus extrage denumirile elementelor pentru titlu și datele pentru completarea tabelului:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # Set row color alternation
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # Parse rows into key-value pairs
    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]
        }
    }
     # Fill the table
    .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
    # Set headers
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Aici, în loc de comanda simplă [split $str «:»], care împarte șirul în elemente separate prin «:» și returnează o listă, se utilizează o expresie regulată, deoarece unele elemente conțin de asemenea două puncte.

Procedura InsertClusterItems (una dintre mai multe similare) adaugă pur și simplu în arbore lista elementelor fiice cu identificatorii corespunzători la elementul clustere.
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Baze de informații" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Servere active" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Administratori" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Manageri de cluster" -values $id
    $tree insert $parent end -id "processes::$id" -text "Procese active" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Sesiuni" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Blocaje" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Conexiuni" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Profiluri de securitate" -values $id
}

Se pot lua în considerare și alte două variante de implementare a unei astfel de proceduri, unde se va vedea cum se poate optimiza și scăpa de comenzile repetate:

În această procedură, adăugarea și verificarea sunt rezolvate direct:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Sesiuni" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Blocaje" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Conexiuni" -values "$id"
    }
}

Aici metoda este mai corectă:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Directoare virtuale"}
        {com "Clase COM permise"}
        {addin "Componente externe"}
        {module "Rapoarte și procese externe"}
        {app "Aplicatii permise"}
        {inet "Resurse internet"}
    }
    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 
    }
}

Diferența dintre ele constă în aplicarea unui ciclu în care este executată comanda repetată (comenzile). Ce abordare să aplici - aceasta depinde deja de decizia dezvoltatorului.

Am discutat despre adăugarea elementelor și obținerea datelor, acum este timpul să ne oprim asupra editării. Deoarece, în principal, pentru editare și adăugare se folosesc aceleași parametri (excepția o constituie baza informațională), formele de dialog utilizate sunt aceleași. Algoritmul apelului procedurilor pentru adăugare arată astfel:

Add::$key->AddToplevel

Iar pentru editare astfel:

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

Ca exemplu, să luăm editarea unui cluster, adică făcând click pe numele clusterului în copac, apăsăm butonul de editare din bara de instrumente (creionul) iar pe ecran va fi afişată forma corespunzătoare:

Scriem un GUI pentru 1C RAC, sau din nou despre 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 ""
    }
    # desenați formularul pentru cluster
    set frm [Add::cluster $tree $host $values]
    # schimbați textul de pe etichetă
    $frm configure -text "Editare cluster"
    
    set active_cluster $values
    # obțineți datele pentru clusterul selectat
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # umpleți câmpurile
    FormFieldsDataInsert $frm $lst
    # dezactivați câmpurile care nu pot fi editate
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # re-atribuiți handler-ul
    .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
    }
}

În comentariile din cod, în principiu, totul este clar, cu excepția faptului că handler-ul butonului a fost redefinit și există procedura FormFieldsDataInsert, care umple câmpurile cu date și inițializează variabilele:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # obțineți lista de parametrii și valori
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # schimbați simbolurile
            regsub -all -- "-" [string trim $param] "_" entry_name
            # umpleți cu date
            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 """]
            }
            # pentru casetele de selectare schimbați valorile
            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 această procedură a apărut un alt avantaj al Tcl - numele variabilelor sunt înlocuite cu valorile altor variabile. Asta înseamnă că, pentru automatizarea completării formularelor și inițializarea variabilelor, denumirile câmpurilor și variabilelor se potrivesc cu cheile din linia de comandă a utilitarului rac și cu denumirile parametrilor de ieșire a comenzilor, cu unele excepții - cratima este înlocuită cu un underscore. De exemplu, scheduled-jobs-deny corespunde câmpului ent_scheduled_jobs_deny și variabilei scheduled_jobs_deny.

Formele de adăugare și editare pot diferi prin conținutul câmpurilor; de exemplu, lucrul cu baza de informații:

Adăugare Bază de Informații

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Editare Bază de Informații

Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

În procedura de editare Edit::infobase, pe formular se adaugă câmpurile necesare; codul este voluminos, de aceea nu îl voi include aici.

Procedurile de adăugare, editare, ștergere sunt implementate analogic și pentru celelalte elemente.

Dat fiind că funcționarea utilitarului presupune un număr nelimitat de servere, clustere, baze de informații etc., pentru a determina la care cluster aparține fiecare server sau bază de informații, au fost introduse câteva variabile globale, a căror valori sunt stabilite la fiecare clic pe elementele din arbore. Asta înseamnă că procedura parcurge recursiv toți părinții și stabilește variabilele:

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

Clusterul 1C permite lucrul atât cu autorizare, cât și fără. Există două tipuri de administratori - administrator de agent de cluster și administrator de cluster. Prin urmare, pentru o funcționare corectă, au fost introduse încă 4 variabile globale, care conțin numele de utilizator și parola administratorului. Adică, dacă în cluster există un cont de administrator, va fi afișat un dialog pentru introducerea numelui de utilizator și parolei, datele vor fi salvate în memorie și vor fi incluse în fiecare comandă pentru clusterul corespunzător.

Pentru aceasta răspunde procedura de gestionare a erorilor

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Administratorul clusterului nu este autentificat" {
            AuthorisationDialog "Administratorul clusterului"
            .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
        }
        "Administratorul serverului central nu este autentificat" {
            AuthorisationDialog "Administratorul agentului clusterului"
            .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
            }
        }
        "Administratorul clusterului nu este autentificat" {
            AuthorisationDialog "Administratorul clusterului"
            .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
        }
        "Administratorul serverului central nu este autentificat" {
            AuthorisationDialog "Administratorul agentului clusterului"
            .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"
        }
    }
}

Adică, în funcție de ceea ce returnează comanda, va fi și reacția corespunzătoare.

În prezent, funcționalitatea este realizată cam în proporție de 95%, rămâne să se implementeze lucrul cu profilele de securitate și apoi să testez =). Asta e tot. Îmi cer scuze pentru narațiunea abruptă.

Codul, ca de obicei, este disponibil aici.

Actualizare: Am terminat lucrul cu profilele de securitate. Acum funcționalitatea este complet implementată.

Actualizare 2: s-a adăugat localizarea în limba engleză și rusă, a fost verificată funcționalitatea pe Windows 7
Scriem un GUI pentru 1C RAC, sau din nou despre Tcl/Tk

Sursa: habr.com

Cumpără un hosting fiabil pentru site-uri cu protecție DDoS, servere VPS VDS 🔥 Cumpără un hosting fiabil pentru site-uri cu protecție DDoS, servere VPS VDS | ProHoster