Ao me aprofundar no tópico de trabalhar com os produtos 1C no Linux, descobri uma desvantagem - a falta de uma ferramenta gráfica multiplataforma conveniente para gerenciar um cluster de servidores 1C. E foi decidido corrigir essa falha escrevendo uma GUI para o utilitário de console rac. A linguagem de desenvolvimento foi escolhida tcl / tk como, na minha opinião, a mais adequada para esta tarefa. E agora, quero apresentar alguns aspectos interessantes da solução neste material.
Para o trabalho, você precisa de distribuições tcl / tk e 1C. E como decidi aproveitar ao máximo os recursos da entrega básica do tcl / tk sem usar pacotes de terceiros, precisarei da versão 8.6.7, que inclui o ttk - um pacote com elementos gráficos adicionais, dos quais precisaremos principalmente do ttk :: TreeView, ele permite exibir dados na forma de uma estrutura em árvore e na forma de uma tabela (lista). Além disso, na nova versão, o trabalho com exceções foi refeito (o comando try, usado no projeto ao executar comandos externos).
Um projeto consiste em vários arquivos (embora nada impeça que tudo seja feito por um):
rac_gui.cfg - configuração padrão
rac_gui.tcl - script principal de inicialização
O diretório lib contém arquivos carregados automaticamente na inicialização:
function.tcl - arquivo com procedimentos
gui.tcl - GUI principal
images.tcl - biblioteca de imagens em base64
O arquivo rac_gui.tcl, de fato, inicia o intérprete, inicializa as variáveis, carrega os 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" } }
Depois de baixar tudo o que é necessário e verificar a disponibilidade do utilitário rac, uma janela gráfica será iniciada. A interface do programa consiste em três elementos:
Barra de ferramentas, árvore e lista
Eu criei o conteúdo da "árvore" o mais semelhante possível a um snap padrão do Windows a partir de 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 para trabalhar com o programa é o seguinte:
1. No início, você precisa adicionar o servidor de cluster principal (ou seja, o servidor de gerenciamento de cluster (no linux, o comando é iniciado com o comando "/opt/1C/v8.3/x86_64/ras cluster --daemon")
Para fazer isso, clique no botão "+" e, na janela que se abre, digite o endereço e a porta do servidor:
Depois, nosso servidor aparece na árvore clicando em qual, uma lista de clusters é aberta ou um erro de conexão é exibido.
2. Ao clicar no nome do cluster, uma lista de funções disponíveis será aberta.
3. ...
Bem e assim por diante, ou seja, Para adicionar um novo cluster, selecione qualquer um disponível na lista e pressione o botão + na barra de ferramentas e a caixa de diálogo para adicionar um novo será exibida:
Os botões na barra de ferramentas executam funções dependendo do contexto, ou seja, de qual elemento da árvore ou lista é selecionado, este ou aquele procedimento será executado.
Considere o botão Adicionar ("+") como um exemplo:
Código de geração do botão:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32
Aqui vemos que quando o botão é pressionado, o procedimento Adicionar será executado, com seu código:
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 }
Portanto, uma das vantagens do tickle é visível - você pode passar o valor de uma variável como o nome do procedimento:
Add::$key .frm_tree.tree $host $values
Ou seja, por exemplo, se pressionarmos o servidor principal e pressionar "+", o procedimento Add :: server será iniciado, se o cluster for Add :: cluster e assim por diante (vou escrever um pouco sobre de onde vêm as "chaves" necessárias abaixo), os procedimentos listados desenham elementos gráficos apropriados ao contexto.
Como você deve ter notado, os formulários são semelhantes em estilo - isso não é surpreendente, porque são exibidos em um procedimento, mais precisamente no quadro principal do formulário (janela, botões, imagem, rótulo), o 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 # 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 }
Parâmetros de chamada: título, nome da imagem para o ícone da biblioteca (lib / images.tcl) e o parâmetro opcional nome da janela (padrão .add). Portanto, se usarmos os exemplos acima para adicionar o servidor principal e o cluster, a chamada será a seguinte:
AddToplevel " " server_grey_64
ou
AddToplevel " " cluster_grey_64
Bem, continuando com esses exemplos, mostrarei os procedimentos que exibem as caixas de diálogo de adição para o servidor ou cluster.
Add :: server proc Add::server {} { global default # set frm [AddToplevel " " server_grey_64] # label $frm.lbl_host -text " " entry $frm.ent_host label $frm.lbl_port -text "" entry $frm.ent_port $frm.ent_port insert end $default(port) grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5 grid columnconfigure $frm 0 -weight 1 grid rowconfigure $frm 0 -weight 1 #set frm_btn [frame .add.frm_btn -border 0] # .add.frm_btn.btn_ok configure -command { set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]] .frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host" destroy .add return $host } return $frm }
Adicionar :: 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 "" } # () 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 }
Ao comparar o código desses procedimentos, a diferença é visível a olho nu, vou focar no manipulador do botão OK. Em Tk, as propriedades dos elementos gráficos podem ser redefinidas em tempo de execução usando a opção de
configuração . Por exemplo, o comando de saída do botão inicial:
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 "entupido" inicia o procedimento para adicionar um cluster.
Aqui vale a pena fazer uma digressão para trabalhar com elementos gráficos em Tk - para vários elementos de entrada de dados (entrada, caixa de combinação, botão de verificação etc.), foi introduzido um parâmetro como uma variável de texto (variável de texto):
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
Essa variável é definida no espaço para nome global e contém o valor atual inserido. I.e. para obter o texto inserido do campo, basta considerar o valor correspondente à variável (é claro, desde que esteja definido ao criar o elemento).
O segundo método para obter o texto digitado (para elementos do tipo entrada) é usar o comando get:
.add.frm.ent_name get
Ambos os métodos podem ser vistos no código acima.
Clicar neste botão, nesse caso, inicia o procedimento RunCommand com a linha de comando gerada para adicionar um cluster em termos de 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
Então, chegamos ao comando principal, que controla o lançamento do rac com os parâmetros que precisamos, também analisa a saída dos comandos em listas e retorna, se necessário:
Comando de execução 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 "" } }
Depois de inserir os dados do servidor principal, eles serão adicionados à árvore. Para isso, no procedimento Adicionar: servidor acima, o código a seguir é responsável:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
Agora, clicando no nome do servidor na árvore, obtemos uma lista de clusters gerenciados por esse servidor e, clicando em um cluster, obtemos uma lista de elementos de cluster (servidores, infobases, etc.). Isso é implementado no procedimento TreePress (arquivo 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 }
Assim, Run :: server será iniciado no servidor principal (Run :: cluster para o cluster, Run :: work_server etc. para o servidor de produção). I.e. o valor da variável $ key faz parte do nome do elemento da árvore especificado pela opção
-id .
Preste atenção ao procedimento
Run :: 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 } }
Este procedimento processa o que foi recebido do servidor por meio do comando RunCommand e adiciona todo tipo de coisas aos clusters de árvores, vários elementos raiz (bancos de dados, servidores de produção, sessões etc.). Se você olhar atentamente, por dentro, poderá notar a chamada para o procedimento InsertItemsWorkList. É usado para adicionar elementos à lista gráfica, processando a saída do utilitário de console rac, que foi retornado anteriormente como uma lista para a variável $ lst. Esta é uma lista de listas que contêm pares de elementos separados por dois pontos.
Por exemplo, uma lista de conexões de 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
Em forma gráfica, será algo parecido com isto:
O procedimento acima identifica os nomes dos elementos para o cabeçalho e os dados para preencher a tabela:
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 }
Aqui, em vez do comando simples [split $ str ":"], que divide a string em elementos separados por ":" e retorna uma lista, uma expressão regular é aplicada, pois alguns elementos também contêm dois pontos.
O procedimento InsertClusterItems (um dos vários similares) simplesmente adiciona uma lista de elementos filhos com os identificadores correspondentes ao elemento de cluster necessário na árvore
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 }
Você pode considerar mais duas opções para implementar esse procedimento, onde será claramente visível como otimizar e se livrar de comandos duplicados:
Neste procedimento, a adição e a verificação são resolvidas na testa:
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" } }
E aqui a abordagem é mais correta:
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 } }
A diferença entre eles é o uso do ciclo no qual os comandos repetidos são executados. Qual abordagem usar é a critério do desenvolvedor.
Consideramos adicionar elementos e receber dados; é hora de parar na edição. Como basicamente os mesmos parâmetros são usados para editar e adicionar (a exceção é a infobase), os formulários de diálogo são os mesmos. O procedimento de chamada de procedimento para adicionar se parece com o seguinte:
Adicionar :: $ key-> AddToplevelE para editar assim:
Editar :: $ key-> Adicionar :: $ key-> AddTopLevelPor exemplo, considere editar um cluster, ou seja, clicando no nome do cluster na árvore, pressione o botão editar na barra de ferramentas (lápis) e o formulário correspondente será exibido:
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 "" } # 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 } }
De acordo com os comentários no código, em princípio, tudo está claro, exceto que o código do manipulador de botão é redefinido e o procedimento FormFieldsDataInsert está presente, o que preenche os campos com dados e inicializa as variáveis: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 } } } } }
Neste procedimento, outro tcl mais apareceu - os valores de outras variáveis são substituídos como nomes de variáveis. I.e.
Para automatizar o preenchimento de formulários e a inicialização de variáveis, os nomes dos campos e variáveis correspondem às opções de linha de comando do utilitário rac e aos nomes dos parâmetros de saída dos comandos, com algumas exceções - o traço é substituído por um sublinhado. Por exemplo programados-jobs-negar corresponde ao campo ent_scheduled_jobs_deny e variável scheduled_jobs_deny .As formas de adição e edição podem diferir na composição dos campos, por exemplo, trabalhando com uma base de informações:Adicionando IB
Editando IB
No procedimento de edição Edit :: infobase, os campos obrigatórios são adicionados ao formulário, portanto, não forneço um código grande aqui.Por analogia, os procedimentos para adicionar, editar e excluir outros elementos são implementados.Como o utilitário envolve um número ilimitado de servidores, clusters, infobases etc., para determinar a qual cluster o servidor ou a segurança da informação pertence, várias variáveis globais foram introduzidas, cujos valores são definidos sempre que você clica nos elementos da árvore. I.e.
o procedimento executa recursivamente todos os elementos pai 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 trabalhar com ou sem autorização. Existem dois tipos de administradores - o administrador do agente de cluster e o administrador de cluster. Assim, para a operação correta, foram introduzidas mais 4 variáveis globais contendo o login e a senha do administrador. I.e.
se uma conta de administrador estiver presente no cluster, será exibida uma caixa de diálogo para inserir o login e a senha, os dados serão armazenados na memória e inseridos em cada comando do cluster correspondente.O procedimento de tratamento de erros é responsável por isso.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" } } }
I.e.
dependendo do que o comando retornar, haverá uma reação em conformidade.No momento, a funcionalidade foi implementada em 95%, resta implementar o trabalho com perfis de segurança e test =). Isso é tudo. Peço desculpas pela narração amassada.O código está tradicionalmente disponível aqui .Atualização: trabalho concluído com perfis de segurança. Agora, a funcionalidade está 100% implementada.Atualização 2: localização em inglês e russo é adicionada, trabalho no win7 é verificado