From 0a34af045a3d12dce8edf37582ab409311f402e8 Mon Sep 17 00:00:00 2001
From: Sergey Kalinin <banzaj28@yandex.ru>
Date: Wed, 6 Jun 2018 12:35:20 +0300
Subject: [PATCH] =?UTF-8?q?=D0=A1=D0=B4=D0=B5=D0=BB=D0=B0=D0=BD=20=D0=B2?=
 =?UTF-8?q?=D1=8B=D0=B2=D0=BE=D0=B4=20=D0=B4=D0=B0=D0=BD=D0=BD=D1=8B=D1=85?=
 =?UTF-8?q?=20=D0=B2=20=D0=BD=D0=BE=D1=80=D0=BC=D0=B0=D0=BB=D1=8C=D0=BD?=
 =?UTF-8?q?=D1=83=D1=8E=20=D1=82=D0=B0=D0=B1=D0=BB=D0=B8=D1=86=D1=83?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 lib/function.tcl | 145 +++++++++++++++++------------------------------
 lib/gui.tcl      |  17 +++++-
 rac_gui.cfg      |  11 +++-
 rac_gui.tcl      |   3 +-
 4 files changed, 77 insertions(+), 99 deletions(-)

diff --git a/lib/function.tcl b/lib/function.tcl
index 6b90614..ad3c540 100644
--- a/lib/function.tcl
+++ b/lib/function.tcl
@@ -21,35 +21,14 @@ proc TreePress {tree} {
     } elseif {$key eq ""} {
         return
     }        
-    #puts "$id $host $values"
+    puts "$id $host $values"
     Run::$key $tree $host $values
     #RunCommand $root "infobase summary list --cluster=$cluster $host"
 }
 
 namespace eval Run {} {}
 # Получение данных по кластерам
-proc Run::server_ {tree 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::server {tree host values} {
     set lst [RunCommand server::$host "cluster list $host"]
     set l [lindex $lst 0]
@@ -115,10 +94,7 @@ proc Run::infobase {tree host values} {
     set lst [RunCommand infobase::$values "infobase info --cluster=$active_cluster --infobase=$values $host"]
     
     foreach l $lst {
-        foreach i $l {
-            set base_list [split $i ":"]
-            InsertItemsWorkList $base_list
-        }
+        InsertItemsWorkList $l
     }
 }
 
@@ -128,11 +104,6 @@ proc Run::List:Base {tree host values par} {
     set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster --infobase=$values $host"]
     
     foreach l $lst {
-        foreach i $l {
-            set base_list [split $i ":"]
-            InsertItemsWorkList $base_list
-        }
-        puts "--$l"
         InsertItemsWorkList $l
     }
 }
@@ -141,10 +112,6 @@ proc Run::List {tree host values par} {
     .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
     set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster  $host"]
     foreach l $lst {
-        foreach i $l {
-            set base_list [split $i ":"]
-            #InsertItemsWorkList $base_list
-        }
         InsertItemsWorkList $l
     }
 }
@@ -183,23 +150,17 @@ proc Run::servers {tree host values} {
         if { [$tree exists "work_server::$id"] == 0 } {
             $tree insert "servers::$values" end -id "work_server::$id" -text "[lindex $server($x) 1]" -values "$id"
         }
-        #InsertServerItems $tree $id
+       InsertWorkServerItems $tree $id
     }
     #Run::List $tree $host $values server
 }
 proc Run::work_server {tree host values} {
-    global active_cluster
+    global active_cluster work_list_row_count
     .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
     set lst [RunCommand infobase::$values "server info --cluster=$active_cluster  --server=$values $host"]
     foreach l $lst {
-        foreach i $l {
-            set base_list [split $i ":"]
-            InsertItemsWorkList_ $base_list
-        }
-        #puts $l
-        #InsertItemsWorkList $l
+        InsertItemsWorkList $l
     }
-    #Run::List $tree $host $values server
 }
 proc Run::profiles {tree host values} {
     Run::List $tree $host $values profile
@@ -207,6 +168,23 @@ proc Run::profiles {tree host values} {
 proc Run::processes {tree host values} {
     Run::List $tree $host $values process
 }
+proc Run::work_server_processes {tree host values} {
+    global active_cluster work_list_row_count
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand work_server_processes::$values "process list --cluster=$active_cluster --server=$values $host"]
+    foreach l $lst {
+        InsertItemsWorkList $l
+    }
+}
+proc Run::work_server_licenses {tree host values} {
+    global active_cluster work_list_row_count
+    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
+    set lst [RunCommand work_server_processes::$values "process list --cluster=$active_cluster --server=$values --licenses $host"]
+    foreach l $lst {
+        InsertItemsWorkList $l
+    }
+}
+
 proc Run::managers {tree host values} {
     Run::List $tree $host $values manager
 }
@@ -215,58 +193,39 @@ 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
+    #set l [split $lst "&"] 
+    foreach l $lst {
+        #set base_list [split $i ":"]
+        InsertItemsWorkList $l
     }
 }
 
-proc InsertItemsWorkList_ {lst} {
-    #.frm_work.tree_work configure -columns "par val" -displaycolumns "par val"
-    .frm_work.tree_work insert {} end  -values $lst
-    #     .frm_work.tree_work column [lindex $lst 0] -id [lindex $lst 0]
-    #     .frm_work.tree_work heading [lindex $lst 0] -text [lindex $lst 0]
-    #     .frm_work.tree_work insert [lindex $lst 0] end  -values [lindex $lst 1]
-    #.frm_work.tree_work insert val end -text [lindex $lst 1] -values [lindex $lst 1]
-    #puts [.frm_work.tree_work cget -columns]
-    #puts [.frm_work.tree_work column par]
-    
-}
 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 {
-        set l [split $i ":"]
-        lappend column_list [lindex $l 0]
-        lappend value_list [lindex $l 1]
+        if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.+)} $i match param v2 v3 v4 value] {
+            lappend column_list $param
+            lappend value_list $value
+        }
     }
     .frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
-    .frm_work.tree_work insert {} end  -values $value_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
 }
 
-proc RunCommand_ {root par} {
-    global dir rac_cmd cluster
-    #puts $par
-    set pipe [open "|$rac_cmd $par" "r"]
-    set lst ""
-    while {[gets $pipe line]>=0} {
-        #puts "$line"
-        if {$line eq ""} {
-            append lst "----&"
-        } else {
-            append lst "$line&"
-        }
-    }
-    close $pipe
-    return $lst
-    #    fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
-    #    fconfigure $pipe -buffering none -blocking no
-}
 proc RunCommand {root par} {
-    global dir rac_cmd cluster
-    #puts $par
+    global dir rac_cmd cluster work_list_row_count
+    puts "$rac_cmd $par"
+    set work_list_row_count 0
     set pipe [open "|$rac_cmd $par" "r"]
     set lst ""
     set l ""
@@ -275,7 +234,7 @@ proc RunCommand {root par} {
             lappend l $lst
             set lst ""
         } else {
-            lappend lst $line
+            lappend lst [string trim $line]
         }
     }
     close $pipe
@@ -310,16 +269,17 @@ proc InsertBaseItems {tree id} {
         $tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
     }
 }
-proc InsertServerstems {tree id} {
-    set parent "infobase::$id"
-    if { [$tree exists "sessions::$id"] == 0 } {
-        $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
+
+proc InsertWorkServerItems {tree id} {
+    set parent "work_server::$id"
+    if { [$tree exists "work_server_processes::$id"] == 0 } {
+        $tree insert $parent end -id "work_server_processes::$id" -text "Процессы" -values "$id"
     }
-    if { [$tree exists "locks::$id"] == 0 } {
-        $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
+    if { [$tree exists "work_server_licenses::$id"] == 0 } {
+        $tree insert $parent end -id "work_server_licenses::$id" -text "Лицензии" -values "$id"
     }
     if { [$tree exists "connections::$id"] == 0 } {
-        $tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
+        #$tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
     }
 }
 
@@ -702,4 +662,3 @@ proc SaveMainServer {host port} {
     close $file
     return "$host:$port"
 }
-
diff --git a/lib/gui.tcl b/lib/gui.tcl
index 28520a7..456f85f 100644
--- a/lib/gui.tcl
+++ b/lib/gui.tcl
@@ -16,14 +16,18 @@ if {[info exists topLevelGeometry]} {
 
 wm title . "1C Rac GUI"
 wm iconname . "1C Rac Gui"
-#image create photo icon -data {}
-#wm iconphoto . icon
+
+#wm iconphoto . tcllogo
 wm protocol . WM_DELETE_WINDOW Quit
 wm overrideredirect . 0
 wm positionfrom . user
 
 #ttk::style configure TPanedwindow -background blue
 #ttk::style configure Sash -sashthickness 5
+#ttk::style configure TButton  -padding 60  -relief flat -bg black
+#ttk::style configure Custom.Treeview -foreground red
+#ttk::style configure Custom.Treeview -rowheight 20
+
 
 set frm_tool [frame .frm_tool]
 pack $frm_tool -side left -fill y 
@@ -60,11 +64,15 @@ 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 -class TreeView \
+    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]
 ]
+# table rows background colors
+$tree_work tag configure dark -background $color(dark_table_bg)
+$tree_work tag configure light -background $color(light_table_bg)
+
 #$tree_work heading par -text "Параметр" -anchor center
 #$tree_work heading val -text "Значение" -anchor center
 #set tree_work [ttk::treeview $frm_work.tree_work \
@@ -83,3 +91,6 @@ 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
+
+
+
diff --git a/rac_gui.cfg b/rac_gui.cfg
index f725d6f..e737eea 100644
--- a/rac_gui.cfg
+++ b/rac_gui.cfg
@@ -2,9 +2,14 @@
 #                Rac GUI
 #        Distributed under GNU Public License
 # Author: Sergey Kalinin svk@nuk-svk.ru
-# Copyright (c) "http://nuk-svk.ru", 2018,
+# Copyright (c) "http://nuk-svk.ru", 2018
 # https://bitbucket.org/svk28/rac-gui
 ######################################################
+#
+#            Configuration parameters
+#
+######################################################
+
 set rac_cmd "/opt/1C/v8.3/x86_64/rac"
 
 set default(locale) "ru"
@@ -29,4 +34,6 @@ set default(dbms) [list PostgreSQL MSSQLServer IBMDB2 OracleDatabase]
 #    2 -  постоянно
 set default(secure_level) [list 0 1 2]
 set default(date_offset) [list 0 2000]
-
+# цвета строк в таблице
+set color(dark_table_bg) "#e2e2e2"
+set color(light_table_bg) "#ffffff"
diff --git a/rac_gui.tcl b/rac_gui.tcl
index c661810..77107a6 100755
--- a/rac_gui.tcl
+++ b/rac_gui.tcl
@@ -71,8 +71,9 @@ if [file exists [file join $dir(work) 1c_srv.cfg]] {
 # option add *Listbox.Foreground $editor(fg) interactive
 # option add *Listbox.Background $editor(bg) interactive
 # option add *TreeView.Background $editor(bg) interactive
-# option add *TreeView.Foreground $editor(fg) interactive
+#option add *Treeview.Foreground red interactive
 # #option add *Frame.Background $editor(bg) interactive
 # option add *ScrollableFrame.Background $editor(bg) interactive
 # option add *ScrolledWindow.Background $editor(bg) interactive
 
+