Ao me aprofundar no tema dos produtos 1C em ambiente Linux, identifiquei uma desvantagem: a falta de uma ferramenta gráfica multiplataforma conveniente para gerenciar o cluster de servidores 1C. Assim, decidimos corrigir essa deficiência, desenvolvendo uma interface gráfica para a ferramenta de console rac. A linguagem escolhida para o desenvolvimento foi o tcl/tk, que, na minha opinião, é a mais adequada para essa tarefa. Aqui, gostaria de apresentar alguns aspectos interessantes da solução neste material.
Para o funcionamento, serão necessários os pacotes tcl/tk e 1C. Como decidi aproveitar ao máximo os recursos da versão padrão do tcl/tk sem utilizar pacotes de terceiros, precisaremos da versão 8.6.7, que inclui o ttk — um pacote com elementos gráficos adicionais, dos quais precisaremos, principalmente, do ttk::TreeView, que permite exibir dados tanto em uma estrutura hierárquica quanto em uma tabela (lista). Além disso, na nova versão, foi reformulada a manipulação de exceções (o comando try, que é utilizado no projeto ao executar comandos externos).
O projeto consiste em vários arquivos (embora nada impeça que tudo seja feito em um único arquivo):
rac_gui.cfg — configuração padrão
rac_gui.tcl — script principal de inicialização
No diretório lib, estão os arquivos que são carregados automaticamente na inicialização:
function.tcl — arquivo com rotinas
gui.tcl — interface gráfica principal
images.tcl — biblioteca de imagens em base64
O arquivo rac_gui.tcl, na verdade, inicializa o interpretador, inicializa variáveis, carrega módulos, configurações, e assim por diante. O conteúdo do arquivo com comentários:
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"
}
}Após carregar tudo o que é necessário e verificar a presença da ferramenta rac, uma janela gráfica será aberta. A interface do programa consiste em três elementos:
Barra de ferramentas, árvore e lista
O conteúdo da "árvore" foi feito o mais semelhante possível à extensão padrão do Windows da 1C.
O código principal que forma esta janela está contido no arquivo
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
O algoritmo de operação do programa é o seguinte:
1. Primeiro, é necessário adicionar o servidor principal do cluster (ou seja, o servidor de gerenciamento do cluster (em Linux, o gerenciamento é iniciado com o comando "/opt/1C/v8.3/x86_64/ras cluster —daemon").
Para isso, clique no botão “+” e, na janela que se abre, insira o endereço do servidor e a porta:
Após isso, o nosso servidor aparecerá na árvore e, ao clicar nele, abrirá a lista de clusters ou será exibida uma mensagem de erro de conexão.
2. Clicando no nome do cluster, será aberta uma lista de funções disponíveis para ele.
3.…
E assim por diante, ou seja, para adicionar um novo cluster, selecionamos qualquer um disponível na lista e clicamos no botão “+” na barra de ferramentas, o que exibirá o diálogo de adição do novo:
Os botões na barra de ferramentas executam funções dependendo do contexto, ou seja, do elemento da árvore ou lista que foi selecionado, uma determinada operação será realizada.
Vamos considerar o exemplo do botão de adição (“+”):
Código para criar o botão:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Aqui vemos que, ao pressionar o botão, a operação “Add” será executada, seu código:
proc Add {} {
global active_cluster host
# Definindo o ID do elemento selecionado
set id [.frm_tree.tree selection]
# Definindo o valor desse elemento
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
# dependendo do que foi selecionado, a operação necessária será iniciada
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
return
}
Add::$key .frm_tree.tree $host $values
}Aqui vemos uma das vantagens do Tcl — o nome do procedimento pode receber o valor de uma variável:
Add::$key .frm_tree.tree $host $valuesOu seja, por exemplo, se clicarmos no servidor principal e pressionarmos “+”, a operação Add::server será iniciada; se no cluster — Add::cluster, e assim por diante (sobre de onde vêm as “chaves” necessárias eu escreverei um pouco abaixo), os procedimentos listados desenham os elementos gráficos correspondentes ao contexto.
Como você já deve ter notado, os formulários são semelhantes em estilo — e isso não é surpreendente, pois são gerados por um único procedimento, mais precisamente a estrutura principal do formulário (janela, botões, imagem, rótulo), nome do procedimento: 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
# rótulo com ícone
ttk::label $win_name.lbl -image $img
# frame com campos de entrada
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
# frame e botões
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
}
Parâmetros da chamada: título, nome da imagem do ícone da biblioteca (lib/images.tcl) e um parâmetro opcional para o nome da janela (padrão .add). Assim, se considerarmos os exemplos acima para adicionar o servidor principal e o cluster, a chamada será, respectivamente:
AddToplevel "Adicionando Servidor Principal" server_grey_64ou
AddToplevel "Adicionando Cluster" cluster_grey_64E continuando com esses exemplos, vou mostrar os procedimentos que apresentam os diálogos de adição para o servidor ou cluster.
Add::server
proc Add::server {} {
global default
# exibindo o formulário principal
set frm [AddToplevel "Adicionando Servidor Principal" server_grey_64]
# adicionando rótulos e campos de entrada a este formulário
label $frm.lbl_host -text "Endereço do Servidor"
entry $frm.ent_host
label $frm.lbl_port -text "Porta"
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]
# redefinindo o manipulador de pressionamento de botão
.add.frm_btn.btn_ok configure -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
return $frm
}Add::cluster
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
# definindo variáveis globais ()
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 "Adicionar Cluster" cluster_grey_64]
label $frm.lbl_host -text "Endereço do Servidor Principal"
entry $frm.ent_host
label $frm.lbl_port -text "Porta"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text "Nome do Cluster"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Conexão Segura"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text "Parar processos desligados após:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Nível de Tolerância a Falhas"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Modo de Distribuição de Carga"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Desvio Aceitável do Número de Erros do Servidor, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Processos Ativos:"
label $frm.lbl_lifetime_limit -text "Período de Reinício, seg."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Tamanho Máximo da Memória, KB"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Intervalo de Excedente de Memória, seg."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Forçar Encerramento de Processos Problemáticos"
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
# redefinimos o manipulador
.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
}Ao comparar o código desses procedimentos, a diferença é visível a olho nu; gostaria de chamar a atenção para o manipulador do botão "Ok". No Tk, as propriedades dos elementos gráficos podem ser redefinidas durante a execução do programa usando a opção configure. Por exemplo, o comando inicial para a exibição do botão:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }Mas em nossos formulários, o comando depende da funcionalidade necessária:
.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
}
No exemplo acima, o botão "está preparado" para iniciar o procedimento de adição do cluster.
Aqui vale a pena fazer uma pausa para discutir o trabalho com elementos gráficos no Tk — para vários elementos de entrada de dados (entry, combobox, checkbutton, etc.), foi introduzido um parâmetro chamado variável de texto (textvariable):
entry $frm.ent_lifetime_limit -textvariable lifetime_limitEssa variável é definida no espaço de nomes global e contém o valor atual inserido. Ou seja, para obter o texto inserido no campo, basta ler o valor da variável correspondente (claro, desde que seja definida ao criar o elemento).
O segundo método para obter o texto inserido (para elementos do tipo entry) é usar o comando get:
.add.frm.ent_name getAmbos os métodos podem ser vistos no código acima.
Pressionar este botão, neste caso, inicia o procedimento RunCommand com a string de comando formatada para a adição do cluster em termos do 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:1545Aqui chegamos ao comando principal que gerencia a execução do rac com os parâmetros necessários, além de analisar a saída dos comandos em listas e retornar, se necessário:
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
# abre um canal em modo não bloqueante
# $rac - comando com caminho completo
# $par - chaves de inicialização e opções formatadas
set pipe [open "|$rac_cmd $par" "r"]
try {
set lst ""
set l ""
# adiciona a saída do comando à lista de listas
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} {
# Inicia o manipulador de erro
ErrorParcing $result $options
return ""
}
}Após a entrada dos dados do servidor principal, ele será adicionado à árvore; para isso, o seguinte código na mencionada procedure Add:server é responsável:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Agora, ao clicar no nome do servidor na árvore, obteremos a lista de clusters geridos por esse servidor, e ao clicar em um cluster, obteremos a lista de elementos do cluster (servidores, bancos de dados, etc.). Isso é implementado na procedure TreePress (arquivo lib/function.tcl):
proc TreePress {tree} {
global host server active_cluster infobase
# determina o elemento selecionado
set id [$tree selection]
# define as variáveis globais necessárias
SetGlobalVarFromTreeItems $tree $id
# Determina a chave e o valor, ou seja, o tipo do elemento selecionado
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
# e dependendo do que foi escolhido, a procedure correspondente será executada
# no namespace Run
Run::$key $tree $host $values
}Assim, para o servidor principal, executará Run::server (para o cluster — Run::cluster, para o servidor de trabalho — Run::work_server, etc.). Ou seja, o valor da variável $key é parte do nome do elemento da árvore, definido pela opção -id.
Observe a procedure
Run::server
proc Run::server {tree host values} {
# obtendo a lista de clusters do servidor requerido
set lst [RunCommand server::$host "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
# removendo itens desnecessários da lista
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
# lendo a lista
foreach cluster_list $lst {
# Preenchendo a lista com os valores obtidos
InsertItemsWorkList $cluster_list
# processando a saída (lista) para adicionar dados na árvore
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]]
}
}
}
# adicionando clusters na árvore
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"
# adicionando elementos ao cluster
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Administradores" -values "$id"
#InsertClusterItems $tree $id
}
}Este procedimento processa o que foi recebido do servidor através do comando RunCommand e adiciona diversas informações na árvore — clusters, vários elementos raiz (bancos de dados, servidores de trabalho, sessões e assim por diante). Se você observar de perto, pode notar a chamada do procedimento InsertItemsWorkList. Ele é usado para adicionar elementos na lista gráfica, processando a saída da utilidade de console rac, que anteriormente foi retornada em forma lista na variável $lst. Essa é uma lista de listas, contendo pares de elementos separados por dois pontos.
Por exemplo, a lista de conexões do cluster:
svk@svk ~]$ /opt/1C/v8.3/x86_64/rac connection list --cluster=783d2170-56c3-11e8-c586-fc75165efbb2 localhost:1545
connection : dcf5991c-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:49:51
session-number : 0
blocked-by-ls : 0
connection : b993293a-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:48:52
session-number : 0
blocked-by-ls : 0
Visualmente, isso parecerá mais ou menos assim:
O procedimento mencionado acima destaca os nomes dos elementos para o cabeçalho e os dados para preencher a tabela:
InsertItemsWorkList
proc InsertItemsWorkList {lst} {
global work_list_row_count
# configuração da alternância de cores para a linha
if [expr $work_list_row_count % 2] {
set tag escuro
} else {
set tag claro
}
# parsing de linhas em pares chave - valor
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]
}
}
# preenchendo a tabela
.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
# configuração dos cabeçalhos
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}Aqui, em vez do comando simples [split $str «:»], que divide a string em elementos separados por «:» e retorna uma lista, foi aplicado uma expressão regular, pois alguns elementos também contêm dois pontos.
A procedimentos InsertClusterItems (um dos vários semelhantes) simplesmente adiciona à árvore o elemento de cluster desejado uma lista de elementos filhos com os identificadores correspondentes.
InsertClusterItems
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text "Bases de Dados" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Servidores em Funcionamento" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Administradores" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Gerentes de Cluster" -values $id
$tree insert $parent end -id "processes::$id" -text "Processos em Funcionamento" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Sessões" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Bloqueios" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Conexões" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Perfis de Segurança" -values $id
}
Pode-se considerar mais duas variantes de implementação de tal procedimento, onde será claramente visível como otimizar e eliminar comandos repetidos:
Neste procedimento, a adição e verificação são resolvidas de forma direta:
InsertBaseItems
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Sessões" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Bloqueios" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Conexões" -values "$id"
}
}
Aqui, a abordagem é mais correta:
InsertProfileItems
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{dir "Catálogos Virtuais"}
{com "Classes COM Permitidas"}
{addin "Componentes Externos"}
{module "Relatórios e Processos Externos"}
{app "Aplicativos Permitidos"}
{inet "Recursos da Internet"}
}
foreach i $lst {
append item [lindex $i 0] "::$id"
if { [$tree exists $item] == 0 } {
$tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
}
unset item
}
}A diferença entre eles está na aplicação do loop, onde um comando (ou comandos) repetitivos é executado. Qual abordagem adotar depende do critério do desenvolvedor.
Depois de abordarmos a adição de elementos e a obtenção de dados, é hora de focarmos na edição. Como, na maioria das vezes, os mesmos parâmetros são usados tanto para edição quanto para adição (com exceção da base de informações), os formulários de diálogo utilizados são os mesmos. O algoritmo de chamada de procedimentos para adição é o seguinte:
Add::$key->AddToplevel
E para edição é assim:
Edit::$key->Add::$key->AddTopLevel
Como exemplo, vamos considerar a edição de um cluster, ou seja, clicando no nome do cluster na árvore, pressionamos o botão de edição na barra de ferramentas (ícone do lápis) e a forma correspondente será exibida na tela:
Edit::cluster
proc Edit::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes active_cluster
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
# desenhando o formulário para o cluster
set frm [Add::cluster $tree $host $values]
# mudando o texto no rótulo
$frm configure -text "Edição do cluster"
set active_cluster $values
# obtendo dados sobre o cluster selecionado
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
# preenchendo os campos
FormFieldsDataInsert $frm $lst
# desativando campos cujo acesso é proibido
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
# reatribuindo o manipulador
.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
}
}Com os comentários no código, em essência, tudo está claro, exceto pelo fato de que o manipulador do botão foi sobrescrito e há um procedimento FormFieldsDataInsert, que preenche os campos com dados e inicializa variáveis:
FormFieldsDataInsert
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
# obtendo a lista de parâmetros e valores
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
# trocando símbolos
regsub -all -- "-" [string trim $param] "_" entry_name
# preenchendo com dados
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 """]
}
# para checkboxes alteramos valores
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
}
}
}
}
}
Neste procedimento, surgiu mais uma vantagem do tcl — os nomes das variáveis podem ser substituídos pelos valores de outras variáveis. Ou seja, para automatizar o preenchimento de formulários e a inicialização de variáveis, os nomes dos campos e variáveis correspondem às chaves da linha de comando da utilidade rac, e aos nomes dos parâmetros de saída dos comandos, com algumas exceções — o hífen é substituído por um sublinhado. Por exemplo scheduled-jobs-deny corresponde ao campo ent_scheduled_jobs_deny e à variável scheduled_jobs_deny.
Os formulários de adição e edição podem variar na composição dos campos, por exemplo, ao trabalhar com a base de informações:
Adicionar IB
Editar IB
No procedimento de edição Edit::infobase, os campos necessários são adicionados ao formulário, o código é extenso, portanto não o incluo aqui.
Procedimentos de adição, edição e exclusão também foram implementados de maneira análoga para os demais elementos.
Como a operação da utilidade implica um número ilimitado de servidores, clusters, bases de informações, etc., foram introduzidas várias variáveis globais para determinar a qual cluster pertence qual servidor ou IB, sendo que os valores são definidos a cada clique nos elementos da árvore. Ou seja, o procedimento percorre recursivamente todos os elementos pais e define as variáveis:
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
}
}
O cluster 1C permite operação tanto com autorização como sem. Existem dois tipos de administradores — o administrador do agente do cluster e o administrador do cluster. Assim, para o funcionamento correto, foram introduzidas mais 4 variáveis globais, contendo o login e a senha do administrador. Ou seja, se houver uma conta de administrador no cluster, um diálogo será exibido para a entrada do login e da senha, e os dados serão salvos na memória e utilizados em cada comando para o respectivo cluster.
Isso é tratado pelo procedimento de tratamento de erros
ErrorParcing
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Administrador do cluster não está autenticado" {
AuthorisationDialog "Administrador do cluster"
.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
}
"Administrador do servidor central não está autenticado" {
AuthorisationDialog "Administrador do agente do cluster"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
"Cluster administrator is not authenticated" {
AuthorisationDialog "Administrador do cluster"
.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 "Administrador do agente do cluster"
.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"
}
}
}Ou seja, dependendo do que a comando retornar, será a reação correspondente.
Atualmente, a funcionalidade está implementada em cerca de 95%, resta implementar o trabalho com perfis de segurança e testar =). É isso. Peço desculpas pela narrativa apressada.
O código, como de costume, está disponível .
Atualização: Concluí o trabalho com perfis de segurança. Agora a funcionalidade está implementada 100%.
Atualização 2: adicionado suporte a inglês e russo, verificada a operação no win7
Fonte: habr.com
