As far as understanding the topic of the work of 1C-ovsky products in the linux environment, there was one drawback - the lack of a convenient graphical multiplatform tool for managing a cluster of 1C servers. And it was decided to correct this deficiency by writing a GUI for the console utility rac. The language for development was chosen as tcl / tk as, in my opinion, the most suitable for this task. And here, I want to present some interesting aspects of the solution in this material.
For work, you will need tcl / tk and 1C distributions. And since I decided to make the most of the basic tcl / tk delivery without using third-party packages, I’ll need version 8.6.7, which includes ttk - a package with additional graphic elements, from which we will need mainly ttk :: TreeView, it allows output data in the form of a tree structure and in the form of a table (list). Also, in the new version, the work with exceptions has been reworked (the try command, which is used in the project when running external commands).
The project consists of several files (although nothing prevents everything from doing one):
rac_gui.cfg - default config
rac_gui.tcl - the main startup script
The lib directory contains files automatically loaded at startup:
function.tcl - procedure file
gui.tcl - the main graphical interface
images.tcl - base64 image library
The rac_gui.tcl file, in fact, starts the interpreter, initializes variables, loads modules, configs, and so on. The content of the file with comments:
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" } }
After downloading all that is required and checking for the presence of the rac utility, a graphical window will be launched. The program interface consists of three elements:
Toolbar, tree and list
I made the contents of the “tree” as close as possible to the standard windows-based equipment from 1C.
The main code that forms this window is contained in the file.
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
The algorithm for working with the program is as follows:
1. At the beginning, you need to add the main cluster server (i.e., the cluster management server (in linux, the control is started with the command "/opt/1C/v8.3/x86_64/ras cluster --daemon")).
To do this, click on the "+" button and in the window that opens, enter the server address and port:
After that, in the tree, our server will appear on a click on which, the list of clusters will open or a connection error will be displayed.
2. Clicking on the cluster name will open the list of functions available to it.
3. ...
Well, and so on, i.e. To add a new cluster, select any available in the list and press the "+" button in the toolbar and the dialog to add a new one will be displayed:
The buttons on the toolbar perform functions depending on the context, i.e. from what element of the tree or list is selected, this or that procedure will be executed.
Consider the example of the add button ("+"):
Button formation code:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32
Here we see that when the button is pressed, the “Add” procedure will be executed, its 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 }
So one of the advantages of a ticker is looking through - you can pass the value of a variable as the name of a procedure:
Add::$key .frm_tree.tree $host $values
Ie, for example, if we click into the main server and click "+", then the Add :: server procedure will be launched, if Add :: cluster will be run into the cluster and so on (I will write a little about where the necessary "keys" come from below), the listed procedures draw graphic elements corresponding to the context.
As you may have noticed, the forms are similar in style - this is not surprising, because they are derived by one procedure, or rather the main frame of the form (window, buttons, image, label), the name of the procedure
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 }
Call parameters: title, image name for icon from library (lib / images.tcl) and optional window name parameter (default is .add). Thus, if you take the above examples to add the main server and the cluster, then the call will be respectively:
AddToplevel " " server_grey_64
or
AddToplevel " " cluster_grey_64
Well and continuing with this examples I will show the procedures that bring up the add dialogs for the server or 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 }
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 }
When comparing the code of these procedures, the difference is visible to the naked eye, the attention will be focused on the handler of the “OK” button. In Tk, properties of graphic elements can be overridden during program execution using the
configure option. For example, the initial command to output a button:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
But in our forms, the team depends on the required functionality:
.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 }
In the example above, the start of the procedure for adding a cluster is “stuck” on the button.
Here it is worth making a digression in the direction of working with graphic elements in Tk - for various data entry elements (entry, combobox, checkbutton, etc.), a parameter has been introduced as a text variable (textvariable):
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
This variable is defined in the global namespace and contains the current value entered. Those. in order to get the entered text from the field, simply read the value corresponding to the variable (of course, provided that it is defined when the element is created).
The second method to get the entered text (for entry type elements) is to use the get command:
.add.frm.ent_name get
Both of these methods can be seen in the above code.
Pressing this button, in this case, starts the RunCommand procedure with the generated string of the command to add a cluster in terms of 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
So we come to the main command, which controls the launch of rac with the parameters we need, also parses the output of the commands to the lists and returns if required:
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 "" } }
After entering the data of the main server, it will be added to the tree, for this, in the Add: server procedure above, the following code answers:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
Now, clicking on the server name in the tree, we will get a list of clusters managed by this server, and clicking on the cluster, we will get a list of cluster elements (servers, infobases, etc.). This is implemented in the TreePress procedure (file lib / function.tcl):
proc TreePress {tree} { global host server active_cluster infobase # set id [$tree selection] # SetGlobalVarFromTreeItems $tree $id # , .. set values [$tree item $id -values] set key [lindex [split $id "::"] 0] # # Run Run::$key $tree $host $values }
Accordingly, Run :: server will start for the main server (for the cluster - Run :: cluster, for the working server - Run :: work_server, etc.). Those. the value of the $ key variable is the part of the name of the tree element specified by the
-id option.
Pay attention to the procedure
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 } }
This procedure handles what was received from the server via the RunCommand command, and adds all sorts of things to the tree — clusters, different root elements (databases, production servers, sessions, and so on). If you look closely, then inside you can notice a call to the InsertItemsWorkList procedure. It is used to add items to the graphic list, processing the output of the rac console utility, which was previously returned as a list to the $ lst variable. This is a list of lists containing a pair of items separated by a colon.
For example, the list of cluster connections:
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
Graphically, it will look something like this:
The above procedure highlights the names of the elements for the title and the data for filling the table:
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 }
Here, instead of a simple command [split $ str ":"], which splits a string into elements separated by ":" and returns a list, a regular expression is applied, since some elements also contain a colon.
The InsertClusterItems procedure (one of several similar ones) simply adds to the tree to the required cluster member a list of child elements with corresponding identifiers.
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 }
You can consider two more options for implementing a similar procedure, where you can clearly see how you can optimize and get rid of duplicate commands:
In this procedure, the addition and verification are solved in the forehead:
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" } }
And here the approach is more correct:
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 } }
The difference between them is in the application of the cycle, in which the repeated command (s) is executed. Which approach to apply is at the discretion of the developer.
We considered adding elements and obtaining data, it’s time to dwell on editing. Since, basically, the same parameters are used for editing and adding (except for the information base), the same dialogue forms are used. The algorithm for calling procedures to add looks like this:
Add :: $ key-> AddToplevelAnd for editing like this:
Edit :: $ key-> Add :: $ key-> AddTopLevelFor example, let's take cluster editing, i.e. clicking on the cluster name in the tree, click the edit button in the toolbar (pencil) and the corresponding form will be displayed on the screen:
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 } }
, , , , FormFieldsDataInsert, :
FormFieldsDataInsert proc FormFieldsDataInsert {frm lst} { foreach i [lindex $lst 0] { # if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] { # regsub -all -- "-" [string trim $param] "_" entry_name # if [winfo exists $frm.ent_$entry_name] { $frm.ent_$entry_name delete 0 end $frm.ent_$entry_name insert end [string trim $value "\""] } if [winfo exists $frm.cb_$entry_name] { global $entry_name set $entry_name [string trim $value "\""] } # if [winfo exists $frm.check_$entry_name] { global $entry_name if {$value eq "0"} { set $entry_name no } elseif {$value eq "1"} { set $entry_name yes } else { set $entry_name $value } } } } }
tcl — . Those. , rac — .
scheduled-jobs-deny ent_scheduled_jobs_deny scheduled_jobs_deny .
, , :
Edit::infobase , .
, , .
, , .., , , . Those. :
SetGlobalVarFromTreeItems proc SetGlobalVarFromTreeItems {tree id} { global host server active_cluster infobase set parent [$tree parent $id] set values [$tree item $id -values] set key [lindex [split $id "::"] 0] switch -- $key { server {set host $values} work_server {set server $values} cluster {set active_cluster $values} infobase {set infobase $values} } if {$parent eq ""} { return } else { SetGlobalVarFromTreeItems $tree $parent } }
1 . — . 4 , . Those. , , .
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" } } }
Those. , , .
95, =). That's all. .
,
.
: . 100%.
2: , win7
