1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

1C məhsullarının linux mühitində necə işlədiyi mövzusunu araşdırarkən bir çatışmazlıq aşkar edildi - 1C server klasterini idarə etmək üçün rahat qrafik multiplatforma alətin olmaması. Və rac konsolu yardım proqramı üçün GUI yazaraq bu çatışmazlığı düzəltməyə qərar verildi. İnkişaf dili tcl/tk idi, məncə, bu vəzifə üçün ən uyğundur. İndi isə mən bu materialda həllin bəzi maraqlı tərəflərini təqdim etmək istəyirəm.

İşləmək üçün tcl / tk və 1C paylamalarına ehtiyacınız olacaq. Üçüncü tərəf paketlərindən istifadə etmədən tcl / tk-nin əsas çatdırılmasının imkanlarından maksimum yararlanmaq qərarına gəldiyim üçün bizə ttk daxil olan 8.6.7 versiyası lazımdır - əlavə qrafik elementləri olan paket, bunlardan əsasən ttk lazımdır. :: TreeView, həm ağac strukturu şəklində, həm də cədvəl (siyahı) şəklində çıxış məlumatlarına imkan verir. Həmçinin, istisnalarla iş yeni versiyada (xarici əmrləri yerinə yetirərkən layihədə istifadə olunan try əmri) yenidən işlənib.

Layihə bir neçə fayldan ibarətdir (baxmayaraq ki, heç bir şey hər şeyin bir olmasına mane olmur):

rac_gui.cfg - standart konfiqurasiya
rac_gui.tcl - əsas başlanğıc skripti
lib kataloqu başlanğıcda avtomatik yüklənən faylları ehtiva edir:
function.tcl - prosedurları olan fayl
gui.tcl - əsas GUI
images.tcl - base64 şəkil kitabxanası

rac_gui.tcl faylı, əslində, tərcüməçini işə salır, dəyişənləri işə salır, modulları, konfiqurasiyaları yükləyir və s. Şərhləri olan faylın məzmunu:

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

Lazım olan hər şeyi yüklədikdən və rac yardım proqramının mövcudluğunu yoxladıqdan sonra qrafik pəncərəsi işə salınacaq. Proqram interfeysi üç elementdən ibarətdir:

Alətlər paneli, ağac və siyahı

Mən "ağacın" məzmununu 1C-dən adi pəncərə avadanlığına mümkün qədər oxşar etdim.

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Bu pəncərəni təşkil edən əsas kod faylda var
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

Proqramla işləmək üçün alqoritm aşağıdakı kimidir:

1. Başlanğıcda siz əsas klaster serverini əlavə etməlisiniz (yəni klaster idarəetmə serveri (linuxda idarəetmə "/opt/1C/v8.3/x86_64/ras cluster -daemon" əmri ilə başlanır)).

Bunu etmək üçün "+" düyməsini basın və açılan pəncərədə server ünvanını və portunu daxil edin:

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Bundan sonra serverimiz üzərinə klikləməklə ağacda görünəcək, klasterlərin siyahısı açılacaq və ya əlaqə xətası görünəcək.

2. Klaster adının üzərinə klikləməklə, onun üçün mövcud funksiyaların siyahısı açılacaq.

3. ...

Yaxşı, və s., yəni. yeni klaster əlavə etmək üçün siyahıda mövcud olan hər hansı birini seçin və alətlər panelində "+" düyməsini basın və yenisini əlavə etmək üçün dialoq görünəcək:

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Alətlər panelindəki düymələr kontekstdən asılı olaraq funksiyaları yerinə yetirir, yəni. ağacın və ya siyahının hansı elementinin seçilməsindən asılı olaraq bu və ya digər prosedur yerinə yetiriləcəkdir.

Əlavə et düyməsinin ("+") nümunəsini nəzərdən keçirin:

Düymə formalaşdırma kodu:

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

Burada görürük ki, düymə basıldıqda “Əlavə et” proseduru yerinə yetiriləcək, onun kodu belədir:

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
}

Budur, qıdıqlamanın müsbət cəhətlərindən biri - dəyişənin dəyərini prosedurun adı kimi keçirə bilərsiniz:

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

Yəni, məsələn, əsas serverə girib “+” düyməsini sıxsaq, Add::server proseduru işə düşəcək, əgər klasterdəsə — Add::cluster və s. zəruri "açarların" aşağıdan gəldiyi yerlərdə) sadalanan prosedurlar kontekstə uyğun qrafik elementləri çəkir.

Diqqət etdiyiniz kimi, formalar üslub baxımından oxşardır - bu təəccüblü deyil, çünki onlar bir prosedurla, daha dəqiq desək, formanın əsas çərçivəsi (pəncərə, düymələr, şəkil, etiket), prosedurun adı ilə göstərilir. 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
}

Zəng parametrləri: başlıq, kitabxanadakı ikona üçün şəkil adı (lib/images.tcl) və əlavə pəncərə adı parametri (defolt .add). Beləliklə, əsas server və klasteri əlavə etmək üçün yuxarıdakı nümunələri götürsək, müvafiq olaraq zəng olacaq:

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

və ya

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

Yaxşı, bu nümunələrlə davam edərək, bir server və ya klaster üçün əlavə dialoqlarını göstərən prosedurları göstərəcəyəm.

Əlavə et::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
}

Əlavə edin::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
}

Bu prosedurların kodunu müqayisə edərkən fərq çılpaq gözlə görünür, diqqətimi OK düyməsini idarə edənə yönəldəcəyəm. Tk-da qrafik elementlərin xassələri seçim ilə icra zamanı ləğv edilə bilər konfiqurasiya. Məsələn, ilkin düymənin çıxış əmri:

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

Ancaq formalarımızda əmr tələb olunan funksionallıqdan asılıdır:

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

Yuxarıdakı misalda "sıxılmış" düyməsi klasterin əlavə edilməsi proseduruna başlayır.

Burada Tk-da qrafik elementlərlə işləmək üçün bir təxribat aparmağa dəyər - müxtəlif məlumat daxiletmə elementləri üçün (giriş, birləşmə qutusu, yoxlama düyməsi və s.), mətn dəyişəni (mətn dəyişəni) kimi bir parametr təqdim olunur:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Bu dəyişən qlobal ad məkanında müəyyən edilir və hazırda daxil edilmiş dəyəri ehtiva edir. Bunlar. sahədən daxil edilmiş mətni əldə etmək üçün sadəcə dəyişənə uyğun olan dəyəri oxumaq lazımdır (əlbəttə ki, elementin yaradıldığı zaman müəyyən olunmaq şərti ilə).

Daxil edilmiş mətni əldə etməyin ikinci üsulu (giriş tipli elementlər üçün) get əmrindən istifadə etməkdir:

.add.frm.ent_name get

Bu üsulların hər ikisini yuxarıdakı kodda görmək olar.

Bu düyməni basmaqla, bu halda, yaradılan klaster rac baxımından əmr sətri əlavə etməklə RunCommand prosedurunu işə salır:

/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

Beləliklə, biz lazım olan parametrlərlə rac-ın işə salınmasına nəzarət edən, həmçinin əmrlərin çıxışını siyahılara ayıran və lazım olduqda qaytaran əsas komandaya gəldik:

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

Əsas serverin məlumatlarını daxil etdikdən sonra ağaca əlavə olunacaq, bunun üçün yuxarıdakı Add:server prosedurunda aşağıdakı kod cavabdehdir:

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

İndi ağacdakı server adının üzərinə klikləməklə bu server tərəfindən idarə olunan klasterlərin siyahısını, klaster üzərinə klikləməklə isə klaster elementlərinin (serverlər, infobazalar və s.) siyahısını əldə edirik. Bu, TreePress prosedurunda həyata keçirilir (lib/function.tcl faylı):

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
}

Müvafiq olaraq, əsas server üçün Run::server işə salınacaq (klaster üçün Run::cluster, işləyən server üçün Run::work_server və s.). Bunlar. $açar dəyişəninin dəyəri seçim tərəfindən verilən ağac elementinin adının bir hissəsidir -id.

Prosedura baxaq

çalıştır :: 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
    }
}

Bu prosedur RunCommand əmri vasitəsilə serverdən qəbul edilənləri emal edir və ağaca hər cür şey əlavə edir - klasterlər, müxtəlif kök elementləri (bazalar, işləyən serverlər, sessiyalar və s.). Diqqətlə baxsanız, içəridə InsertItemsWorkList proseduruna çağırışı görə bilərsiniz. O, əvvəllər $lst dəyişənində siyahı kimi qaytarılmış rac konsol yardım proqramının çıxışını emal edərək qrafik siyahıya elementlər əlavə etmək üçün istifadə olunur. Bu, iki nöqtə ilə ayrılmış element cütlərini ehtiva edən siyahıların siyahısıdır.

Məsələn, klaster əlaqələrinin siyahısı:

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

Qrafik olaraq bu kimi görünəcək:

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Yuxarıdakı prosedur başlıq üçün element adlarını və cədvəli doldurmaq üçün məlumatları çıxarır:

InsertItems WorkList

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
}

Burada sətri ":" ilə ayrılmış elementlərə bölən və siyahı qaytaran sadə [split $str ":"] əmri əvəzinə müntəzəm ifadə istifadə olunur, çünki bəzi elementlərdə iki nöqtə də var.

InsertClusterItems proseduru (bir neçə oxşar prosedurdan biri) sadəcə olaraq ağacda tələb olunan klaster elementinə müvafiq identifikatorları olan uşaq elementlərin siyahısını əlavə edir.
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
}

Belə bir proseduru həyata keçirmək üçün daha iki variantı nəzərdən keçirə bilərsiniz, burada təkrarlanan əmrləri necə optimallaşdıra və yaxa qurtara biləcəyiniz aydın şəkildə görünəcəkdir:

Bu prosedurda əlavə və yoxlama baş-başa həll olunur:

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

Və burada daha yaxşı bir yanaşma var:

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

Aralarındakı fərq təkrar əmr (lər)in yerinə yetirildiyi dövrün tətbiqidir. Hansı yanaşmadan istifadə etmək tərtibatçının ixtiyarındadır.

Elementlər əlavə etmək və məlumat əldə etmək, biz hesab etdik, redaktə etməyi dayandırmağın vaxtı gəldi. Əsasən redaktə və əlavə etmək üçün eyni parametrlər istifadə edildiyi üçün (istisna infobazadır), dialoq formaları eyni istifadə olunur. Əlavə etmək üçün prosedurları çağırmaq üçün alqoritm belə görünür:

Add::$key->AddTopLevel

Və belə redaktə üçün:

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

Məsələn, klaster redaktəsini götürək, yəni. klasterin adındakı ağacın üzərinə vuraraq, alətlər panelində (qələm) redaktə düyməsini sıxın və ekranda müvafiq forma görünəcək:

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında
Redaktə::klaster

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

Koddakı şərhlərə görə, prinsipcə, hər şey aydındır, yalnız düyməni idarə edən kodun yenidən təyin edilməsi və sahələri məlumatlarla dolduran və dəyişənləri işə salan FormFieldsDataInsert proseduru var:

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

Bu prosedurda tcl-nin başqa bir artısı ortaya çıxdı - digər dəyişənlərin dəyərləri dəyişən adları ilə əvəz olunur. Bunlar. formaların doldurulmasını və dəyişənlərin işə salınmasını avtomatlaşdırmaq üçün sahələrin və dəyişənlərin adları rac yardım proqramının əmr xətti açarlarına və bəzi istisnalarla komanda çıxış parametrlərinin adlarına uyğun gəlir - tire alt xətt ilə əvəz edilmişdir. Məs planlaşdırılmış-işləri-inkar sahəyə uyğun gəlir planlaşdırılmış_işləri_inkar edin və dəyişən planlaşdırılmış_işləri_inkar edin.

Əlavə etmək və redaktə etmək üçün formalar sahələrin tərkibində fərqlənə bilər, məsələn, infobaza ilə işləmək:

IB əlavə edin

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

IB redaktəsi

1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Redaktə prosedurunda Edit::infobase, tələb olunan sahələr forma əlavə olunur, ona görə də kodu burada vermirəm.

Analoji olaraq digər elementlər üçün əlavə, redaktə, silmə prosedurları həyata keçirilir.

Kommunalın işləməsi bir serverin və ya İS-in hansı klasterə aid olduğunu müəyyən etmək üçün sınırsız sayda server, klaster, məlumat bazası və s. nəzərdə tutduğundan, hər dəfə kliklədiyiniz zaman dəyərləri təyin olunan bir neçə qlobal dəyişən təqdim olunur. ağacın elementləri. Bunlar. prosedur rekursiv olaraq bütün əsas elementlərdən keçir və dəyişənləri təyin edir:

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

Cluster 1C sizə icazə ilə və ya icazəsiz işləməyə imkan verir. İki növ administrator var - klaster agenti administratoru və klaster inzibatçısı. Müvafiq olaraq, düzgün işləmək üçün administratorun giriş və şifrəsini ehtiva edən daha 4 qlobal dəyişən təqdim edilmişdir. Bunlar. klasterdə administrator hesabı varsa, o zaman loqin və parolun daxil edilməsi üçün dialoq pəncərəsi görünəcək, məlumatlar yaddaşda saxlanılacaq və müvafiq klaster üçün hər bir komandaya əvəz olunacaq.

Bu, səhvlərin idarə edilməsi prosedurunun məsuliyyətidir.

Parcing xətası

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

Bunlar. əmrin nə qaytardığından asılı olaraq, müvafiq olaraq reaksiya olacaq.

Hazırda funksionallıq təxminən 95 faiz həyata keçirilir, təhlükəsizlik profilləri ilə işi həyata keçirmək və onu sınaqdan keçirmək qalır =). Hamısı budur. Əzilmiş hekayəyə görə üzr istəyirəm.

Kod, ənənəvi olaraq mövcuddur burada.

Yeniləmə: Təhlükəsizlik profilləri ilə iş tamamlandı. İndi funksionallıq 100% həyata keçirilir.

Yeniləmə 2: İngilis və Rus dillərinə lokallaşdırma əlavə edildi, win7-də sınaqdan keçirilmiş iş
1C RAC üçün GUI yazırıq və ya yenidən Tcl / Tk haqqında

Mənbə: www.habr.com

Добавить комментарий