Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Вақте ки мо ба мавзӯи чӣ гуна кор кардани маҳсулоти 1C дар муҳити Linux шинос шудем, як нуқсон ошкор шуд - набудани асбоби қулайи графикии бисёрплатформа барои идоракунии кластери серверҳои 1C. Ва тасмим гирифта шуд, ки ин камбудиро тавассути навиштани GUI барои утилитаи консолии rac ислоҳ кунад. Tcl/tk ҳамчун забони рушд интихоб шудааст, ки ба назари ман, барои ин вазифа мувофиқтарин аст. Ва ҳамин тавр, ман мехостам дар ин мавод якчанд ҷанбаҳои ҷолиби ҳалли онро пешниҳод кунам.

Барои кор ба шумо тақсимоти tcl/tk ва 1C лозим аст. Ва азбаски ман қарор додам, ки бе истифодаи бастаҳои тарафи сеюм аз имкониятҳои интиқоли асосии tcl/tk истифода барам, ба ман версияи 8.6.7 лозим аст, ки ttk - бастаи дорои унсурҳои графикии иловагиро дар бар мегирад, ки ба мо лозим аст, асосан, ttk::TreeView, он имкон медиҳад, ки маълумот ҳам дар шакли сохтори дарахт ва ҳам дар шакли ҷадвал (рӯйхат) намоиш дода шавад. Инчунин, дар версияи нав кор бо истисноҳо аз нав кор карда шуд (фармони try, ки дар лоиҳа ҳангоми иҷро кардани фармонҳои беруна истифода мешавад).

Лоиҳа аз якчанд файл иборат аст (гарчанде ки ҳеҷ чиз ба шумо имкон намедиҳад, ки ҳама чизро дар як кор кунед):

rac_gui.cfg - танзимоти пешфарз
rac_gui.tcl - скрипти асосии оғозёбӣ
Феҳристи lib дорои файлҳое мебошад, ки ҳангоми оғозёбӣ ба таври худкор бор карда мешаванд:
function.tcl - файл бо расмиёти
gui.tcl - интерфейси асосии графикӣ
images.tcl - китобхонаи тасвирҳои base64

Файли rac_gui.tcl, воқеан, тарҷумонро оғоз мекунад, тағирёбандаҳоро оғоз мекунад, модулҳо, конфигуратсияҳоро бор мекунад ва ғайра. Мундариҷаи файл бо шарҳҳо:

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

Пас аз зеркашии ҳама чизҳои зарурӣ ва тафтиши мавҷудияти утилитаи rac, равзанаи графикӣ кушода мешавад. Интерфейси барнома аз се унсур иборат аст:

Панели асбобҳо, дарахт ва рӯйхат

Ман мундариҷаи "дарахтро" то ҳадди имкон ба таҷҳизоти стандартии Windows аз 1C монанд кардам.

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Рамзи асосие, ки ин равзанаро ташкил медиҳад, дар файл мавҷуд аст
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

Алгоритми кор бо барнома чунин аст:

1. Аввалан, шумо бояд сервери асосии кластерро илова кунед (яъне сервери идоракунии кластер (дар Linux идоракунӣ бо фармони "/opt/1C/v8.3/x86_64/ras cluster —daemon" оғоз мешавад)).

Барои ин, тугмаи "+" -ро клик кунед ва дар равзанаи кушодашуда суроғаи сервер ва портро ворид кунед:

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Пас аз он, сервери мо бо пахш кардани он дар дарахт пайдо мешавад, рӯйхати кластерҳо кушода мешавад ё хатои пайвастшавӣ нишон дода мешавад.

2. Ангуштзании номи кластер рӯйхати функсияҳои барои он дастрасро мекушояд.

3.…

Ва ғайра, яъне. барои илова кардани кластери нав, ягон каси дар рӯйхат мавҷудбударо интихоб кунед ва тугмаи "+"-ро дар панели асбобҳо пахш кунед ва муколамаи иловаи нав пайдо мешавад:

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Тугмаҳои панели асбобҳо вазифаҳоро вобаста ба контекст иҷро мекунанд, яъне. Вобаста аз он, ки кадом элементи дарахт ё рӯйхат интихоб шудааст, ин ё он тартиб иҷро карда мешавад.

Биёед мисоли тугмаи иловаро бубинем ("+"):

Рамзи тавлиди тугма:

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

Дар ин ҷо мебинем, ки ҳангоми пахш кардани тугма тартиби "Илова кардан" иҷро мешавад, рамзи он:

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
}

Ин аст яке аз бартариҳои tickle: шумо метавонед арзиши тағирёбандаро ҳамчун номи процедура гузаронед:

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

Яъне, масалан, агар мо сервери асосиро нишон диҳем ва тугмаи "+" -ро пахш кунем, пас тартиби Add::server оғоз мешавад, агар дар кластер - Add::cluster ва ғайра (ман менависам, ки дар куҷо "Калидҳо" -и зарурӣ аз каме дар поён меоянд), тартиби номбаршуда унсурҳои графикии ба контекст мувофиқро ҷалб мекунанд.

Тавре ки шумо аллакай қайд кардаед, шаклҳо аз ҷиҳати услуб ба ҳам монанданд - ин тааҷҷубовар нест, зеро онҳо бо як процедура, аниқтараш чаҳорчӯбаи асосии форма (тиреза, тугмаҳо, тасвир, нишона), номи процедура нишон дода мешаванд. 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
}

Параметрҳои занг: унвон, номи тасвир барои нишона аз китобхона (lib/images.tcl) ва параметри ихтиёрии номи тиреза (пешфарз .add). Ҳамин тариқ, агар мо мисолҳои дар боло зикршударо барои илова кардани сервери асосӣ ва кластер гирем, занг мувофиқан хоҳад буд:

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

ё

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

Хуб, бо ин мисолҳо идома дода, ман расмҳоеро нишон медиҳам, ки муколамаҳои иловагиро барои сервер ё кластер нишон медиҳанд.

Илова :: сервер

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
}

Илова :: кластер

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
}

Ҳангоми муқоисаи рамзи ин равандҳо, фарқият ба чашми бараҳна намоён аст; ман ба коркарди тугмаи "OK" тамаркуз мекунам. Дар Tk, хосиятҳои элементҳои графикиро ҳангоми иҷрои барнома бо истифода аз опсия бекор кардан мумкин аст танзим кунед. Масалан, фармони ибтидоӣ барои намоиш додани тугма:

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

Аммо дар шаклҳои мо, фармон аз функсияҳои зарурӣ вобаста аст:

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

Дар мисоли боло, тугмаи "бандшуда" тартиби илова кардани кластерро оғоз мекунад.

Дар ин ҷо ба ҷои кор кардан бо унсурҳои графикӣ дар Tk - барои унсурҳои гуногуни вуруди додаҳо (ворид, қуттии комбинатсия, тугмаи чек ва ғайра) параметр ҳамчун тағирёбандаи матн ҷорӣ карда шудааст:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Ин тағирёбанда дар фазои номҳои глобалӣ муайян карда шудааст ва арзиши ҳозираи воридшударо дар бар мегирад. Онхое. барои гирифтани матни воридшуда аз майдон, шумо бояд танҳо арзиши ба тағирёбанда мувофиқро хонед (албатта, ба шарте ки он ҳангоми сохтани элемент муайян карда шавад).

Усули дуюми дарёфти матни воридшуда (барои унсурҳои навъи вуруд) ин истифодаи фармони get мебошад:

.add.frm.ent_name get

Ҳардуи ин усулҳоро дар коди боло дидан мумкин аст.

Ангуштзании ин тугма, дар ин ҳолат, тартиби RunCommand-ро бо сатри фармони тавлидшуда барои илова кардани кластер аз рӯи 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

Акнун мо ба фармони асосӣ меравем, ки оғози racро бо параметрҳои ба мо лозима назорат мекунад, инчунин баромади фармонҳоро ба рӯйхатҳо таҳлил мекунад ва агар лозим бошад, бармегардад:

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

Пас аз ворид кардани маълумоти сервери асосӣ, он ба дарахт илова карда мешавад, барои ин, дар тартиби боло Add:server, рамзи зерин масъул аст:

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

Ҳоло, бо пахш кардани номи сервер дар дарахт, мо рӯйхати кластерҳоеро, ки аз ҷониби он сервер идора карда мешаванд, мегирем ва бо пахш кардани кластер, мо рӯйхати унсурҳои кластерро мегирем (серверҳо, инфобазаҳо ва ғайра). Ин дар тартиби TreePress амалӣ карда мешавад (file lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # определяем выделенный элемент
    set id  [$tree selection]
   # устанавливаем нужные глобальные переменные
    SetGlobalVarFromTreeItems $tree $id
   # Определяем ключ и значение, т.е. именно тип выбранного элемента
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # и в зависимости от того что выбрали будет запущена соответствующая процедура 
   # в пространстве имён Run
    Run::$key $tree $host $values
}

Мутаносибан, Run::server барои сервери асосӣ оғоз карда мешавад (барои кластер - Run::cluster, барои сервери корӣ - Run::work_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
    }
}

Ин тартиб он чизеро, ки аз сервер тавассути фармони RunCommand гирифта шуда буд, коркард мекунад ва ба дарахт ҳама гуна чизҳоро илова мекунад - кластерҳо, унсурҳои гуногуни реша (базаҳо, серверҳои корӣ, сеансҳо ва ғайра). Агар шумо бодиққат нигоҳ кунед, шумо зангро ба тартиби InsertItemsWorkList дар дохили он мебинед. Он барои илова кардани элементҳо ба рӯйхати графикӣ тавассути коркарди баромади утилитаи консолии rac, ки қаблан ҳамчун рӯйхат ба тағирёбандаи $lst баргардонида шуда буд, истифода мешавад. Ин рӯйхати рӯйхатҳоест, ки дорои ҷуфтҳои элементҳои бо аломати ду нуқта ҷудошуда мебошанд.

Масалан, рӯйхати пайвастҳои кластер:

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

Дар шакли графикӣ он чунин хоҳад буд:

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Тартиби дар боло зикршуда номи элементҳоро барои сарлавҳа ва маълумот барои пур кардани ҷадвал интихоб мекунад:

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
}

Дар ин ҷо ба ҷои фармони оддӣ [split $str ":"], ки сатрро ба унсурҳои бо ":" ҷудошуда тақсим мекунад ва рӯйхатро бармегардонад, ифодаи муқаррарӣ истифода мешавад, зеро дар баъзе элементҳо ду нуқта низ мавҷуд аст.

Тартиби InsertClusterItems (яке аз якчанд монанд) танҳо рӯйхати унсурҳои кӯдакро бо идентификаторҳои мувофиқ ба дарахти элементи кластери лозимӣ илова мекунад.
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
}

Шумо метавонед ду варианти дигарро барои амалисозии тартиби шабеҳ баррасӣ кунед, ки дар он ба таври возеҳ намоён хоҳад шуд, ки чӣ гуна шумо метавонед аз фармонҳои такроршаванда оптимизатсия ва халос шавед:

Дар ин тартиб, илова кардан ва тафтиш якҷоя ҳал карда мешаванд:

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

Ин аст равиши дурусттар:

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

Фарқи байни онҳо истифодаи ҳалқаест, ки дар он фармон(ҳо)-и такрорӣ иҷро мешаванд. Кадом равиши истифода дар ихтиёри таҳиягар аст.

Мо илова кардани элементҳо ва дарёфти маълумотро фаро гирифтем, ҳоло вақти он расидааст, ки ба таҳрир таваҷҷӯҳ кунем. Азбаски аслан барои таҳрир ва илова як параметрҳо истифода мешаванд (ба истиснои пойгоҳи иттилоотӣ), ҳамон шаклҳои муколама истифода мешаванд. Алгоритми даъвати расмиёти илова чунин менамояд:

Илова ::$key->AddToplevel

Ва барои таҳрир чунин:

Таҳрир ::$key->Add::$key->AddTopLevel

Масалан, биёед таҳрири кластерро гирем, яъне. Номи кластерро дар дарахт пахш карда, тугмаи таҳрирро дар панели асбобҳо (қалам) пахш кунед ва шакли мувофиқ дар экран пайдо мешавад:

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk
Таҳрир :: кластер

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

Дар асоси шарҳҳои код, аслан ҳама чиз равшан аст, ба истиснои он ки коди коркардкунандаи тугмаҳо бекор карда шудааст ва тартиби FormFieldsDataInsert мавҷуд аст, ки майдонҳоро бо маълумот пур мекунад ва тағирёбандаҳоро оғоз мекунад:

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

Дар ин тартиб, бартарии дигари tcl пайдо шуд - арзишҳои тағирёбандаҳои дигар ҳамчун номҳои тағирёбанда иваз карда мешаванд. Онхое. барои автоматикунонии пуркунии формаҳо ва инициализатсияи тағирёбандаҳо, номи майдонҳо ва тағирёбандаҳо ба коммутаторҳои сатри фармони утилитаи rac ва номи параметрҳои баромади фармон мувофиқат мекунанд, ба истиснои баъзе истисно - тире бо зерхат иваз карда мешавад. Масалан кор-хои ба накша гирифташударо рад мекунанд ба майдон мувофиқат мекунад ent_credded_jobs_dey ва тағйирёбанда рад кардани_корҳои ба нақша гирифташуда.

Шаклҳо барои илова ва таҳрир метавонанд дар таркиби майдонҳо фарқ кунанд, масалан, кор бо пойгоҳи иттилоотӣ:

Илова кардани амнияти иттилоотӣ

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Таҳрири амнияти иттилоотӣ

Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Дар тартиби таҳриркунӣ Edit::infobase, майдонҳои зарурӣ ба форма илова карда мешаванд; рамз ҳаҷм дорад, бинобар ин ман онро дар ин ҷо пешниҳод намекунам.

Аз рӯи қиёс, тартиби илова кардан, таҳрир кардан, нест кардан барои дигар элементҳо амалӣ карда мешавад.

Азбаски кори утилита шумораи номаҳдуди серверҳо, кластерҳо, пойгоҳҳои иттилоотӣ ва ғайраро дар назар дорад, барои муайян кардани кадом кластер ба кадом сервер ё системаи амнияти иттилоотӣ мансуб аст, якчанд тағирёбандаҳои глобалӣ ҷорӣ карда шудаанд, ки арзишҳои ҳар яки онҳо муқаррар карда мешаванд. вақте ки шумо ба унсурҳои дарахт клик мекунед. Онхое. тартиби рекурсивӣ аз тамоми унсурҳои волидайн мегузарад ва тағирёбандаҳоро муқаррар мекунад:

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

Кластери 1С ба шумо имкон медиҳад, ки бо иҷозат ё бидуни иҷозат кор кунед. Ду намуди администраторҳо мавҷуданд - мудири агенти кластер ва мудири кластер. Ҳамин тариқ, барои дуруст кор кардан, боз 4 тағирёбандаи глобалӣ ҷорӣ карда шуданд, ки дорои логин ва пароли администратор мебошанд. Онхое. агар дар кластер ҳисоби администратор мавҷуд бошад, муколама барои ворид кардани логин ва пароли шумо пайдо мешавад, маълумот дар хотира нигоҳ дошта мешавад ва ба ҳар як фармони кластери мувофиқ ворид карда мешавад.

Ин масъулияти тартиби коркарди хато аст.

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

Онхое. вобаста ба он ки фармон чӣ бармегардад, реаксия мувофиқи он хоҳад буд.

Дар айни замон, тақрибан 95 фоизи функсияҳо амалӣ карда шудаанд, танҳо иҷрои кор бо профилҳои амниятӣ ва санҷиши он боқӣ мемонад =). Ҳамааш ҳамин. Барои ҳикояи ғафсшуда бахшиш мепурсам.

Рамзи анъанавӣ дастрас аст дар ин ҷо.

Навсозӣ: Ман кор бо профилҳои амниятро анҷом додам. Ҳоло ин функсия 100% иҷро шудааст.

Навсозии 2: маҳаллӣсозӣ ба забони англисӣ ва русӣ илова карда шуд, кор дар win7 санҷида шуд
Навиштани GUI барои 1C RAC ё боз дар бораи Tcl/Tk

Манбаъ: will.com

Илова Эзоҳ