Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Kako sam se sve više upuštao u rad s 1C proizvodima u Linux okruženju, otkrio sam jedan nedostatak — nedostatak praktičnog grafičkog višestrukog alata za upravljanje 1C server klasterom. Odluka je donijeta da se taj nedostatak ispravi pisanjem GUI-a za konzolnu alatku rac. Za razvoj je odabran tcl/tk, koji smatram najprikladnijim za ovu zadaću. Evo nekoliko zanimljivih aspekata rješenja koje želim predstaviti u ovom materijalu.

Za rad su potrebni distribucije tcl/tk i 1C. Budući da sam odlučio maksimalno iskoristiti mogućnosti osnovne verzije tcl/tk bez korištenja vanjskih paketa, potrebna je verzija 8.6.7 koja uključuje ttk — paket s dodatnim grafičkim elementima, od kojih ćemo najviše koristiti ttk::TreeView, koji omogućava prikaz podataka kako u obliku drvne strukture, tako i u obliku tablice (popisa). Također, u novoj verziji preinačena je obrada iznimaka (komanda try, koja se koristi u projektu prilikom pokretanja vanjskih komandi).

Projekt se sastoji od nekoliko datoteka (iako ništa ne sprečava da se sve napravi u jednoj):

rac_gui.cfg — zadana konfiguracija
rac_gui.tcl — glavni pokretački skript
U direktoriju lib nalaze se datoteke koje se automatski učitavaju prilikom pokretanja:
function.tcl — datoteka s procedurama
gui.tcl — glavni grafički sučelje
images.tcl — biblioteka slika u base64

Datoteka rac_gui.tcl, zapravo, pokreće interpreter, inicijalizira varijable, učitava module, konfiguracije i tako dalje. Sadržaj datoteke s komentarima:

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

Nakon učitavanja svega što je potrebno i provjere prisutnosti alata rac, bit će pokrenut grafički prozor. Sučelje programa sastoji se od tri elementa:

Traka s alatima, drvo i popis

Sadržaj ‘drveta’ učinio sam što sličnijim standardnoj Windows dodatku od 1C.

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Glavni kod koji oblikuje ovaj prozor nalazi se u datoteci
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

Algoritam rada s programom je sljedeći:

1. Na početku, potrebno je dodati glavni server klastera (tj. server za upravljanje klasterom (u Linuxu se upravljanje pokreće naredbom ‘/opt/1C/v8.3/x86_64/ras cluster —daemon’)).

Za to kliknite na dugme ‘+’ i u otvorenom prozoru unesite adresu servera i port:

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Nakon toga, na stablu će se pojaviti naš poslužitelj na koji klikom otvarate popis klastera ili će se prikazati pogreška povezivanja.

2. Klikom na ime klastera otvarate popis funkcija dostupnih za njega.

3.…

I tako dalje, tj. da biste dodali novi klaster, odaberite bilo koji dostupan na popisu i pritisnite gumb „+” u alatnoj traci te će se otvoriti dijalog za dodavanje novog:

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Gumbi u alatnoj traci izvršavaju funkcije ovisno o kontekstu, tj. o tome koji je element stabla ili popisa odabran, izvršit će se određena procedura.

Razmotrit ćemo na primjeru gumba za dodavanje („+”):

Kod za formiranje gumba:

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

Ovdje vidimo da će se pritiskom na gumb izvršiti procedura „Add”, njen kod:

proc Add {} {
    global active_cluster host
    # Definiramo identifikator odabranog elementa
    set id  [.frm_tree.tree selection] 
    # Definiramo vrijednost tog elementa
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # ovisno o tome što smo odabrali, pokrenut će se potrebna procedura
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Evo, jedan od prednosti tikla — kao ime procedure možete proslijediti vrijednost varijable:

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

Tj., na primjer, ako kliknemo na glavni poslužitelj i pritisnemo „+”, pokrenut će se procedura Add::server, ako na klaster — Add::cluster i tako dalje (o tome odakle dolaze potrebni „ključevi” napisat ću malo niže), navedene procedure prikazuju grafičke elemente koji odgovaraju kontekstu.

Kao što ste možda primijetili, obrasci su sličnog stila — i nije iznenađujuće, jer ih ispisuje jedna procedura, točnije osnovni okvir obrasca (prozor, gumbi, slika, oznaka), naziv procedure 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
    # oznaka s ikonom
    ttk::label $win_name.lbl -image $img
    # okvir s poljima za unos
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # okvir i dugmad
    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
}

Parametri poziva: naslov, naziv slike za ikonu iz biblioteke (lib/images.tcl) i opcionalni parametar naziv prozora (zadano .add). Dakle, koristeći prethodno navedene primjere za dodavanje glavnog poslužitelja i klastera, poziv će biti, redom:

AddToplevel "Dodavanje glavnog poslužitelja" server_grey_64

ili

AddToplevel "Dodavanje klastera" cluster_grey_64

Nastavljajući s ovim primjerima, pokazat ću procedure koje prikazuju dijaloge za dodavanje za poslužitelj ili klaster.

Add::server

proc Add::server {} {
    global default
    # prikazujemo glavnu formu
    set frm [AddToplevel "Dodavanje glavnog poslužitelja" server_grey_64]
    # dodajemo oznake i polja za unos na ovu formu
    label $frm.lbl_host -text "Adresa poslužitelja"
    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]
    # redefiniramo obrtnik za pritisak dugmeta
    .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 ""
    }
    # postavljamo globalne varijable ()
    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 "Dodavanje klastera" cluster_grey_64]
    
    label $frm.lbl_host -text "Adresa glavnog servera"
    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 "Ime klastera"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Zaštićena veza"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Zaustaviti isključene procese nakon:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Nivo otpornosti na greške"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Način uravnoteženja opterećenja"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Dozvoljena odstupanja u broju grešaka servera, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Radni procesi:"
    label $frm.lbl_lifetime_limit -text "Period ponovnog pokretanja, sek."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Dozvoljena količina memorije, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Interval premašivanja dozvoljene količine memorije, sek."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Prisilno završiti problematične procese"
    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
    # prebacujemo obrtnik
    .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
}

Kada se uspoređuje kod ovih procedura, razlika je očita golim okom; usmjeravam pažnju na obradu gumba „U redu“. U Tk svojstva grafičkih elemenata mogu se redefinirati tijekom izvršavanja programa pomoću opcije configure. Na primjer, izvorna naredba za ispis gumba:

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

Međutim, u našim formama, naredba ovisi o potrebnoj funkcionalnosti:

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

U gornjem primjeru, gumb „U redu“ pokreće proceduru za dodavanje klastera.

Tu treba napraviti odmak prema radu s grafičkim elementima u Tk — za razne elemente za unos podataka (entry, combobox, checkbutton itd.) uveden je parametar kao tekstualna varijabla (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Ova varijabla je definirana u globalnom prostoru imena i sadrži trenutno unesenu vrijednost. Drugim riječima, da bismo dobili uneseni tekst iz polja, jednostavno moramo pročitati vrijednost odgovarajuće varijable (naravno, pod uvjetom da je definirana prilikom stvaranja elementa).

Druga metoda za dobivanje unesenog teksta (za elemente tipa entry) je korištenje naredbe get:

.add.frm.ent_name get

Obje ove metode možemo vidjeti u gornjem kodu.

Pritiskanje ovog gumba, u ovom slučaju, pokreće proceduru RunCommand s formiranom naredbom za dodavanje klastera u terminima 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

Tu smo došli do glavne naredbe koja upravlja pokretanjem rac s potrebnim parametrima, također razdvaja ispis naredbi na liste i vraća, ako je potrebno:

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
    # otvaranje kanala u neblokirajućem režimu
    # $rac - komanda s punom putanjom
    # $par - formirani ključevi pokretanja i opcije    
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # izlaz komande dodajemo u listu lista
        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} {
        # Pokretanje obrade grešaka
        ErrorParcing $result $options
        return ""
    }
}

Nakon unosa podataka glavnog servera, on će biti dodat u drvo; za to, u gornjoj proceduri Add:server, odgovara sledeći kod:

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

Sada klikom na ime servera u drvetu dobićemo listu klastera kojima upravlja taj server, a klikom na klaster dobićemo listu stavki klastera (poslužitelja, informacionih baza itd.). To je realizovano u proceduri TreePress (datoteka lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # određivanje selektovanog elementa
    set id  [$tree selection]
   # postavljanje potrebnih globalnih promenljivih
    SetGlobalVarFromTreeItems $tree $id
   # Definisanje ključa i vrednosti, tj. tip odabranog elementa
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # a u zavisnosti od onoga što odaberemo pokrenuće se odgovarajuća procedura
   # u imenskom prostoru Run
    Run::$key $tree $host $values
}

S obzirom na to, za glavni server će se pokrenuti Run::server (za klaster — Run::cluster, za radni server — Run::work_server itd.). Tj. vrednost promenljive $key je deo imena elementa drveta, definisan opcijom -id.

Obratimo pažnju na proceduru

Run::server

proc Run::server {tree host values} {
    # dobivamo popis klastera potrebnog poslužitelja
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # uklanjamo suvišne iz popisa
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # čitamo popis
    foreach cluster_list $lst {
        # Ispunjavamo popis dobivenim vrijednostima
        InsertItemsWorkList $cluster_list
        # obrađujemo izlaz (popis) da dodamo podatke u stablo
        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]]
            }
        }
    }
    # dodajemo klastere u stablo
    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"
            # dodajemo elemente u klaster
            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
    }
}

Ova procedura obrađuje ono što je primljeno od poslužitelja putem naredbe RunCommand i dodaje različite elemente u stablo — klastere, različite korijenske elemente (baze, radne poslužitelje, sesije i tako dalje). Ako se bolje pogleda, može se primijetiti poziv procedure InsertItemsWorkList. Ona se koristi za dodavanje elemenata u grafički popis, obrađujući izlaz konzolne utilite rac, koji je ranije vraćen u varijablu $lst u obliku popisa. To je popis popisa, koji sadrži parove elemenata odvojenih dvotočkom.

Na primjer, popis veza klastera:

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

U grafičkom prikazu to će izgledati otprilike ovako:

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Ova procedura ističe nazive elemenata za naslov i podatke za ispunjavanje tablice:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # postavljanje izmjene boje za red
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # razdioba redaka u parova ključ - vrijednost
    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]
        }
    }
     # popunjavanje tablice
    .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
    # postavljanje naslova
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Ovdje je umjesto jednostavne naredbe [split $str «:»], koja dijeli niz na elemente odvojene «:» i vraća listu, korišteno regularno izražavanje, pošto neki elementi također sadrže dvotočku.

Procedura InsertClusterItems (jedna od nekoliko sličnih) jednostavno dodaje u stablo traženom elementu klastera popis podređenih elemenata s odgovarajućim identifikatorima
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Informacijske baze" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Radni poslužitelji" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Administratori" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Menadžeri klastera" -values $id
    $tree insert $parent end -id "processes::$id" -text "Radni procesi" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Sesije" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Zaključavanja" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Povezivanja" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Sigurnosni profili" -values $id
}

Može se razmotriti još dva varijante implementacije slične procedure, gdje će se jasno vidjeti kako optimizirati i osloboditi se ponavljajućih naredbi:

U ovoj proceduri dodavanje i provjera riješeni su direktno:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Sesije" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Zaključavanja" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Povezivanja" -values "$id"
    }
}

A ovdje je pristup ispravniji:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Virtualni direktoriji"}
        {com "Dopuštene COM klase"}
        {addin "Vanjske komponente"}
        {module "Vanjski izvještaji i obrade"}
        {app "Dopuštene aplikacije"}
        {inet "Internetski resursi"}
    }
    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 
    }
}

Razlika između njih leži u primjeni petlje u kojoj se izvršava ponavljajuća naredba (naredbe). Koji pristup primijeniti — to je odluka programera.

Dodavanje elemenata i dobivanje podataka smo razmotrili, a sada je vrijeme da se osvrnemo na uređivanje. Kako se, u osnovi, za uređivanje i dodavanje koriste isti parametri (iznimka je informacijska baza), tako se koriste i iste dijaloške forme. Algoritam pozivanja procedura za dodavanje izgleda ovako:

Add::$key->AddToplevel

A za uređivanje tako:

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

Za primjer uzmimo uređivanje klastera, tj. klikom u stablu na naziv klastera, pritisnemo gumb za uređivanje na alatnoj traci (olovka) i na ekran će biti prikazana odgovarajuća forma:

Pisanje GUI-a za 1C RAC, ili ponovno o 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 ""
    }
    # Prikazivanje obrasca za klaster
    set frm [Add::cluster $tree $host $values]
    # Promjena teksta na oznaci
    $frm configure -text "Uređivanje klastera"
    
    set active_cluster $values
    # Dobivanje podataka o odabranom klasteru
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # Popunjavanje polja
    FormFieldsDataInsert $frm $lst
    # Onemogućavanje polja koja se ne mogu uređivati
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # Ponovno dodjeljivanje obrade
    .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
    }
}

Prema komentarima u kodu, u principu je sve jasno, osim što je kod handlera gumba ponovno definiran i postoji procedura FormFieldsDataInsert koja popunjava polja podacima i inicijalizira varijable:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # Dobivanje popisa parametara i vrijednosti
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # Promjena simbola
            regsub -all -- "-" [string trim $param] "_" entry_name
            # Popunjavanje podacima
            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 """]
            }
            # Za checkboxe promjena vrijednosti
            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
                }
            }
        }
    }
}

U ovom postupku pojavila se još jedna prednost tcl - kao imena varijable koriste se vrednosti drugih varijabli. Tj. za automatizaciju popunjavanja obrazaca i inicijalizaciju varijabli, nazivi polja i varijabli odgovaraju ključevima komandne linije alata rac i nazivima parametara izlaznih komandi s određenim izuzecima - crtice su zamenjene donjom crtom. Na primer scheduled-jobs-deny odgovara polju ent_scheduled_jobs_deny i varijabli scheduled_jobs_deny.

Obrasci za dodavanje i uređivanje mogu se razlikovati po sastavu polja, na primer, rad s informacionom bazom:

Dodavanje IB

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Uređivanje IB

Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

U postupku uređivanja Edit::infobase na obrazac se dodaju potrebna polja, kod je obiman pa ga ne navodim ovde.

Na sličan način implementirani su postupci dodavanja, uređivanja, brisanja i za ostale elemente.

Budući da rad alata podrazumeva neograničen broj servera, klastera, informacionih baza itd., za određivanje kojem klasteru pripada koji server ili IB, uvedene su nekoliko globalnih varijabli čije se vrednosti postavljaju pri svakom kliku na elemente drveta. Tj. postupak rekurzivno prolazi kroz sve roditeljske elemente i postavlja varijable:

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

Klaster 1C omogućava rad kako sa autorizacijom tako i bez nje. Postoje dva tipa administratora - administrator agenta klastera i administrator klastera. Prema tome, za ispravan rad uvedena su još 4 globalne varijable koje sadrže korisničko ime i lozinku administratora. Tj. ako u klasteru postoji nalog administratora, biće prikazan dijalog za unos korisničkog imena i lozinke, podaci će se sačuvati u memoriji i biće korišćeni u svakoj komandi za odgovarajući klaster.

Za to je odgovoran postupak obrade grešaka

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Administrator klastera nije autentificiran" {
            AuthorisationDialog "Administrator klastera"
            .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
        }
        "Administrator središnjeg poslužitelja nije autentificiran" {
            AuthorisationDialog "Administrator agenta klastera"
            .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
            }
        }
        "Cluster administrator is not authenticated" {
            AuthorisationDialog "Administrator klastera"
            .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 "Administrator agenta klastera"
            .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"
        }
    }
}

Odnosno, ovisno o tome što vraća naredba, bit će i odgovarajuća reakcija.

Trenutno je funkcionalnost realizirana otprilike 95%, ostalo je implementirati rad s sigurnosnim profilima i testirati =). Na tome je sve. Ispričavam se na skraćenom narativu.

Kod, kao i obično, dostupan je ovdje.

Ažuriranje: Završio sam rad s sigurnosnim profilima. Sada je funkcionalnost realizirana 100%.

Ažuriranje 2: dodana je lokalizacija na engleski i ruski, provjeren rad u win7
Pisanje GUI-a za 1C RAC, ili ponovno o Tcl/Tk

Izvor: habr.com

Kupite pouzdan hosting za web stranice s DDoS zaštitom, VPS VDS servere 🔥 Kupite pouzdan hosting za web stranice s DDoS zaštitom, VPS VDS servere | ProHoster