1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

1C mahsulotlari Linux muhitida qanday ishlashi mavzusini o'rganar ekanmiz, bitta kamchilik aniqlandi - 1C serverlari klasterini boshqarish uchun qulay grafik ko'p platformali vositaning yo'qligi. Va bu kamchilikni rac konsoli yordam dasturi uchun GUI yozish orqali tuzatishga qaror qilindi. Tcl/tk dasturlash tili sifatida tanlandi, menimcha, bu vazifa uchun eng mos keladi. Shunday qilib, men ushbu materialda yechimning ba'zi qiziqarli tomonlarini taqdim qilmoqchiman.

Ishlash uchun sizga tcl/tk va 1C tarqatish kerak bo'ladi. Va men uchinchi tomon paketlaridan foydalanmasdan asosiy tcl/tk yetkazib berish imkoniyatlaridan maksimal darajada foydalanishga qaror qilganim uchun, menga ttk-ni o'z ichiga olgan 8.6.7 versiyasi kerak bo'ladi - qo'shimcha grafik elementlarga ega paket, bizga asosan ttk kerak. ::TreeView, u daraxt tuzilishi shaklida ham, jadval (ro'yxat) ko'rinishida ham ma'lumotlarni ko'rsatish imkonini beradi. Shuningdek, yangi versiyada istisnolar bilan ishlash qayta ishlandi (tashqi buyruqlarni ishga tushirishda loyihada foydalaniladigan try buyrug'i).

Loyiha bir nechta fayllardan iborat (garchi hamma narsani bitta faylda qilishingizga hech narsa xalaqit bermasa ham):

rac_gui.cfg - standart konfiguratsiya
rac_gui.tcl - asosiy ishga tushirish skripti
lib katalogi ishga tushirilganda avtomatik ravishda yuklanadigan fayllarni o'z ichiga oladi:
function.tcl - protseduralar bilan fayl
gui.tcl - asosiy grafik interfeys
images.tcl - base64 rasmlar kutubxonasi

rac_gui.tcl fayli, aslida, tarjimonni ishga tushiradi, o'zgaruvchilarni ishga tushiradi, modullarni, konfiguratsiyalarni va hokazolarni yuklaydi. Sharhlar bilan fayl tarkibi:

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

Kerakli hamma narsani yuklab olgandan va rac yordam dasturi mavjudligini tekshirgandan so'ng, grafik oyna ochiladi. Dastur interfeysi uchta elementdan iborat:

Asboblar paneli, daraxt va ro'yxat

Men "daraxt" ning tarkibini 1C dan standart Windows uskunasiga iloji boricha o'xshash qildim.

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Ushbu oynani tashkil etuvchi asosiy kod faylda joylashgan
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

Dastur bilan ishlash algoritmi quyidagicha:

1. Birinchidan, siz asosiy klaster serverini qo'shishingiz kerak (ya'ni, klasterni boshqarish serveri (Linuxda boshqaruv “/opt/1C/v8.3/x86_64/ras klaster —daemon” buyrug'i bilan ishga tushiriladi)).

Buning uchun "+" tugmasini bosing va ochilgan oynada server manzili va portini kiriting:

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Shundan so'ng, serverimiz uni bosish orqali daraxtda paydo bo'ladi, klasterlar ro'yxati ochiladi yoki ulanish xatosi ko'rsatiladi.

2. Klaster nomini bosish u uchun mavjud funksiyalar ro'yxatini ochadi.

3.…

Va hokazo, ya'ni. yangi klaster qo'shish uchun ro'yxatda mavjud bo'lgan birini tanlang va asboblar panelidagi "+" tugmasini bosing va yangi klaster qo'shish dialog oynasi ko'rsatiladi:

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Asboblar panelidagi tugmalar kontekstga qarab vazifalarni bajaradi, ya'ni. Daraxt yoki ro'yxatning qaysi elementi tanlanganiga qarab, u yoki bu protsedura bajariladi.

Keling, qo'shish tugmasi ("+") misolini ko'rib chiqaylik:

Tugma yaratish kodi:

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

Bu erda biz tugma bosilganda "Qo'shish" protsedurasi bajarilishini ko'ramiz, uning kodi:

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
}

Tiklening afzalliklaridan biri bu: siz o'zgaruvchining qiymatini protsedura nomi sifatida berishingiz mumkin:

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

Ya'ni, masalan, asosiy serverni ko'rsatib, "+" tugmachasini bossak, Add::server protsedurasi ishga tushadi, agar klasterda bo'lsa - Add::cluster va hokazo (qaerda ekanligini yozaman. zarur "kalitlar" bir oz pastdan keladi), sanab o'tilgan protseduralar kontekstga mos keladigan grafik elementlarni tortadi.

Siz allaqachon sezganingizdek, shakllar uslub jihatidan o'xshash - bu ajablanarli emas, chunki ular bitta protsedura, aniqrog'i shaklning asosiy ramkasi (oyna, tugmalar, rasm, yorliq), protsedura nomi bilan ko'rsatiladi. 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
}

Chaqiruv parametrlari: sarlavha, kutubxonadagi belgi uchun rasm nomi (lib/images.tcl) va ixtiyoriy oyna nomi parametri (standart .add). Shunday qilib, agar biz asosiy server va klasterni qo'shish uchun yuqoridagi misollarni olsak, qo'ng'iroq mos ravishda bo'ladi:

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

yoki

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

Xo'sh, ushbu misollarni davom ettirib, men server yoki klaster uchun qo'shish dialoglarini ko'rsatadigan protseduralarni ko'rsataman.

:: server qo'shing

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
}

::klaster qo'shing

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
}

Ushbu protseduralar kodini solishtirganda, farq yalang'och ko'z bilan ko'rinadi, men "Ok" tugmachasini ishlovchiga e'tibor qarataman. Tk-da grafik elementlarning xossalari dasturni bajarish vaqtida variant yordamida bekor qilinishi mumkin yapılandırır. Masalan, tugmani ko'rsatish uchun dastlabki buyruq:

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

Ammo bizning shakllarimizda buyruq kerakli funksionallikka bog'liq:

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

Yuqoridagi misolda "tiqilib qolgan" tugmasi klaster qo'shish jarayonini boshlaydi.

Bu erda Tk-da grafik elementlar bilan ishlashga to'xtalib o'tish kerak - turli xil ma'lumotlarni kiritish elementlari uchun (kirish, combobox, tasdiqlash tugmasi va boshqalar) matn o'zgaruvchisi sifatida parametr kiritilgan:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Bu o'zgaruvchi global nomlar maydonida aniqlanadi va joriy kiritilgan qiymatni o'z ichiga oladi. Bular. maydondan kiritilgan matnni olish uchun faqat o'zgaruvchiga mos keladigan qiymatni o'qish kerak (albatta, elementni yaratishda aniqlangan bo'lsa).

Kiritilgan matnni olishning ikkinchi usuli (kirish turi elementlari uchun) get buyrug'idan foydalanishdir:

.add.frm.ent_name get

Ushbu ikkala usulni yuqoridagi kodda ko'rish mumkin.

Ushbu tugmani bosish, bu holda, rac jihatidan klaster qo'shish uchun yaratilgan buyruq qatori bilan RunCommand protsedurasini ishga tushiradi:

/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

Endi biz asosiy buyruqqa keldik, u bizga kerakli parametrlar bilan racni ishga tushirishni boshqaradi, shuningdek buyruqlar chiqishini ro'yxatlarga ajratadi va agar kerak bo'lsa, qaytaradi:

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

Asosiy server ma'lumotlarini kiritgandan so'ng, u daraxtga qo'shiladi, buning uchun yuqoridagi Add:server protsedurasida quyidagi kod javobgar bo'ladi:

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

Endi daraxtdagi server nomini bosish orqali biz ushbu server tomonidan boshqariladigan klasterlar ro'yxatini olamiz va klasterni bosish orqali biz klaster elementlari (serverlar, infobazalar va boshqalar) ro'yxatini olamiz. Bu TreePress protsedurasida (lib/function.tcl fayli) amalga oshiriladi:

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
}

Shunga ko'ra, Run::server asosiy server uchun ishga tushiriladi (klaster uchun - Run::cluster, ishlaydigan server uchun - Run::work_server va boshqalar). Bular. $ kalit o'zgaruvchining qiymati opsiya tomonidan ko'rsatilgan daraxt elementi nomining bir qismidir -id.

Keling, protseduraga e'tibor beraylik

:: serverni ishga tushiring

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

Ushbu protsedura RunCommand buyrug'i orqali serverdan olingan narsalarni qayta ishlaydi va daraxtga barcha turdagi narsalarni qo'shadi - klasterlar, turli ildiz elementlari (bazalar, ishchi serverlar, seanslar va boshqalar). Agar diqqat bilan qarasangiz, ichidagi InsertItemsWorkList protsedurasiga qo'ng'iroqni ko'rasiz. Oldin $lst o'zgaruvchisiga ro'yxat sifatida qaytarilgan rac konsoli yordam dasturining chiqishini qayta ishlash orqali grafik ro'yxatga elementlar qo'shish uchun ishlatiladi. Bu ikki nuqta bilan ajratilgan juft elementlarni o'z ichiga olgan ro'yxatlar ro'yxati.

Masalan, klaster ulanishlari ro'yxati:

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

Grafik shaklda u quyidagicha ko'rinadi:

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Yuqoridagi protsedura sarlavha va jadvalni to'ldirish uchun ma'lumotlar uchun elementlarning nomlarini tanlaydi:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # установка чередования цвета для строки
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # разбор строк на пары ключ - значение
    foreach i $lst {
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            lappend column_list [string trim $param]
            lappend value_list [string trim $value]
        }
    }
     # заполнение таблицы
    .frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
    .frm_work.tree_work insert {} end  -values $value_list -tags $tag
    .frm_work.tree_work column #0 -stretch
    # установка заголовков
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Bu yerda qatorni “:” bilan ajratilgan elementlarga ajratuvchi va roʻyxatni qaytaruvchi oddiy [split $str “:”] buyrugʻi oʻrniga oddiy ibora ishlatiladi, chunki baʼzi elementlarda ikki nuqta ham mavjud.

InsertClusterItems protsedurasi (bir nechta shunga o'xshashlardan biri) kerakli klaster elementi daraxtiga mos keladigan identifikatorlarga ega bo'lgan kichik elementlar ro'yxatini qo'shadi.
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
}

Shunga o'xshash protsedurani amalga oshirishning yana ikkita variantini ko'rib chiqishingiz mumkin, bu erda qanday qilib optimallashtirish va takroriy buyruqlardan xalos bo'lishingiz aniq ko'rinadi:

Ushbu protsedurada qo'shish va tekshirish birma-bir hal qilinadi:

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

Mana to'g'riroq yondashuv:

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

Ularning orasidagi farq tsikldan foydalanishda bo'lib, unda takroriy buyruq(lar) bajariladi. Qaysi yondashuvdan foydalanish ishlab chiquvchining ixtiyorida.

Biz elementlarni qo'shish va ma'lumotlarni olish masalalarini ko'rib chiqdik, endi tahrirlashga e'tibor qaratish vaqti keldi. Tahrirlash va qo'shish uchun asosan bir xil parametrlar ishlatilganligi sababli (axborot bazasidan tashqari), bir xil dialog shakllari qo'llaniladi. Qo'shish uchun protseduralarni chaqirish algoritmi quyidagicha ko'rinadi:

Qo'shing::$key->AddToplevel

Va shunday tahrirlash uchun:

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

Misol uchun, klasterni tahrirlashni olaylik, ya'ni. Daraxtdagi klaster nomini bosgandan so'ng, asboblar panelidagi (qalam) tahrirlash tugmasini bosing va ekranda tegishli shakl paydo bo'ladi:

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida
Tahrirlash::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
    }
}

Koddagi izohlarga asoslanib, printsipial jihatdan hamma narsa aniq, faqat tugmani qayta ishlash kodi bekor qilingan va maydonlarni ma'lumotlar bilan to'ldiradigan va o'zgaruvchilarni ishga tushiradigan FormFieldsDataInsert protsedurasi mavjud:

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

Ushbu protsedurada tcl ning yana bir afzalligi paydo bo'ldi - boshqa o'zgaruvchilarning qiymatlari o'zgaruvchilar nomlari bilan almashtiriladi. Bular. shakllarni to'ldirish va o'zgaruvchilarni ishga tushirishni avtomatlashtirish uchun maydonlar va o'zgaruvchilar nomlari rac yordam dasturining buyruq qatori kalitlariga va buyruq chiqish parametrlarining nomlariga mos keladi, ba'zi istisnolar bilan - chiziq pastki chiziq bilan almashtiriladi. Masalan rejalashtirilgan-ishlar-rad etish maydonga mos keladi rejalashtirilgan_ishlarni_rad etish va o'zgaruvchan rejalashtirilgan_ishlarni_rad etish.

Qo'shish va tahrirlash shakllari maydonlar tarkibida farq qilishi mumkin, masalan, ma'lumot bazasi bilan ishlash:

Axborot xavfsizligini qo'shish

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Axborot xavfsizligini tahrirlash

1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Tahrirlash tartibida Edit::infobase, kerakli maydonlar shaklga qo'shiladi; kod hajmi katta, shuning uchun men uni bu erda taqdim etmayman.

Analogiya bo'yicha, boshqa elementlar uchun qo'shish, tahrirlash, o'chirish protseduralari amalga oshiriladi.

Yordamchi dasturning ishlashi cheksiz miqdordagi serverlar, klasterlar, axborot bazalari va boshqalarni nazarda tutganligi sababli, qaysi klaster qaysi serverga yoki axborot xavfsizligi tizimiga tegishli ekanligini aniqlash uchun har birida qiymatlari o'rnatiladigan bir nechta global o'zgaruvchilar kiritilgan. daraxtning elementlarini bosganingizda. Bular. protsedura rekursiv ravishda barcha asosiy elementlardan o'tadi va o'zgaruvchilarni o'rnatadi:

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

1C klasteri avtorizatsiya bilan yoki ruxsatsiz ishlash imkonini beradi. Administratorlarning ikki turi mavjud - klaster agenti administratori va klaster administratori. Shunga ko'ra, to'g'ri ishlash uchun administrator login va parolini o'z ichiga olgan yana 4 ta global o'zgaruvchilar kiritildi. Bular. klasterda administrator hisobi mavjud bo'lsa, login va parolni kiritish uchun dialog oynasi ko'rsatiladi, ma'lumotlar xotirada saqlanadi va tegishli klaster uchun har bir buyruqqa kiritiladi.

Bu xatoliklarni hal qilish jarayoni uchun javobgardir.

ErrorParcing

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

Bular. buyruq qaytaradigan narsaga qarab, reaktsiya shunga mos ravishda bo'ladi.

Hozirgi vaqtda funksionallikning taxminan 95 foizi amalga oshirildi, faqat xavfsizlik profillari bilan ishlashni amalga oshirish va uni sinab ko'rish qoladi =). Ana xolos. Buzilgan hikoya uchun uzr so'rayman.

Kod an'anaviy ravishda mavjud shu yerda.

Yangilash: Men xavfsizlik profillari bilan ishlashni tugatdim. Endi funksionallik 100% amalga oshirildi.

Yangilanish 2: ingliz va rus tillarida mahalliylashtirish qo'shildi, win7 da ishlash sinovdan o'tkazildi
1C RAC uchun GUI yozish yoki yana Tcl/Tk haqida

Manba: www.habr.com

a Izoh qo'shish