# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: myhealth.tcl,v 1.32 2006/03/28 15:10:34 jfontain Exp $


package provide myhealth [lindex {$Revision: 1.32 $} 1]
package require miscellaneous 1
if {![catch {package require Thread 2.5}]} {           ;# use threads so that core is not blocked on connection problems with server
    package require stooop 4.1
    namespace import stooop::*
    package require threads 1
    namespace eval myhealth {
        variable thread
        set thread(busy) 0
        set thread(worker) [new worker]
    }
}

namespace eval myhealth {

    array set data {
        updates 0
        0,label display 0,type ascii 0,message {per hour values are calculated for the last poll period using the absolute values from the server, and only for variables that make sense (otherwise a ? is displayed in the column)}
        0,0 absolute 1,0 {per hour}
        1,label version 1,type ascii 1,message {The version number for the server.} 1,1 {}
        2,label uptime 2,type dictionary 2,message {How many seconds the server has been up.} 1,2 {}
        3,label {slow queries} 3,type real 3,message {Number of queries that have taken more than long_query_time.}
        4,label {remaining connections} 4,type integer 4,message {Number of simultaneous connections left before the number of connections reaches the maximum number of simultaneous clients allowed (as defined by the max_connections variable).} 1,4 ?
        5,label {select scan} 5,type real 5,message {Number of joins where we scanned the first table.}
        6,label {select full join} 6,type real 6,message {Number of joins without keys (Should be 0).}
        7,label {aborted connects} 7,type real 7,message {Number of tries to connect to the MySQL server that failed.}
        8,label {created tmp disk tables} 8,type real 8,message {Number of implicit temporary tables on disk created while executing statements.}
        9,label {created tmp files} 9,type real 9,message {How many temporary files mysqld has created.}
        10,label {key efficiency} 10,type real 10,message {Efficiency of the key cache in %.} 1,10 ?
        pollTimes {20 10 30 60 120 300}
        switches {--dsn 1 --host 1 --password 1 --port 1 --user 1}
        persistent 1
        views {{visibleColumns {0 1 2 3 4 5 6 7 8 9 10} swap 1}}
    }
    # variable name to column mapping for MySQL changing variables:
    array set nameColumn {
        Uptime 2 Slow_queries 3 Select_scan 5 Select_full_join 6 Aborted_connects 7 Created_tmp_disk_tables 8 Created_tmp_files 9
    }
    # MySQL variables needed for indicators calculations
    array set needed {max_connections {} Threads_connected {} Key_read_requests {} Key_reads {}}
    set file [open myhealth.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file
    if {[info exists thread]} {                     ;# show on last line of this module help window that we are running with threads
        regsub -nocase </body> $data(helpText) "<p><i>(currently running in threaded mode)</i>\n\\0" data(helpText)
    }

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable thread
        variable odbc
        variable connection
        variable data

        set user $::tcl_platform(user)                                                                                 ;# by default
        catch {set user $options(--user)}
        if {[info exists options(--dsn)]} {                                               ;# ODBC mode id data source name specified
            set odbc 1
            if {[info exists options(--host)] || [info exists options(--port)]} {
                error {--host and --port options incompatible with --dsn option}
            }
            set arguments [list $options(--dsn)]
            catch {lappend arguments $user}
            catch {lappend arguments $options(--password)}
            if {[info exists thread]} {
                worker::evaluate $thread(worker) {package require tclodbc 2}
                set connection [worker::wait $thread(worker) "database odbc $arguments"]             ;# use a unique connection name
                set list [worker::evaluate $thread(worker) "$connection {show variables like 'version'}"]
            } else {
                package require tclodbc 2                           ;# so that it works with both UNIX 2.2.1 et Windows 2.3 versions
                set connection [eval database odbc $arguments]                                       ;# use a unique connection name
                set list [$connection {show variables like 'version'}]
            }
            set data(identifier) myhealth($options(--dsn))
            set version [lindex [lindex $list 0] 1]
        } else {
            set odbc 0
            if {[info exists options(--port)] && (![info exists options(--host)] || [string equal $options(--host) localhost])} {
                error {--port option useless with local socket connection (localhost as host)}
            }
            set arguments {}
            catch {lappend arguments -host $options(--host)}
            catch {lappend arguments -user $user}
            catch {lappend arguments -password $options(--password)}
            catch {lappend arguments -port $options(--port)}
            if {[info exists thread]} {
                worker::evaluate $thread(worker) {package require mysqltcl}
                set connection [worker::wait $thread(worker) "mysqlconnect $arguments"]                           ;# do not hang GUI
                set host [worker::evaluate $thread(worker) "lindex \[mysqlinfo $connection host\] 0"]
                # do not retrieve version in background as it is unlikely to fail if connection was established:
                set list [worker::evaluate $thread(worker) "mysqlsel $connection {show variables like 'version'} -flatlist"]
            } else {
                package require mysqltcl
                set connection [eval mysqlconnect $arguments]
                set host [lindex [mysqlinfo $connection host] 0]           ;# work around mysqltcl 3 return value: "host via TCP/IP"
                set list [mysqlsel $connection {show variables like 'version'} -flatlist]
            }
            set data(identifier) myhealth($host)
            set version [lindex $list 1]
        }
        scan $version %u.%u.%u major minor subMinor
        switch $major {
            3 {
                if {$minor != 23} {error "cannot monitor a server version 3.$minor"}
                if {$subMinor < 33} {error {cannot monitor a server below version 3.23.33 in the 3.23 series}}
            }
            4 - 5 {
                if {$minor > 1} {error "cannot monitor a server version $major.$minor"}
            }
            default {
                error "cannot monitor a server version $major"
            }
        }
        set data(0,1) $version
    }

    proc getStatus {{result {}} {errorInformation {}}} {
        variable thread
        variable odbc
        variable connection
        variable last
        variable data
        variable needed
        variable nameColumn

        set error 0
        if {[info exists thread]} {
            if {[string length $result] == 0} {                                                        ;# launch query in background
                if {$odbc} {
                    worker::evaluate $thread(worker)\
                        "$connection statement $connection.query {show status}; $connection.query execute; list 1"\
                        myhealth::getStatus
                } else {
                    worker::evaluate $thread(worker) "mysqlsel $connection {show status}; list 1" myhealth::getStatus
                }
                return                                       ;# this procedure is invoked back with a non-empty result (1) when done
            } elseif {[string length $errorInformation] > 0} {                                                   ;# an error occured
                set error 1
                set message $result
            }                                                                           ;# else the query was executed with no error
        } else {
            if {$odbc} {
                set error [catch {$connection statement $connection.query {show status}; $connection.query execute} message]
            } else {
                set error [catch {mysqlsel $connection {show status}} message]
            }
        }
        if {$error} {                                                                                     ;# problem reaching server
            flashMessage "error: $message"
            invalid
        } else {
            set clock [expr {[clock clicks -milliseconds] / 3600000.0}]                                      ;# store clock in hours
            catch {set period [expr {$clock - $last(clock)}]}
            set last(clock) $clock
            while {1} {
                if {[info exists thread]} {
                    # no need for background work since the whole data is already in this client (mysql_store_result() used):
                    if {$odbc} {
                        set list [worker::evaluate $thread(worker) "$connection.query fetch"]
                    } else {
                        set list [worker::evaluate $thread(worker) "mysqlnext $connection"]
                    }
                } else {
                    if {$odbc} {
                        set list [$connection.query fetch]
                    } else {
                        set list [mysqlnext $connection]
                    }
                }
                if {[llength $list] == 0} break
                foreach {variable value} $list {}
                if {[info exists needed($variable)]} {
                    set needed($variable) $value                                                ;# for indicators calculations below
                }
                if {[catch {set column $nameColumn($variable)}]} continue                               ;# variable is not displayed
                if {[string equal $variable Uptime]} {
                    set data(0,$column) [formattedTime $value]
                    set data(1,$column) {}
                } else {
                    if {[string equal $data($column,type) real]} {                                 ;# required for per second values
                        set data(0,$column) $value                                   ;# display as is as it really may be an integer
                        if {[info exists period]} {
                            # can wrap around, so force 32 bit integers subtractions (valid on 32 and 64 bit Tcl platforms)
                            set data(1,$column) [format %.2f [expr {(($value - $last($column)) & 0xFFFFFFFF) / $period}]]
                        } else {
                            set data(1,$column) ?
                        }
                        set last($column) $value
                    } else {
                        set data(0,$column) $value
                    }
                }
            }
        }
        if {$odbc} {
            # ignore connection errors at this point (they will be reported at next poll):
            if {[info exists thread]} {
                catch {worker::evaluate $thread(worker) "$connection.query drop"}
            } else {
                catch {$connection.query drop}
            }
        }
        if {!$error} getVariables                                                            ;# continue retrieving more needed data
    }

    proc getVariables {{result {}} {errorInformation {}}} {
        variable thread
        variable odbc
        variable connection
        variable data
        variable needed
        variable nameColumn

        set error 0
        if {[info exists thread]} {
            if {[string length $result] == 0} {                                                        ;# launch query in background
                if {$odbc} {
                    worker::evaluate $thread(worker)\
                        "$connection statement $connection.query {show variables}; $connection.query execute; list 1"\
                        myhealth::getVariables
                } else {
                    worker::evaluate $thread(worker) "mysqlsel $connection {show variables}; list 1" myhealth::getVariables
                }
                return                                       ;# this procedure is invoked back with a non-empty result (1) when done
            } elseif {[string length $errorInformation] > 0} {                                                   ;# an error occured
                set error 1
                set message $result
            }                                                                           ;# else the query was executed with no error
        } else {
            if {$odbc} {
                set error [catch {$connection statement $connection.query {show variables}; $connection.query execute} message]
            } else {
                set error [catch {mysqlsel $connection {show variables}} message]
            }
        }
        if {$error} {                                                                                     ;# problem reaching server
            flashMessage "error: $message"
            invalid
        } else {
            while {1} {
                if {[info exists thread]} {
                    # no need for background work since the whole data is already in this client (mysql_store_result() used):
                    if {$odbc} {
                        set list [worker::evaluate $thread(worker) "$connection.query fetch"]
                    } else {
                        set list [worker::evaluate $thread(worker) "mysqlnext $connection"]
                    }
                } else {
                    if {$odbc} {
                        set list [$connection.query fetch]
                    } else {
                        set list [mysqlnext $connection]
                    }
                }
                if {[llength $list] == 0} break
                foreach {variable value} $list {}
                if {[info exists needed($variable)]} {
                    set needed($variable) $value                                                ;# for indicators calculations below
                }
                if {[catch {set column $nameColumn($variable)}]} continue                               ;# variable is not displayed
                set data(0,$column) $value
            }
        }
        if {$odbc} {
            # ignore connection errors at this point (they will be reported at next poll):
            if {[info exists thread]} {
                catch {worker::evaluate $thread(worker) "$connection.query drop"}
            } else {
                catch {$connection.query drop}
            }
        }
        if {!$error} {
            set data(0,4) [expr {$needed(max_connections) - $needed(Threads_connected)}]
            if {$needed(Key_read_requests) == 0} {
                set data(0,10) ?                                                                               ;# no keyed reads yet
            } else {
                set data(0,10) [format %.1f [expr {100 - ((double($needed(Key_reads)) / $needed(Key_read_requests)) * 100)}]]
            }
            if {[info exists thread]} {
                set thread(busy) 0
            }
            incr data(updates)                                       ;# done retrieving and calculating whole data: validate display
        }
    }

    proc update {} {
        variable thread

        if {[info exists thread]} {
            if {$thread(busy)} return
            set thread(busy) 1
        }
        getStatus                                                                                           ;# start retrieving data
    }

    proc invalid {} {                                                                              ;# update data when it is invalid
        variable thread
        variable last
        variable data

        if {[info exists thread]} {
            set thread(busy) 0
        }
        catch {unset last}
        foreach name [array names data *,label] {
            scan $name %u column
            if {$column == 0} continue                                                                             ;# headers column
            switch $data($column,type) {
                integer - real {
                    set data(0,$column) ?
                    set data(1,$column) ?                                                          ;# required for per second values
                }
                default {
                    set data(0,$column) {}
                }
            }
        }
        incr data(updates)
    }

    proc terminate {} {
        variable thread
        variable odbc
        variable connection

        if {![info exists connection]} return                                        ;# connection may have failed in initialization
        if {$odbc} {
            if {[info exists thread]} {
                worker::evaluate $thread(worker) "$connection disconnect" list            ;# try to disconnect while ignoring errors
                delete $thread(worker)
            } else {
                catch {$connection disconnect}
            }
        } else {
            if {[info exists thread]} {
                worker::evaluate $thread(worker) "mysqlclose $connection" list      ;# try to close connection while ignoring errors
                delete $thread(worker)
            } else {
                catch {mysqlclose $connection}
            }
        }
    }

}
