Mientras profundizaba en el tema de trabajar los productos 1C en Linux, descubrí un inconveniente: la falta de una herramienta gráfica multiplataforma conveniente para administrar un clúster de servidores 1C. Y se decidió solucionar este inconveniente escribiendo una GUI para la utilidad de consola rac. El lenguaje de desarrollo fue elegido tcl / tk como, en mi opinión, el más adecuado para esta tarea. Y ahora, quiero presentar algunos aspectos interesantes de la solución en este material.
Para el trabajo, necesita distribuciones tcl / tk y 1C. Y dado que decidí aprovechar al máximo las capacidades de la entrega tcl / tk básica sin usar paquetes de terceros, necesitaré la versión 8.6.7, que incluye ttk, un paquete con elementos gráficos adicionales, del cual necesitaremos principalmente ttk :: TreeView, permite mostrar datos tanto en forma de estructura de árbol como en forma de tabla (lista). Además, en la nueva versión, se ha vuelto a trabajar con excepciones (el comando try, que se usa en el proyecto cuando se ejecutan comandos externos).
Un proyecto consta de varios archivos (aunque nada impide que todo lo haga uno):
rac_gui.cfg - configuración predeterminada
rac_gui.tcl - secuencia de comandos de inicio principal
El directorio lib contiene archivos cargados automáticamente al inicio:
function.tcl - archivo con procedimientos
gui.tcl - GUI principal
images.tcl - biblioteca de imágenes en base64
El archivo rac_gui.tcl, de hecho, inicia el intérprete, inicializa las variables, carga los módulos, las configuraciones, etc. El contenido del archivo con comentarios:
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" } }
Después de descargar todo lo necesario y verificar la disponibilidad de la utilidad rac, se abrirá una ventana gráfica. La interfaz del programa consta de tres elementos:
Barra de herramientas, árbol y lista
Hice que el contenido del "árbol" fuera lo más similar posible a un complemento estándar de Windows de 1C.
El código principal que forma esta ventana está contenido en el archivo
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
El algoritmo para trabajar con el programa es el siguiente:
1. Al principio, debe agregar el servidor de clúster principal (es decir, el servidor de administración de clúster (en Linux, el comando se inicia con el comando "/opt/1C/v8.3/x86_64/ras cluster --daemon").
Para hacer esto, haga clic en el botón "+" y en la ventana que se abre, ingrese la dirección del servidor y el puerto:
Después, nuestro servidor aparece en el árbol haciendo clic en el cual, se abre una lista de clústeres o se muestra un error de conexión.
2. Al hacer clic en el nombre del clúster, se abrirá una lista de funciones disponibles.
3. ...
Bueno y así sucesivamente, es decir Para agregar un nuevo clúster, seleccione cualquier disponible en la lista y presione el botón + en la barra de herramientas y se mostrará el cuadro de diálogo para agregar uno nuevo:
Los botones en la barra de herramientas realizan funciones dependiendo del contexto, es decir. de qué elemento del árbol o lista está seleccionado, se realizará este o aquel procedimiento.
Considere el botón Agregar ("+") como ejemplo:
Código de generación de botones:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32
Aquí vemos que cuando se presiona el botón, se ejecutará el procedimiento Agregar, su 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 }
Entonces, una de las ventajas del cosquilleo es visible: puede pasar el valor de una variable como el nombre del procedimiento:
Add::$key .frm_tree.tree $host $values
Es decir, por ejemplo, si tocamos el servidor principal y presionamos "+", se iniciará el procedimiento Add :: server, si el clúster es Add :: cluster y así sucesivamente (escribiré un poco acerca de dónde provienen las "teclas" necesarias a continuación), los procedimientos enumerados dibujan elementos gráficos apropiados para el contexto.
Como habrás notado, los formularios tienen un estilo similar; esto no es sorprendente, ya que se muestran en un solo procedimiento, más precisamente el marco principal del formulario (ventana, botones, imagen, etiqueta), el nombre del procedimiento.
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 llamada: título, nombre de imagen para el icono de la biblioteca (lib / images.tcl) y el parámetro de nombre de ventana opcional (predeterminado .add). Por lo tanto, si tomamos los ejemplos anteriores para agregar el servidor principal y el clúster, la llamada será en consecuencia:
AddToplevel " " server_grey_64
o
AddToplevel " " cluster_grey_64
Bueno, continuando con estos ejemplos, mostraré los procedimientos que muestran los cuadros de diálogo de agregar para el servidor o el clúster.
Agregar :: servidor 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 }
Agregar :: clúster 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 }
Al comparar el código de estos procedimientos, la diferencia es visible a simple vista, me centraré en el controlador del botón Aceptar. En Tk, las propiedades de los elementos gráficos se pueden redefinir en tiempo de ejecución utilizando la opción de
configuración . Por ejemplo, el comando de salida del botón inicial:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
Pero en nuestros formularios, el comando depende de la funcionalidad requerida:
.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 }
En el ejemplo anterior, el botón "obstruido" inicia el procedimiento para agregar un clúster.
Aquí vale la pena hacer una digresión para trabajar con elementos gráficos en Tk: para varios elementos de entrada de datos (entrada, cuadro combinado, botón de verificación, etc.), se introdujo un parámetro como una variable de texto (variable de texto):
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
Esta variable se define en el espacio de nombres global y contiene el valor actual ingresado. Es decir Para obtener el texto ingresado del campo, solo necesita leer el valor correspondiente a la variable (por supuesto, siempre que esté definido al crear el elemento).
El segundo método para obtener el texto ingresado (para elementos de entrada de tipo) es usar el comando get:
.add.frm.ent_name get
Ambos métodos se pueden ver en el código anterior.
Al hacer clic en este botón, en este caso, se inicia el procedimiento RunCommand con la línea de comando generada para agregar un clúster en términos 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
Entonces llegamos al comando principal, que controla el lanzamiento de rac con los parámetros que necesitamos, también analiza la salida de los comandos en listas y devuelve si es necesario:
Comando de ejecución 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 "" } }
Después de ingresar los datos del servidor principal, se agregará al árbol, para esto, en el procedimiento Agregar: servidor anterior, el siguiente código es responsable:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
Ahora, al hacer clic en el nombre del servidor en el árbol, obtenemos una lista de clústeres administrados por ese servidor, y al hacer clic en un clúster, obtenemos una lista de elementos del clúster (servidores, bases de datos, etc.). Esto se implementa en el procedimiento TreePress (archivo 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 }
En consecuencia, Run :: server se iniciará para el servidor principal (Run :: cluster para el cluster, Run :: work_server, etc. para el servidor de producción). Es decir El valor de la variable $ key es parte del nombre del elemento del árbol especificado por la opción
-id .
Presta atención al procedimiento.
Ejecutar :: servidor 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 procedimiento procesa lo que se recibió del servidor a través del comando RunCommand y agrega todo tipo de cosas al árbol: clústeres, varios elementos raíz (bases de datos, servidores de producción, sesiones, etc.). Si observa detenidamente, en el interior puede observar la llamada al procedimiento InsertItemsWorkList. Se utiliza para agregar elementos a la lista gráfica, procesando el resultado de la utilidad de consola rac, que anteriormente se devolvió como una lista a la variable $ lst. Esta es una lista de listas que contienen pares de elementos separados por dos puntos.
Por ejemplo, una lista de conexiones de clúster:
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
En forma gráfica, se verá más o menos así:
El procedimiento anterior identifica los nombres de los elementos para el encabezado y los datos para llenar la tabla:
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 }
Aquí, en lugar del comando simple [split $ str ":"], que divide la cadena en elementos separados por ":" y devuelve una lista, se aplica una expresión regular, ya que algunos elementos también contienen dos puntos.
El procedimiento InsertClusterItems (uno de varios similares) simplemente agrega una lista de elementos secundarios con los identificadores correspondientes al elemento de clúster requerido en el árbol
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 }
Puede considerar dos opciones más para implementar dicho procedimiento, donde será claramente visible cómo puede optimizar y deshacerse de comandos duplicados:
En este procedimiento, la suma y la verificación se resuelven en la frente:
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" } }
Y aquí el enfoque es más correcto:
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 } }
La diferencia entre ellos es el uso del ciclo en el que se ejecutan los comandos repetidos. El enfoque de uso queda a criterio del desarrollador.
Consideramos agregar elementos y recibir datos; es hora de detenerse en la edición. Dado que, básicamente, se utilizan los mismos parámetros para editar y agregar (la excepción es la base de datos), los formularios de diálogo son los mismos. El procedimiento de llamada al procedimiento para agregar se ve así:
Añadir :: $ clave-> AddToplevelY para editar así:
Editar :: $ clave-> Agregar :: $ clave-> AddTopLevelPor ejemplo, tome la edición de un clúster, es decir haciendo clic en el nombre del clúster en el árbol, presione el botón de edición en la barra de herramientas (lápiz) y se mostrará el formulario correspondiente:
Editar :: clúster 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 } }
Según los comentarios en el código, en principio, todo está claro, excepto que el código del controlador de botones se redefine y el procedimiento FormFieldsDataInsert está presente, que llena los campos con datos e inicializa las variables: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 } } } } }
En este procedimiento, surgió otro plus tcl: los valores de otras variables se sustituyen como nombres de variables. Es decir
Para automatizar el llenado de formularios e inicializar variables, los nombres de campos y variables corresponden a los interruptores de línea de comando de la utilidad rac y los nombres de los parámetros de salida de los comandos con algunas excepciones: el guión se reemplaza por un guión bajo. Por ejemplo, Scheduled-jobs-deny corresponde al campo ent_scheduled_jobs_deny y la variable Scheduled_jobs_deny .Las formas de agregar y editar pueden diferir en la composición de los campos, por ejemplo, trabajar con la base de información:Agregar IB
Editar IB
En el procedimiento de edición Editar :: infobase, los campos obligatorios se agregan al formulario, por lo tanto, no proporciono un código grande aquí.Por analogía, se implementan los procedimientos para agregar, editar y eliminar otros elementos.Dado que la utilidad involucra un número ilimitado de servidores, clústeres, bases de datos, etc., para determinar a qué clúster pertenece el servidor o la seguridad de la información, se han ingresado varias variables globales, cuyos valores se establecen cada vez que hace clic en los elementos del árbol. Es decir
El procedimiento se ejecuta recursivamente a través de todos los elementos principales y establece las variables: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 } }
El clúster 1C le permite trabajar con o sin autorización. Hay dos tipos de administradores: el administrador del agente de clúster y el administrador del clúster. En consecuencia, para la operación correcta, se introdujeron 4 variables globales más que contienen el nombre de usuario y la contraseña del administrador. Es decir
Si hay una cuenta de administrador en el clúster, se mostrará un cuadro de diálogo para ingresar el nombre de usuario y la contraseña, los datos se almacenarán en la memoria y se insertarán en cada comando para el clúster correspondiente.El procedimiento de manejo de errores es responsable de esto.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" } } }
Es decir
dependiendo de lo que devuelva el comando, habrá una reacción en consecuencia.Por el momento, la funcionalidad se ha implementado en un 95 por ciento, queda por implementar el trabajo con perfiles de seguridad y test =). Eso es todo Pido disculpas por la narración arrugada.El código está tradicionalmente disponible aquí .Actualización: trabajo completado con perfiles de seguridad. Ahora la funcionalidad está implementada al 100%.Actualización 2: se agrega la localización en inglés y ruso, se verifica el trabajo en win7