Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Sa pagtalakay namin sa paksa kung paano gumagana ang mga produkto ng 1C sa kapaligiran ng Linux, natuklasan ang isang disbentaha - ang kakulangan ng isang maginhawang graphical na multi-platform na tool para sa pamamahala ng isang kumpol ng mga 1C server. At napagpasyahan na itama ang disbentaha na ito sa pamamagitan ng pagsulat ng isang GUI para sa rac console utility. Napili ang Tcl/tk bilang wika ng pag-unlad bilang, sa palagay ko, ang pinaka-angkop para sa gawaing ito. At kaya, nais kong ipakita ang ilang mga kagiliw-giliw na aspeto ng solusyon sa materyal na ito.

Upang gumana kakailanganin mo ang tcl/tk at 1C distribution. At dahil napagpasyahan kong sulitin ang mga kakayahan ng pangunahing paghahatid ng tcl/tk nang hindi gumagamit ng mga third-party na pakete, kakailanganin ko ang bersyon 8.6.7, na kinabibilangan ng ttk - isang pakete na may karagdagang mga elemento ng graphic, kung saan higit na kailangan natin ang ttk ::TreeView, pinapayagan nito ang pagpapakita ng data kapwa sa anyo ng istraktura ng puno at sa anyo ng isang talahanayan (listahan). Gayundin, sa bagong bersyon, ang gawaing may mga pagbubukod ay muling ginawa (ang try command, na ginagamit sa proyekto kapag nagpapatakbo ng mga panlabas na utos).

Ang proyekto ay binubuo ng ilang mga file (bagaman walang pumipigil sa iyo na gawin ang lahat sa isa):

rac_gui.cfg - default na config
rac_gui.tcl - pangunahing script ng paglulunsad
Ang direktoryo ng lib ay naglalaman ng mga file na awtomatikong na-load sa pagsisimula:
function.tcl - file na may mga pamamaraan
gui.tcl - pangunahing graphical na interface
images.tcl - base64 image library

Ang rac_gui.tcl file, sa katunayan, ay nagsisimula sa interpreter, nagpapasimula ng mga variable, naglo-load ng mga module, config, at iba pa. Mga nilalaman ng file na may mga komento:

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

Pagkatapos i-download ang lahat ng kinakailangan at suriin kung mayroong rac utility, isang graphical na window ang ilulunsad. Ang interface ng programa ay binubuo ng tatlong elemento:

Toolbar, puno at listahan

Ginawa ko ang mga nilalaman ng "puno" bilang katulad hangga't maaari sa karaniwang kagamitan sa Windows mula sa 1C.

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Ang pangunahing code na bumubuo sa window na ito ay nakapaloob sa 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

Ang algorithm para sa pagtatrabaho sa programa ay ang mga sumusunod:

1. Una, kailangan mong idagdag ang pangunahing cluster server (ibig sabihin, ang cluster management server (sa Linux, ang pamamahala ay inilunsad gamit ang command na β€œ/opt/1C/v8.3/x86_64/ras cluster β€”daemon”)).

Upang gawin ito, mag-click sa pindutang "+" at sa window na bubukas, ipasok ang address at port ng server:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pagkatapos, lalabas ang aming server sa puno sa pamamagitan ng pag-click dito, magbubukas ang isang listahan ng mga kumpol o isang error sa koneksyon ang ipapakita.

2. Ang pag-click sa pangalan ng cluster ay magbubukas ng isang listahan ng mga function na magagamit para dito.

3. ...

At iba pa, i.e. upang magdagdag ng bagong cluster, pumili ng alinmang available sa listahan at pindutin ang "+" na button sa toolbar at ipapakita ang add new dialog:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Ang mga pindutan sa toolbar ay gumaganap ng mga function depende sa konteksto, i.e. Depende sa kung aling elemento ng puno o listahan ang pipiliin, isa o ibang pamamaraan ang isasagawa.

Tingnan natin ang halimbawa ng add button (β€œ+”):

Code ng pagbuo ng button:

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

Dito makikita natin na kapag pinindot ang pindutan, ang "Magdagdag" na pamamaraan ay isasagawa, ang code nito:

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
}

Narito ang isa sa mga pakinabang ng kiliti: maaari mong ipasa ang halaga ng isang variable bilang pangalan ng pamamaraan:

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

Iyon ay, halimbawa, kung itinuro natin ang pangunahing server at pindutin ang "+", pagkatapos ay ilulunsad ang Add::server procedure, kung sa cluster - Add::cluster at iba pa (Isusulat ko kung saan ang ang mga kinakailangang "susi" ay nagmumula sa kaunti sa ibaba), ang mga nakalistang pamamaraan ay gumuhit ng mga graphic na elemento na naaangkop sa konteksto.

Tulad ng napansin mo na, ang mga form ay magkatulad sa istilo - hindi ito nakakagulat, dahil ipinapakita ang mga ito sa pamamagitan ng isang pamamaraan, mas tiyak ang pangunahing frame ng form (window, mga pindutan, imahe, label), ang pangalan ng pamamaraan. 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
}

Mga parameter ng tawag: pamagat, pangalan ng larawan para sa icon mula sa library (lib/images.tcl) at isang opsyonal na parameter ng pangalan ng window (default .add). Kaya, kung kukunin natin ang mga halimbawa sa itaas para sa pagdaragdag ng pangunahing server at kumpol, ang tawag ay magiging naaayon:

AddToplevel "Π”ΠΎΠ±Π°Π²Π»Π΅Π½ΠΈΠ΅ основного сСрвСра" server_grey_64

o

AddToplevel "Π”ΠΎΠ±Π°Π²Π»Π΅Π½ΠΈΠ΅ кластСра" cluster_grey_64

Well, sa pagpapatuloy sa mga halimbawang ito, ipapakita ko ang mga pamamaraan na nagpapakita ng mga add dialog para sa isang server o cluster.

Magdagdag ng::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
}

Magdagdag ng::kumpol

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
}

Kapag inihambing ang code ng mga pamamaraang ito, ang pagkakaiba ay makikita sa mata; ako ay tumutuon sa "Ok" na tagapangasiwa ng pindutan. Sa Tk, ang mga katangian ng mga graphic na elemento ay maaaring ma-override sa panahon ng pagpapatupad ng programa gamit ang opsyon i-configure ang. Halimbawa, ang paunang utos upang ipakita ang pindutan:

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

Ngunit sa aming mga form, ang utos ay nakasalalay sa kinakailangang pag-andar:

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

Sa halimbawa sa itaas, ang "barado" na buton ay magsisimula ng pamamaraan para sa pagdaragdag ng isang kumpol.

Narito ito ay nagkakahalaga ng paggawa ng isang digression patungo sa pagtatrabaho sa mga graphic na elemento sa Tk - para sa iba't ibang mga elemento ng input ng data (entry, combobox, checkbutton, atbp.) Ang isang parameter ay ipinakilala bilang isang variable ng teksto:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Ang variable na ito ay tinukoy sa pandaigdigang namespace at naglalaman ng kasalukuyang inilagay na halaga. Yung. upang makuha ang ipinasok na teksto mula sa patlang, kailangan mo lamang basahin ang halaga na naaayon sa variable (siyempre, sa kondisyon na ito ay tinukoy kapag lumilikha ng elemento).

Ang pangalawang paraan para sa pagkuha ng ipinasok na teksto (para sa mga elemento ng uri ng entry) ay ang paggamit ng get command:

.add.frm.ent_name get

Ang parehong mga pamamaraan na ito ay makikita sa code sa itaas.

Ang pag-click sa button na ito, sa kasong ito, ay naglulunsad ng RunCommand procedure na may nabuong command line para sa pagdaragdag ng cluster sa mga tuntunin ng 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

Ngayon ay napunta tayo sa pangunahing utos, na kumokontrol sa paglulunsad ng rac na may mga parameter na kailangan natin, pina-parse din ang output ng mga command sa mga listahan at pagbabalik, kung kinakailangan:

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

Matapos ipasok ang pangunahing data ng server, ito ay idaragdag sa puno, para dito, sa itaas na Add:server procedure, ang sumusunod na code ay may pananagutan:

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

Ngayon, sa pamamagitan ng pag-click sa pangalan ng server sa tree, nakakakuha kami ng listahan ng mga cluster na pinamamahalaan ng server na iyon, at sa pamamagitan ng pag-click sa isang cluster, nakakakuha kami ng listahan ng mga elemento ng cluster (mga server, infobase, atbp.). Ito ay ipinatupad sa pamamaraan ng TreePress (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
}

Alinsunod dito, ang Run::server ay ilulunsad para sa pangunahing server (para sa isang cluster - Run::cluster, para sa isang gumaganang server - Run::work_server, atbp.). Yung. ang halaga ng $key variable ay bahagi ng pangalan ng elemento ng puno na tinukoy ng opsyon -id.

Bigyang-pansin natin ang pamamaraan

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

Pinoproseso ng pamamaraang ito ang natanggap mula sa server sa pamamagitan ng utos ng RunCommand at idinaragdag ang lahat ng uri ng mga bagay sa puno - mga kumpol, iba't ibang elemento ng ugat (mga base, gumaganang server, session, at iba pa). Kung titingnan mong mabuti, mapapansin mo ang isang tawag sa pamamaraan ng InsertItemsWorkList sa loob. Ito ay ginagamit upang magdagdag ng mga elemento sa isang graphical na listahan sa pamamagitan ng pagproseso ng output ng rac console utility, na dati ay ibinalik bilang isang listahan sa $lst variable. Ito ay isang listahan ng mga listahan na naglalaman ng mga pares ng mga elemento na pinaghihiwalay ng isang tutuldok.

Halimbawa, isang listahan ng mga kumpol na koneksyon:

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

Sa graphical na anyo ito ay magiging ganito:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pinipili ng pamamaraan sa itaas ang mga pangalan ng mga elemento para sa header at data upang punan ang talahanayan:

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
}

Dito, sa halip na isang simpleng utos [split $str ":"], na naghahati sa string sa mga elemento na pinaghihiwalay ng ":" at nagbabalik ng listahan, isang regular na expression ang ginagamit, dahil ang ilang elemento ay naglalaman din ng colon.

Ang pamamaraan ng InsertClusterItems (isa sa ilang mga katulad) ay nagdaragdag lamang ng isang listahan ng mga elemento ng bata na may kaukulang mga identifier sa puno ng kinakailangang elemento ng cluster
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
}

Maaari mong isaalang-alang ang dalawa pang opsyon para sa pagpapatupad ng katulad na pamamaraan, kung saan malinaw na makikita kung paano mo ma-optimize at mapupuksa ang mga paulit-ulit na utos:

Sa pamamaraang ito, ang pagdaragdag at pagsuri ay malulutas nang direkta:

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

Narito ang isang mas tamang diskarte:

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

Ang pagkakaiba sa pagitan ng mga ito ay ang paggamit ng isang loop, kung saan ang (mga) paulit-ulit na command ay isinasagawa. Aling diskarte ang gagamitin ay nasa pagpapasya ng developer.

Sinakop namin ang pagdaragdag ng mga elemento at pagkuha ng data, ngayon ay oras na upang tumuon sa pag-edit. Dahil, karaniwang, ang parehong mga parameter ay ginagamit para sa pag-edit at pagdaragdag (maliban sa base ng impormasyon), ang parehong mga dialog form ay ginagamit. Ang algorithm para sa mga pamamaraan ng pagtawag para sa pagdaragdag ay ganito ang hitsura:

Magdagdag::$key->AddToplevel

At para sa pag-edit tulad nito:

I-edit::$key->Add::$key->AddTopLevel

Halimbawa, kunin natin ang pag-edit ng isang cluster, i.e. Ang pagkakaroon ng pag-click sa pangalan ng kumpol sa puno, pindutin ang pindutan ng pag-edit sa toolbar (lapis) at ang kaukulang form ay ipapakita sa screen:

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk
I-edit::kumpol

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

Batay sa mga komento sa code, sa prinsipyo, ang lahat ay malinaw, maliban na ang button handler code ay na-override at mayroong FormFieldsDataInsert na pamamaraan na pumupuno sa mga field ng data at nagpapasimula ng mga variable:

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

Sa pamamaraang ito, lumitaw ang isa pang bentahe ng tcl - ang mga halaga ng iba pang mga variable ay pinalitan bilang mga pangalan ng variable. Yung. upang i-automate ang pagpuno ng mga form at pagsisimula ng mga variable, ang mga pangalan ng mga patlang at mga variable ay tumutugma sa mga command line switch ng rac utility at ang mga pangalan ng mga parameter ng output ng command na may ilang pagbubukod - ang gitling ay pinalitan ng isang underscore. Hal nakatakdang-trabaho-tanggihan tumutugma sa larangan ent_scheduled_jobs_deny at variable scheduled_jobs_deny.

Ang mga form para sa pagdaragdag at pag-edit ay maaaring magkakaiba sa komposisyon ng mga patlang, halimbawa, nagtatrabaho sa isang base ng impormasyon:

Pagdaragdag ng seguridad ng impormasyon

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pag-edit ng seguridad ng impormasyon

Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Sa proseso ng pag-edit na Edit::infobase, ang mga kinakailangang field ay idinagdag sa form; ang code ay napakalaki, kaya hindi ko ito ipinakita dito.

Sa pamamagitan ng pagkakatulad, ang mga pamamaraan para sa pagdaragdag, pag-edit, pagtanggal ay ipinatupad para sa iba pang mga elemento.

Dahil ang pagpapatakbo ng utility ay nagpapahiwatig ng isang walang limitasyong bilang ng mga server, kumpol, base ng impormasyon, atbp., upang matukoy kung aling kumpol ang nabibilang sa kung aling server o sistema ng seguridad ng impormasyon, maraming mga pandaigdigang variable ang ipinakilala, ang mga halaga nito ay itinakda sa bawat isa. oras na nag-click ka sa mga elemento ng puno. Yung. ang pamamaraan ay paulit-ulit na tumatakbo sa lahat ng mga elemento ng magulang at nagtatakda ng mga variable:

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

Ang 1C cluster ay nagpapahintulot sa iyo na magtrabaho nang may pahintulot o walang pahintulot. Mayroong dalawang uri ng mga administratorβ€”administrator ng ahente ng cluster at administrator ng cluster. Alinsunod dito, para sa tamang operasyon, 4 pang pandaigdigang variable ang ipinakilala na naglalaman ng administrator login at password. Yung. kung mayroong administrator account sa cluster, may ipapakitang dialog para ipasok ang iyong login at password, ang data ay ise-save sa memorya at ilalagay sa bawat command para sa kaukulang cluster.

Ito ang responsibilidad ng pamamaraan ng paghawak ng error.

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

Yung. depende sa kung ano ang ibabalik ng utos, ang reaksyon ay magiging naaayon.

Sa ngayon, humigit-kumulang 95 porsiyento ng pag-andar ang naipatupad na, ang natitira na lang ay ipatupad ang trabaho sa mga profile ng seguridad at subukan ito =). Iyon lang. Humihingi ako ng paumanhin para sa gusot na kuwento.

Ang code ay tradisyonal na magagamit dito.

Update: Natapos kong magtrabaho sa mga profile ng seguridad. Ngayon ang pag-andar ay 100% na ipinatupad.

Update 2: naidagdag na ang localization sa English at Russian, nasubok ang trabaho sa win7
Pagsusulat ng GUI para sa 1C RAC, o muli tungkol sa Tcl/Tk

Pinagmulan: www.habr.com

Magdagdag ng komento