1c_rac-gui/lib/function.tcl

######################################################
#                Rac GUI
#        Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018
# https://bitbucket.org/svk28/rac-gui
######################################################


proc Quit {} {
    exit
}

proc TreePress {tree} {
    global host
    
    set id  [$tree selection] 
    set values [$tree item [$tree selection] -values]
    set key [lindex [split $id "::"] 0]
    if {$key eq "server"} {
        set host $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} {
    global active_cluster
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    set lst [RunCommand infobase::$values "server list --cluster=$active_cluster  $host"]
    set l [split $lst "&"] 
    foreach i $l {
        set server_list [split $i ":"]
        #InsertItemsWorkList $server_list
        if  {[string trim [lindex $server_list 0]] eq "server"} {
            set server_id [string trim [lindex $server_list 1]]
            lappend server($server_id) $server_id
        }
        if  {[string trim [lindex $server_list 0]] eq "name"} {
            lappend  server($server_id) [string trim [lindex $server_list 1]]
        }
    }
    foreach x [array names server] {
        set id [lindex $server($x) 0]
        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
    }
    #Run::List $tree $host $values server
}
proc Run::work_server {tree host values} {
    global active_cluster
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    set lst [RunCommand infobase::$values "server info --cluster=$active_cluster  --server=$values $host"]
    set l [split $lst "&"] 
    foreach i $l {
        set base_list [split $i ":"]
        InsertItemsWorkList $base_list
    }
    #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"
        append lst "$line&"
    }
    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"
    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"
    }
}
proc InsertServerstems {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"
    }
}

proc DebugInfo {widget f} {
    if {[eof $f]} {
        catch [close $f] msg
        if {$msg != ""} {
            puts $msg
        } else {
            puts $msg
        }
    }
    
    while {[gets $f line]>=0} {
        puts "$line"
        $widget insert {} end -text "$line" -values "$line"
    }
}

proc Del {} {
    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]
    puts "$key, $id , $values"
    Del::$key .frm_tree.tree $host $values
}

namespace eval Del {} {
    proc work_server {tree host values} {
        global active_cluster
        set answer [tk_messageBox -message "Удалить рабочий сервер $values?" \
        -icon question -type yesno ]
        switch -- $answer {
            yes {
                set lst [RunCommand infobase::$values "server remove --cluster=$active_cluster  --server=$values $host"]
                $tree delete "work_server::$values"
                .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
            }
            no {return}
        }
    }
    proc cluster {tree host values} {
        set answer [tk_messageBox -message "Удалить кластер $values?" \
        -icon question -type yesno ]
        switch -- $answer {
            yes {
                set lst [RunCommand infobase::$values "cluster remove --cluster=$values $host"]
                $tree delete "cluster::$values"
                .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
            }
            no {return}
        }
    }
    proc infobase {tree host values} {
        global active_cluster
        set answer [tk_messageBox -message "Удалить информационную базу $values?" \
        -icon question -type yesno ]
        switch -- $answer {
            yes {
                set lst [RunCommand infobase::$values "infobase drop --infobase=$values --cluster=$active_cluster $host"]
                $tree delete "infobase::$values"
                .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
            }
            no {return}
        }
    }
    proc server {tree host values} {
        global dir
        set answer [tk_messageBox -message "Удалить сервер $values?" \
        -icon question -type yesno ]
        switch -- $answer {
            yes {
                #set lst [RunCommand infobase::$values "cluster remove --cluster=$values $host"]
                file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak] 
                set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
                set file [open [file join $dir(work) 1c_srv.cfg] "w"]
                while {[gets $orig_file line] >=0 } {
                    puts $line                    
                    if { $line ne "" && $line ne "$values"} {
                        puts $file $line
                    }
                }
                close $file
                close $orig_file
                #return "$host:$port"
                $tree delete "server::$values"
                .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
                file delete [file join $dir(work) 1c_srv.cfg.bak] 
            }
            no {return}
        }
    }
    
}
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 ]
    }
    puts "$key, $id , $values"
    Add::$key .frm_tree.tree $host $values
}

namespace eval Add {} {
    proc server {} {
        global default
        toplevel .add
        set frm [ttk::labelframe .add.frm -text "Добавление основного сервера" -labelanchor nw]
        
        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 $frm.btn_ok -row 2 -column 1 -sticky nw -padx 5 -pady 5
        #grid $frm.btn_cancel -row 2 -column 1 -sticky se -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]
        ttk::button $frm_btn.btn_ok -image add_grey_24 -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
        }
        ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24 
        pack $frm $frm_btn -padx 5 -pady 5 -expand true -fill x
        pack  $frm_btn.btn_cancel  -side right
        pack  $frm_btn.btn_ok  -side right -padx 10                
        puts $host
    }
    proc work_server {tree host values} {
    }
    proc infobase {tree host values} {
        Add::infobases $tree $host $values 
    }
    proc infobases {tree host values} {
        global default active_cluster
        toplevel .add
        wm title .add "Добавление информационной базы"
        ttk::label .add.lbl -image add_database_grey_64
        set frm [ttk::labelframe .add.frm -text "Добавление информационной базы" -labelanchor nw]
        
        label $frm.lbl_host -text "Адрес сервера баз даннных"
        entry  $frm.ent_host
        label $frm.lbl_db_user -text "Имя пользователя базы даннных"
        entry  $frm.ent_db_user
        label $frm.lbl_db_pass -text "Пароль"
        entry  $frm.ent_db_pass
        #$frm.ent_host insert end $host
        label $frm.lbl_locale -text "Язык базы данных"
        entry $frm.ent_locale 
        $frm.ent_locale  insert end $default(locale)
        label $frm.lbl_infobase_name -text "Имя информационной базы"
        entry  $frm.ent_infobase_name
        label $frm.lbl_base_name -text "Имя базы данных"
        entry  $frm.ent_base_name
        label $frm.lbl_base_type -text "Тип СУБД"
        set combo [ttk::combobox $frm.cb_base_type  -textvariable dbms -values $default(dbms)]]
        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_db_user -row 1 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_db_user -row 1 -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_db_pass -row 2 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_db_pass -row 2 -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_locale -row 3 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_locale -row 3 -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_infobase_name -row 4 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_infobase_name -row 4 -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_base_name -row 5 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_base_name -row 5  -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_base_type -row 6 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.cb_base_type -row 6 -column 1 -sticky nsew -padx 5 -pady 5
        #         grid $frm.lbl_host $frm.ent_host -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_db_user $frm.ent_db_user -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_db_pass $frm.ent_db_pass -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_locale $frm.ent_locale -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_infobase_name $frm.ent_infobase_name -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_base_name $frm.ent_base_name -sticky nwse -padx 5 -pady 5
        #         grid $frm.lbl_base_type $frm.cb_base_type -sticky nwse -padx 5 -pady 5
        #         
        grid columnconfigure $frm 0 -weight 1
        grid rowconfigure $frm 0 -weight 1
        
        set  active_cluster $values
        
        set frm_btn [frame .add.frm_btn -border 0]
        ttk::button $frm_btn.btn_ok -image add_grey_24 -command {
            #puts [RunCommand "" "cluster insert --host=[.add.frm.ent_host get] --port=[.add.frm.ent_port get] --name=[.add.frm.ent_cluster_name get] $host"]
            RunCommand "" "infobase create --create-database  \
            --name=[.add.frm.ent_infobase_name get] \
            --dbms=$dbms \
            --db-server=[.add.frm.ent_host get] \
            --db-name=[.add.frm.ent_base_name get] \
            --locale=[.add.frm.ent_locale get] \
            --db-user=[.add.frm.ent_db_user get] \
            --db-pwd=[.add.frm.ent_db_pass get] \
            --cluster=$active_cluster $host"
            #SaveCluster [.add.frm.ent_host get] [.add.frm.ent_port get]]
            #.frm_tree.tree insert "server::$host" end -id "er::$host" -text "$host" -values "$host"
            destroy .add
            #return $host
        }
        ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24 
        grid .add.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 .add.lbl  -side left
        #         pack $frm -padx 5 -pady 5 -expand true -fill x -side left
        #         pack $frm_btn -padx 5 -pady 5 -expand true -fill x
        pack  $frm_btn.btn_cancel  -side right
        pack  $frm_btn.btn_ok  -side right -padx 10                
        
    }
    
    proc cluster {tree host values} {
        global default
        toplevel .add
        set frm [ttk::labelframe .add.frm -text "Добавление кластера" -labelanchor nw]
        
        label $frm.lbl_host -text "Адрес основного сервера"
        entry  $frm.ent_host
        #$frm.ent_host insert end $host
        label $frm.lbl_port -text "Порт"
        entry $frm.ent_port 
        $frm.ent_port  insert end $default(port)
        label $frm.lbl_cluster_name -text "Название кластера"
        entry  $frm.ent_cluster_name
        
        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_cluster_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_cluster_name -row 2 -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]
        ttk::button $frm_btn.btn_ok -image add_grey_24 -command {
            puts [RunCommand "" "cluster insert --host=[.add.frm.ent_host get] --port=[.add.frm.ent_port get] --name=[.add.frm.ent_cluster_name get] $host"]
            
            #SaveCluster [.add.frm.ent_host get] [.add.frm.ent_port get]]
            #.frm_tree.tree insert "server::$host" end -id "er::$host" -text "$host" -values "$host"
            destroy .add
            #return $host
        }
        ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24 
        pack $frm $frm_btn -padx 5 -pady 5 -expand true -fill x
        pack  $frm_btn.btn_cancel  -side right
        pack  $frm_btn.btn_ok  -side right -padx 10                
        puts $host
    }
}
proc SaveMainServer {host port} {
    global dir
    set file [open [file join $dir(work) 1c_srv.cfg] "a+"]
    puts $file "$host:$port"
    close $file
    return "$host:$port"
}