Добавлен вывод списка кластеров, серверов, баз и т.д

Добавлено отображение параметров кластера: сервера, базы, соединения, блокировки и т.д.

1c_srv.cfg

@@ -9,3 +9,4 @@
 set host 1c-vm-srv
 set port 1541
 
+

CHANGELOG

@@ -5,5 +5,10 @@
 # Home page: https://bitbucket.org/svk28/rac-gui
 ######################################################
 
+15/05/2018
+- Добавлен вывод списка кластеров, серверов, баз и т.д
+- Добавлено отображение параметров кластера: сервера, базы, соединения, блокировки и т.д.
+
 16/05/2018
 - Beginning the project
+

lib/function.tcl

@@ -13,34 +13,175 @@ proc Quit {} {
 
 proc TreePress {tree} {
     global host
-    set cluster [$tree item [$tree selection] -values]
+    set id  [$tree selection] 
-    set root [$tree selection]
+    set values [$tree item [$tree selection] -values]
-    RunCommand $root "infobase summary list --cluster=$cluster $host"
+    set key [lindex [split $id "::"] 0]
+    puts "$key, $id , $values"
+    Run::$key $tree $host $values
+    #RunCommand $root "infobase summary list --cluster=$cluster $host"
     
 }
+
+namespace eval Run {} {}
+
+proc Run::server {tree host values} {
+    puts "Server info $host $values"
+    set lst [RunCommand server::$host "cluster list $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        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
+        }
+    }
+}
+proc Run::cluster {$tree host values} {
+    global active_cluster
+    set active_cluster $values
+    puts "Server info $host $values"
+    puts [RunCommand cluster::$values "cluster info --cluster=$values $host"]
+}
+
+proc Run::infobases {tree host values} {
+    global active_cluster
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    
+    set lst [RunCommand infobase::$values "infobase summary --cluster=$active_cluster list $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        set base_list [split $i ":"]
+        if  {[string trim [lindex $base_list 0]] eq "infobase"} {
+            set base_id [string trim [lindex $base_list 1]]
+            lappend base($base_id) $base_id
+        }
+        if  {[string trim [lindex $base_list 0]] eq "name"} {
+            lappend  base($base_id) [string trim [lindex $base_list 1]]
+        }
+        InsertItemsWorkList $base_list
+    }
+    foreach x [array names base] {
+        set id [lindex $base($x) 0]
+        if { [$tree exists "infobase::$id"] == 0 } {
+            $tree insert "infobases::$values" end -id "infobase::$id" -text "[lindex $base($x) 1]" -values "$id"
+        }
+        InsertBaseItems $tree $id
+    }
+}
+proc Run::infobase {tree host values} {
+    global active_cluster
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand infobase::$values "infobase info --cluster=$active_cluster --infobase=$values $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        set base_list [split $i ":"]
+        InsertItemsWorkList $base_list
+    }
+}
+
+proc Run::List:Base {tree host values par} {
+    global active_cluster
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster --infobase=$values $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        set base_list [split $i ":"]
+        InsertItemsWorkList $base_list
+    }
+}
+proc Run::List {tree host values par} {
+    global active_cluster
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster  $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        set base_list [split $i ":"]
+        InsertItemsWorkList $base_list
+    }
+}
+
+proc Run::sessions {tree host values} {
+    Run::List:Base $tree $host $values session
+}
+proc Run::locks {tree host values} {
+    Run::List:Base $tree $host $values lock        
+}
+
+proc Run::connections {tree host values} {
+    Run::List:Base $tree $host $values connection
+}
+proc Run::servers {tree host values} {
+    Run::List $tree $host $values server
+}
+proc Run::profiles {tree host values} {
+    Run::List $tree $host $values profile
+}
+proc Run::processes {tree host values} {
+    Run::List $tree $host $values process
+}
+proc Run::managers {tree host values} {
+    Run::List $tree $host $values manager
+}
+
+proc Run::admins {tree host values} {
+    global active_cluster
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand infobase::$values "agent admin list  $host"]
+    set l [split $lst "&"] 
+    foreach i $l {
+        set base_list [split $i ":"]
+        InsertItemsWorkList $base_list
+    }
+}
+
+proc InsertItemsWorkList {lst} {
+    .frm_work.tree_work insert {} end  -values $lst
+    #.frm_work.tree_work insert val end -text [lindex $lst 1] -values [lindex $lst 1]
+}
 proc RunCommand {root par} {
     global dir rac_cmd cluster
     set pipe [open "|$rac_cmd $par" "r"]
+    set lst ""
     while {[gets $pipe line]>=0} {
-        puts "$line"
+        #puts "$line"
-        set str [split $line ":"]
+        append lst "$line&"
-        set param [string trim [lindex $str 0]]
-        set val [string trim [lindex $str 1]]
-        .frm_work.tree_work insert {} end -text "$param" -values "$val"
-        #.frm_work.tree_work insert {} end -text "$val" -values "$val"
-        if {$param eq "cluster"} {
-            set cluster $val
-        }
-        if {$param eq "name"} {
-            set cluster_name $val
-            .frm_tree.tree insert $root end -text "$val" -values "$cluster"
-        }
     }
     close $pipe
+    return $lst
     #    fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
     #    fconfigure $pipe -buffering none -blocking no
 }
 
+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 "managers-all"
+    $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 "secureprofiles-all"
+}
+
+proc InsertBaseItems {tree id} {
+    set parent "infobase::$id"
+    $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
+    $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
+    $tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
+}
+
 proc DebugInfo {widget f} {
     if {[eof $f]} {
         catch [close $f] msg
@@ -55,6 +196,5 @@ proc DebugInfo {widget f} {
         puts "$line"
         $widget insert {} end -text "$line" -values "$line"
     }
-
-
 }
+

lib/gui.tcl

@@ -45,7 +45,7 @@ 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 -columns "par val" -displaycolumns "par val" -xscrollcommand [list $frm_work.hsb set] -yscrollcommand [list $frm_work.vsb set]]
+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]]
 #set tree_work [ttk::treeview $frm_work.tree_work \
 
 #$tree_work heading Creator -text "Creator" -anchor center
@@ -79,3 +79,4 @@ pack $frm_tree $frm_work -side left -expand true -fill both
 # # Tell the text widget to take all the extra room
 # grid rowconfigure    .t .t.txt -weight 1
 # grid columnconfigure .t .t.txt -weight 1
+

rac_gui.cfg

@@ -8,3 +8,4 @@
 set locale "ru"
 set rac_cmd "/opt/1C/v8.3/x86_64/rac"
 set dir(lib) [file join [pwd] lib]
+

rac_gui.tcl

@@ -38,7 +38,9 @@ foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
 source [file join $dir(lib) gui.tcl]
 
 puts "$rac_cmd $dir(lib)"
-.frm_tree.tree insert {} end -id "$host" -text "$host" -values "$host"
+.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host:$port"
+#.frm_tree.tree insert {} end -id "$host" -text "$host" -values "$host"
+
+#RunCommand $host "cluster list $host $port"
 
-RunCommand $host "cluster list $host $port"