Kami menulis GUI ke 1C RAC, atau lagi tentang Tcl / Tk

Ketika saya mempelajari topik kerja produk 1C di linux, saya menemukan satu kelemahan - kurangnya alat multi-platform grafis yang nyaman untuk mengelola sekelompok server 1C. Dan diputuskan untuk memperbaiki kekurangan ini dengan menulis GUI untuk rac utility console. Bahasa pengembangan dipilih tcl / tk sebagai, menurut pendapat saya, yang paling cocok untuk tugas ini. Dan sekarang, saya ingin menyajikan beberapa aspek menarik dari solusi dalam materi ini.

Untuk bekerja, Anda memerlukan distribusi tcl / tk dan 1C. Dan karena saya memutuskan untuk memaksimalkan kemampuan pengiriman tcl / tk dasar tanpa menggunakan paket pihak ketiga, saya akan membutuhkan versi 8.6.7, yang mencakup ttk - paket dengan elemen grafis tambahan, yang kita perlukan terutama ttk :: TreeView, memungkinkan menampilkan data baik dalam bentuk struktur pohon maupun dalam bentuk tabel (daftar). Juga, dalam versi baru, bekerja dengan pengecualian telah dilakukan ulang (perintah coba, yang digunakan dalam proyek ketika menjalankan perintah eksternal).

Sebuah proyek terdiri dari beberapa file (walaupun tidak ada yang mencegah semuanya dilakukan oleh satu):

rac_gui.cfg - konfigurasi default
rac_gui.tcl - skrip startup utama
Direktori lib berisi file yang dimuat secara otomatis saat startup:
function.tcl - file dengan prosedur
gui.tcl - GUI utama
images.tcl - pustaka gambar di base64

File rac_gui.tcl, pada kenyataannya, memulai interpreter, menginisialisasi variabel, memuat modul, konfigurasi, dan sebagainya. Isi file dengan komentar:

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


Setelah mengunduh semua yang diperlukan dan memeriksa ketersediaan utilitas balap, jendela grafis akan diluncurkan. Antarmuka program terdiri dari tiga elemen:

Bilah alat, pohon dan daftar

Saya membuat konten "tree" semirip mungkin dengan jendela standar yang diambil dari 1C.

gambar

Kode utama yang membentuk jendela ini terdapat dalam 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 


Algoritma untuk bekerja dengan program ini adalah sebagai berikut:

1. Pada awalnya, Anda perlu menambahkan server cluster utama (yaitu server manajemen cluster (di linux, perintah dimulai dengan perintah "/opt/1C/v8.3/x86_64/ras cluster --daemon").

Untuk melakukan ini, klik tombol "+" dan di jendela yang terbuka, masukkan alamat dan port server:

gambar

Setelah itu, server kami muncul di pohon dengan mengklik di mana, daftar kelompok terbuka atau kesalahan koneksi ditampilkan.

2. Dengan mengklik pada nama cluster, daftar fungsi yang tersedia untuk itu akan terbuka.

3. ...

Baik dan seterusnya, mis. Untuk menambahkan cluster baru, pilih yang tersedia dalam daftar dan tekan tombol + di toolbar dan dialog untuk menambahkan yang baru akan ditampilkan:

gambar

Tombol-tombol pada bilah alat menjalankan fungsi tergantung pada konteksnya, mis. dari elemen pohon atau daftar mana yang dipilih, prosedur ini atau itu akan dilakukan.

Pertimbangkan tombol add ("+") sebagai contoh:

Kode pembuatan tombol:

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

Di sini kita melihat bahwa ketika tombol ditekan, prosedur Tambah akan dieksekusi, kodenya:

 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 } 

Jadi salah satu keuntungan dari gelitik ini terlihat - Anda dapat melewatkan nilai variabel sebagai nama prosedur:

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

Misalnya, jika kita melihat pada server utama dan menekan "+", prosedur Add :: server akan diluncurkan, jika clusternya adalah Add :: cluster dan seterusnya (saya akan menulis sedikit tentang dari mana "kunci" yang diperlukan berasal di bawah), prosedur yang terdaftar menggambar elemen grafik yang sesuai dengan konteksnya.

Seperti yang mungkin Anda perhatikan, bentuk-bentuknya serupa gaya - ini tidak mengejutkan, karena mereka ditampilkan dalam satu prosedur, lebih tepatnya bingkai utama dari formulir (jendela, tombol, gambar, label), nama prosedur
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 } 


Parameter panggilan: judul, nama gambar untuk ikon dari perpustakaan (lib / images.tcl) dan parameter nama jendela opsional (default .add). Jadi, jika kita mengambil contoh di atas untuk menambahkan server dan kluster utama, maka panggilan akan sesuai:

 AddToplevel "  " server_grey_64 

atau

 AddToplevel " " cluster_grey_64 

Nah, melanjutkan dengan contoh-contoh ini saya akan menunjukkan prosedur yang menampilkan dialog add untuk server atau cluster.

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


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


Saat membandingkan kode prosedur ini, perbedaannya terlihat dengan mata telanjang, saya akan fokus pada penangan tombol OK. Di Tk, properti elemen grafis dapat didefinisikan ulang saat runtime menggunakan opsi configure . Misalnya, perintah output tombol awal:

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

Tetapi dalam formulir kami, perintah tergantung pada fungsi yang diperlukan:

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

Dalam contoh di atas, tombol "tersumbat" memulai prosedur untuk menambahkan sebuah cluster.

Di sini perlu dilakukan penyimpangan terhadap bekerja dengan elemen grafis dalam Tk - untuk berbagai elemen entri data (entri, kotak kombo, kotak centang, dll.), Seperti parameter sebagai variabel teks (textvariable) diperkenalkan:

 entry $frm.ent_lifetime_limit -textvariable lifetime_limit 

Variabel ini didefinisikan dalam namespace global dan berisi nilai saat ini yang dimasukkan. Yaitu untuk mendapatkan teks yang dimasukkan dari bidang Anda hanya perlu membaca nilai yang sesuai dengan variabel (tentu saja, asalkan itu didefinisikan saat membuat elemen).

Metode kedua untuk mendapatkan teks yang dimasukkan (untuk elemen entri tipe) adalah dengan menggunakan perintah get:

 .add.frm.ent_name get 

Kedua metode ini dapat dilihat pada kode di atas.

Mengklik tombol ini, dalam hal ini, memulai prosedur RunCommand dengan baris perintah yang dihasilkan untuk menambahkan cluster dalam hal ras:

 /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 

Jadi kami sampai pada perintah utama, yang mengontrol peluncuran rac dengan parameter yang kami butuhkan, juga mem-parsing output dari perintah ke dalam daftar dan kembali jika perlu:

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


Setelah memasukkan data server utama, itu akan ditambahkan ke pohon, untuk ini, dalam prosedur Tambahkan: server di atas, kode berikut bertanggung jawab:

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

Sekarang, dengan mengklik nama server di pohon, kami mendapatkan daftar cluster yang dikelola oleh server itu, dan mengklik sebuah cluster, kami mendapatkan daftar elemen cluster (server, infobases, dll.). Ini diimplementasikan dalam prosedur 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 } 

Dengan demikian, Run :: server akan mulai untuk server utama (Run :: cluster untuk cluster, Run :: work_server, dll untuk server produksi). Yaitu nilai variabel $ key adalah bagian dari nama elemen pohon yang ditentukan oleh opsi -id .

Perhatikan prosedurnya

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


Prosedur ini memproses apa yang diterima dari server melalui perintah RunCommand, dan menambahkan segala macam hal ke cluster pohon, berbagai elemen root (database, server produksi, sesi, dan sebagainya). Jika Anda melihat lebih dekat, di dalam Anda dapat melihat panggilan ke prosedur InsertItemsWorkList. Ini digunakan untuk menambahkan elemen ke daftar grafik, memproses output dari rac utility console, yang sebelumnya dikembalikan sebagai daftar ke variabel $ lst. Ini adalah daftar daftar yang berisi pasangan elemen yang dipisahkan oleh tanda titik dua.

Misalnya, daftar koneksi 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 

Dalam bentuk grafis, akan terlihat seperti ini:

gambar

Prosedur di atas mengidentifikasi nama-nama elemen untuk header dan data untuk mengisi tabel:

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


Di sini alih-alih perintah sederhana [split $ str ":"], yang memecah string menjadi elemen yang dipisahkan oleh ":" dan mengembalikan daftar, ekspresi reguler diterapkan, karena beberapa elemen juga mengandung titik dua.

Prosedur InsertClusterItems (salah satu dari beberapa yang serupa) hanya menambahkan daftar elemen anak dengan pengidentifikasi yang sesuai ke elemen cluster yang diperlukan di pohon
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 } 


Anda dapat mempertimbangkan dua opsi lagi untuk menerapkan prosedur semacam itu, di mana akan terlihat jelas bagaimana Anda dapat mengoptimalkan dan menghilangkan perintah duplikat:

Dalam prosedur ini, menambah dan memeriksa diselesaikan di dahi:

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


Dan di sini pendekatannya lebih tepat:

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


Perbedaan di antara mereka adalah penggunaan siklus di mana perintah yang berulang dijalankan. Pendekatan mana yang digunakan adalah atas kebijakan pengembang.

Kami mempertimbangkan untuk menambahkan elemen dan menerima data, saatnya berhenti mengedit. Karena pada dasarnya parameter yang sama digunakan untuk mengedit dan menambahkan (pengecualiannya adalah infobase), bentuk dialognya sama. Prosedur panggilan prosedur untuk menambahkan terlihat seperti ini:

Tambah :: $ key-> AddToplevel

Dan untuk mengedit seperti ini:

Edit :: $ key-> Add :: $ key-> AddTopLevel

Misalnya, ambil pengeditan kluster, mis. dengan mengklik nama gugus di pohon, tekan tombol edit di bilah alat (pensil) dan formulir yang sesuai akan ditampilkan:

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


Menurut komentar dalam kode, pada prinsipnya, semuanya jelas, kecuali bahwa kode handler tombol didefinisikan ulang dan prosedur FormFieldsDataInsert hadir, yang mengisi bidang dengan data dan menginisialisasi variabel:

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


Dalam prosedur ini, plus tcl lainnya muncul - nilai-nilai variabel lain diganti sebagai nama variabel. Yaituuntuk secara otomatis mengisi formulir dan menginisialisasi variabel, nama-nama bidang dan variabel sesuai dengan switch baris perintah utilitas ras dan nama-nama parameter output dari perintah dengan beberapa pengecualian - tanda hubung diganti dengan garis bawah. Misalnya, dijadwalkan-pekerjaan-menolak sesuai dengan bidang ent_scheduled_jobs_deny dan variabel terjadwal_jobs_deny .

Bentuk menambahkan dan mengedit mungkin berbeda dalam komposisi bidang, misalnya, bekerja dengan basis informasi:

Menambahkan IB

gambar

Mengedit IB

gambar

Dalam prosedur pengeditan Edit :: infobase, bidang yang diperlukan ditambahkan ke formulir, oleh karena itu saya tidak menyediakan kode besar di sini.

Dengan analogi, prosedur untuk menambah, mengedit, menghapus elemen lain diimplementasikan.

Karena utilitas melibatkan jumlah server, cluster, infobases, dll yang tidak terbatas, untuk menentukan cluster mana yang dimiliki server atau keamanan informasi, beberapa variabel global telah diperkenalkan, nilai-nilai yang ditetapkan setiap kali Anda mengklik pada elemen pohon. Yaitu prosedur secara rekursif berjalan melalui semua elemen induk dan menetapkan variabel:

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


Cluster 1C memungkinkan Anda untuk bekerja dengan atau tanpa otorisasi. Ada dua jenis administrator - administrator agen cluster dan administrator cluster. Dengan demikian, untuk operasi yang benar, diperkenalkan 4 variabel global yang berisi login dan kata sandi administrator. Yaitujika akun administrator ada di kluster, dialog akan ditampilkan untuk memasukkan login dan kata sandi, data akan disimpan dalam memori dan dimasukkan ke dalam setiap perintah untuk kluster yang sesuai.

Prosedur penanganan kesalahan bertanggung jawab untuk ini.

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


Yaitutergantung pada apa perintah kembali, akan ada reaksi yang sesuai.

Saat ini, fungsionalitas telah diimplementasikan untuk 95 persen, tetap untuk mengimplementasikan pekerjaan dengan profil keamanan dan menguji =). Itu saja. Saya minta maaf atas narasi yang kusut.

Kode ini tersedia secara tradisional di sini .

Pembaruan: Pekerjaan yang selesai dengan profil keamanan. Sekarang fungsionalitasnya 100% diimplementasikan.

Pembaruan 2: pelokalan dalam bahasa Inggris dan Rusia ditambahkan, pekerjaan di win7 diperiksa
gambar

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


All Articles