Nous écrivons GUI à 1C RAC, ou encore à propos de Tcl / Tk

En approfondissant le sujet du travail des produits 1C sous Linux, j'ai découvert un inconvénient - le manque d'un outil graphique multi-plateforme pratique pour gérer un cluster de serveurs 1C. Et il a été décidé de corriger cette lacune en écrivant une interface graphique pour l'utilitaire de console rac. Le langage de développement a été choisi tcl / tk comme, à mon avis, le plus approprié pour cette tâche. Et maintenant, je veux présenter quelques aspects intéressants de la solution dans ce matériau.

Pour le travail, vous avez besoin des distributions tcl / tk et 1C. Et puisque j'ai décidé de tirer le meilleur parti des capacités de la livraison tcl / tk de base sans utiliser de packages tiers, j'aurai besoin de la version 8.6.7, qui comprend ttk - un package avec des éléments graphiques supplémentaires, dont nous aurons principalement besoin de ttk :: TreeView, cela permet afficher les données à la fois sous forme d'arborescence et sous forme de tableau (liste). De plus, dans la nouvelle version, le travail avec les exceptions a été refait (la commande try, qui est utilisée dans le projet lors de l'exécution de commandes externes).

Un projet se compose de plusieurs fichiers (bien que rien n'empêche que tout soit fait par un seul):

rac_gui.cfg - configuration par défaut
rac_gui.tcl - script de démarrage principal
Le répertoire lib contient des fichiers chargés automatiquement au démarrage:
function.tcl - fichier avec procédures
gui.tcl - interface graphique principale
images.tcl - bibliothèque d'images en base64

En fait, le fichier rac_gui.tcl démarre l'interpréteur, initialise les variables, charge les modules, les configurations, etc. Le contenu du dossier avec commentaires:

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


Après avoir téléchargé tout ce qui est nécessaire et vérifié la disponibilité de l'utilitaire rac, une fenêtre graphique sera lancée. L'interface du programme se compose de trois éléments:

Barre d'outils, arborescence et liste

J'ai fait le contenu de "l'arbre" aussi similaire que possible à un instantané de fenêtres standard à partir de 1C.

image

Le code principal formant cette fenêtre est contenu dans le fichier
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 


L'algorithme pour travailler avec le programme est le suivant:

1. Au début, vous devez ajouter le serveur de cluster principal (c'est-à-dire le serveur de gestion de cluster (sous linux, la commande est lancée avec la commande "/opt/1C/v8.3/x86_64/ras cluster --daemon")).

Pour ce faire, cliquez sur le bouton "+" et dans la fenêtre qui s'ouvre, entrez l'adresse et le port du serveur:

image

Après, notre serveur apparaît dans l'arborescence en cliquant sur lequel, une liste de clusters s'ouvre ou une erreur de connexion s'affiche.

2. En cliquant sur le nom du cluster, une liste des fonctions disponibles pour celui-ci s'ouvrira.

3. ...

Eh bien, etc. Pour ajouter un nouveau cluster, sélectionnez-en un disponible dans la liste et appuyez sur le bouton + dans la barre d'outils et la boîte de dialogue pour en ajouter un nouveau s'affichera:

image

Les boutons de la barre d'outils remplissent des fonctions en fonction du contexte, c'est-à-dire à partir de quel élément de l'arborescence ou de la liste est sélectionné, telle ou telle procédure sera effectuée.

Considérez le bouton Ajouter ("+") comme exemple:

Code de génération de bouton:

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

Ici, nous voyons que lorsque le bouton est enfoncé, la procédure Add sera exécutée, son code:

 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 } 

Ainsi, l'un des avantages du chatouillement est visible - vous pouvez passer la valeur d'une variable comme nom de la procédure:

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

C'est-à-dire, par exemple, si nous piquons sur le serveur principal et appuyons sur "+", la procédure Add :: server sera lancée, si le cluster est Add :: cluster et ainsi de suite (j'écrirai un peu d'où viennent les "clés" nécessaires) ci-dessous), les procédures répertoriées dessinent des éléments graphiques adaptés au contexte.

Comme vous l'avez peut-être remarqué, les formulaires sont de style similaire - ce n'est pas surprenant, car ils sont affichés dans une procédure, plus précisément le cadre principal du formulaire (fenêtre, boutons, image, étiquette), le nom de la procédure
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 } 


Paramètres d'appel: titre, nom de l'image pour l'icône de la bibliothèque (lib / images.tcl) et le paramètre de nom de fenêtre facultatif (par défaut .add). Ainsi, si nous prenons les exemples ci-dessus pour ajouter le serveur principal et le cluster, l'appel sera en conséquence:

 AddToplevel "  " server_grey_64 

ou

 AddToplevel " " cluster_grey_64 

Eh bien, en poursuivant avec ces exemples, je vais montrer les procédures qui affichent les boîtes de dialogue d'ajout pour le serveur ou le cluster.

Ajouter :: serveur
 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 } 


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 "" } #    () 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 } 


En comparant le code de ces procédures, la différence est visible à l'œil nu, je vais me concentrer sur le gestionnaire du bouton OK. Dans Tk, les propriétés des éléments graphiques peuvent être redéfinies lors de l'exécution à l'aide de l'option de configuration . Par exemple, la commande de sortie du bouton initial:

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

Mais dans nos formulaires, la commande dépend des fonctionnalités requises:

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

Dans l'exemple ci-dessus, le bouton «obstrué» démarre la procédure d'ajout d'un cluster.

Ici, il convient de faire une digression pour travailler avec des éléments graphiques dans Tk - pour divers éléments de saisie de données (entrée, zone de liste déroulante, bouton de contrôle, etc.), un paramètre tel qu'une variable de texte (variable de texte) a été introduit:

 entry $frm.ent_lifetime_limit -textvariable lifetime_limit 

Cette variable est définie dans l'espace de noms global et contient la valeur actuelle entrée. C'est-à-dire pour obtenir le texte saisi dans le champ il suffit de lire la valeur correspondant à la variable (bien entendu, à condition qu'elle soit définie lors de la création de l'élément).

La deuxième méthode pour obtenir le texte saisi (pour les éléments de type entrée) consiste à utiliser la commande get:

 .add.frm.ent_name get 

Ces deux méthodes peuvent être vues dans le code ci-dessus.

En cliquant sur ce bouton, dans ce cas, la procédure RunCommand démarre avec la ligne de commande générée pour ajouter un cluster en termes 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 

Nous sommes donc arrivés à la commande principale, qui contrôle le lancement de rac avec les paramètres dont nous avons besoin, analyse également la sortie des commandes dans des listes et retourne si nécessaire:

Runcommand
 proc RunCommand {root par} { global dir rac_cmd cluster work_list_row_count agent_user agent_pwd cluster_user cluster_pwd puts "$rac_cmd $par" set work_list_row_count 0 #      # $rac -     # $par -      set pipe [open "|$rac_cmd $par" "r"] try { set lst "" set l "" #       while {[gets $pipe line]>=0} { #puts $line if {$line eq ""} { lappend l $lst set lst "" } else { lappend lst [string trim $line] } } close $pipe return $l } on error {result options} { #    ErrorParcing $result $options return "" } } 


Après avoir entré les données du serveur principal, elles seront ajoutées à l'arborescence, pour cela, dans la procédure Add: server ci-dessus, le code suivant est responsable:

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

Maintenant, en cliquant sur le nom du serveur dans l'arborescence, nous obtenons une liste des clusters gérés par ce serveur, et en cliquant sur un cluster, nous obtenons une liste des éléments du cluster (serveurs, infobases, etc.). Ceci est implémenté dans la procédure TreePress (fichier 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 conséquence, Run :: server démarrera pour le serveur principal (Run :: cluster pour le cluster, Run :: work_server, etc. pour le serveur de production). C'est-à-dire la valeur de la variable $ key fait partie du nom de l'élément d'arbre spécifié par l'option -id .

Faites attention à la procédure

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


Cette procédure traite ce qui a été reçu du serveur via la commande RunCommand et ajoute toutes sortes de choses à l'arborescence - clusters, divers éléments racine (bases de données, serveurs de production, sessions, etc.). Si vous regardez attentivement, à l'intérieur, vous pouvez remarquer l'appel à la procédure InsertItemsWorkList. Il est utilisé pour ajouter des éléments à la liste graphique, en traitant la sortie de l'utilitaire de console rac, qui était précédemment retournée sous forme de liste à la variable $ lst. Il s'agit d'une liste de listes contenant des paires d'éléments séparés par deux points.

Par exemple, une liste de connexions 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 

Sous forme graphique, cela ressemblera à ceci:

image

La procédure ci-dessus identifie les noms des éléments pour l'en-tête et les données pour remplir le tableau:

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 } 


Ici, au lieu de la simple commande [split $ str ":"], qui divise la chaîne en éléments séparés par ":" et renvoie une liste, une expression régulière est appliquée, car certains éléments contiennent également deux points.

La procédure InsertClusterItems (l'une des nombreuses similaires) ajoute simplement une liste d'éléments enfants avec les identificateurs correspondants à l'élément de cluster requis dans l'arborescence
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 } 


Vous pouvez envisager deux autres options pour implémenter une telle procédure, où il sera clairement visible comment optimiser et supprimer les commandes en double:

Dans cette procédure, l'ajout et la vérification sont résolus sur le front:

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


Et ici, l'approche est plus correcte:

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 différence entre eux est l'utilisation du cycle dans lequel les commandes répétées sont exécutées. L'approche à utiliser est à la discrétion du développeur.

Nous avons envisagé d'ajouter des éléments et de recevoir des données; il est temps de s'arrêter à l'édition. Puisque, fondamentalement, les mêmes paramètres sont utilisés pour l'édition et l'ajout (l'exception est l'infobase), les formes de dialogue sont les mêmes. La procédure d'appel de procédure pour l'ajout ressemble à ceci:

Ajouter :: $ key-> AddToplevel

Et pour éditer comme ça:

Edit :: $ key-> Ajouter :: $ key-> AddTopLevel

Par exemple, prenez l'édition d'un cluster, c.-à-d. en cliquant sur le nom du cluster dans l'arborescence, appuyez sur le bouton éditer dans la barre d'outils (crayon) et le formulaire correspondant s'affichera:

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


Selon les commentaires du code, en principe, tout est clair, sauf que le code du gestionnaire de boutons est redéfini et que la procédure FormFieldsDataInsert est présente, qui remplit les champs de données et initialise les 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 } } } } } 


Dans cette procédure, un autre plus tcl est apparu - les valeurs des autres variables sont remplacées par des noms de variable. C'est-à-direpour automatiser le remplissage des formulaires et l'initialisation des variables, les noms des champs et des variables correspondent aux commutateurs de ligne de commande de l'utilitaire rac et aux noms des paramètres de sortie des commandes à quelques exceptions près - le tiret est remplacé par un trait de soulignement. Par exemple prévu-emploi-nier correspond au champ ent_scheduled_jobs_deny et variable scheduled_jobs_deny .

Les formes d'ajout et d'édition peuvent différer dans la composition des champs, par exemple, en travaillant avec la base d'informations:

Ajouter IB

image

Editing IB

image

Dans la procédure d'édition Edit :: infobase, les champs requis sont ajoutés au formulaire, donc je ne fournis pas de code pour cela.

Par analogie, les procédures d'ajout, d'édition, de suppression pour d'autres éléments sont mises en œuvre.

Étant donné que l'utilitaire implique un nombre illimité de serveurs, clusters, infobases, etc., pour déterminer à quel cluster le serveur ou la sécurité de l'information appartient, plusieurs variables globales ont été entrées, dont les valeurs sont définies à chaque fois que vous cliquez sur les éléments de l'arborescence. C'est-à-dire la procédure parcourt récursivement tous les éléments parents et définit les 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 } } 


Le cluster 1C vous permet de travailler avec ou sans autorisation. Il existe deux types d'administrateurs: l'administrateur d'agent de cluster et l'administrateur de cluster. En conséquence, pour le bon fonctionnement, 4 autres variables globales ont été introduites contenant le login et le mot de passe administrateur. C'est-à-diresi un compte administrateur est présent dans le cluster, une boîte de dialogue s'affiche pour saisir le login et le mot de passe, les données seront stockées en mémoire et insérées dans chaque commande du cluster correspondant.

La procédure de gestion des erreurs en est responsable.

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


C'est-à-direen fonction de ce que la commande retourne, il y aura une réaction en conséquence.

Pour le moment, la fonctionnalité a été implémentée à 95%, il reste à implémenter le travail avec les profils de sécurité et à tester =). C’est tout. Je m'excuse pour la narration froissée.

Le code est traditionnellement disponible ici .

Mise à jour: travail terminé avec les profils de sécurité. Maintenant, la fonctionnalité est implémentée à 100%.

Mise à jour 2: la localisation en anglais et en russe est ajoutée, le travail dans win7 est vérifié
image

Source: https://habr.com/ru/post/fr415835/


All Articles