# 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: myshow.tcl,v 1.6 2006/03/28 15:10:34 jfontain Exp $


package provide myshow [lindex {$Revision: 1.6 $} 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 myshow {
        variable thread
        set thread(busy) 0
        set thread(worker) [new worker]
    }
}
package require hashes


namespace eval myshow {

    array set data {
        updates 0
        0,label data 0,type dictionary 0,message {data or variable name}
        1,label raw 1,type dictionary 1,message {raw data value}
        2,label number 2,type real 2,message {data value as a number}
        3,label rate 3,type real 3,message {data increase, per second, average for the last polling period}
        pollTimes {10 5 20 30 60 120 300}
        switches {--daemon 0 --dsn 1 --host 1 --like 1 --password 1 --port 1 --status 0 --user 1 --variables 0}
        persistent 1 64Bits 1
        sort {0 increasing}
    }
    set file [open myshow.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file; unset 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
        variable statement
        variable extended

        if {![info exists options(--status)] && ![info exists options(--variables)]} {
            error {use either status or variables option}
        }
        if {[info exists options(--status)] && [info exists options(--variables)]} {
            error {use either status or variables option but not both}
        }
        if {[info exists options(--status)]} {
            set extended 1
            set statement "show status"
            set data(views) {{visibleColumns {0 1 2 3} sort {0 increasing}}}
            set data(identifier) myshow(status,
        } else {
            set extended 0
            set statement "show variables"
            set data(views) {{visibleColumns {0 1 2} sort {0 increasing}}}
            set data(identifier) myshow(variables,
        }
        catch {append statement " like '$options(--like)'"}                                                              ;# optional
        set connection(user) $::tcl_platform(user); catch {set connection(user) $options(--user)}
        catch {set connection(password) $options(--password)}
        if {[info exists options(--dsn)]} {                                               ;# ODBC mode id data source name specified
            if {[info exists options(--host)] || [info exists options(--port)]} {
                error {--host and --port options incompatible with ODBC mode}
            }
            set odbc 1
            set connection(dsn) $options(--dsn)
            append data(identifier) $connection(dsn))
        } else {
            if {[info exists options(--port)] && (![info exists options(--host)] || ($options(--host) eq "localhost"))} {
                error {--port option useless with local socket connection (localhost as host)}
            }
            set odbc 0
            catch {set connection(host) $options(--host)}
            catch {set connection(port) $options(--port)}
            set host localhost; catch {set host $options(--host)}
            append data(identifier) $host)
        }
        # in daemon mode, do not check connection and query so initialization never fails
        if {[info exists options(--daemon)]} return
        connect                                                                                                ;# may throw an error
        if {$odbc} {
            if {[info exists thread]} {
                worker::evaluate $thread(worker) "
                    $connection(name) statement $connection(name).query $statement; $connection(name).query execute
                    $connection(name).query drop
                "
            } else {
                $connection(name) statement $connection(name).query $statement; $connection(name).query execute
                $connection(name).query drop
            }
        } else {
            if {[info exists thread]} {
                worker::evaluate $thread(worker) "mysqlsel $connection(name) $statement"
            } else {
                mysqlsel $connection(name) $statement
            }
        }
    }

    proc connect {} {
        variable thread
        variable odbc
        variable connection

        if {$odbc} {
            set arguments [list $connection(dsn) $connection(user)]
            catch {lappend arguments $connection(password)}
            if {[info exists thread]} {
                worker::evaluate $thread(worker) {package require tclodbc 2}
                set connection(name) [worker::wait $thread(worker) "database odbc $arguments"]       ;# use a unique connection name
            } else {
                package require tclodbc 2                           ;# so that it works with both UNIX 2.2.1 et Windows 2.3 versions
                set connection(name) [eval database odbc $arguments]                                 ;# use a unique connection name
            }
        } else {
            set arguments [list -user $connection(user)]
            catch {lappend arguments -host $connection(host)}
            catch {lappend arguments -password $connection(password)}
            catch {lappend arguments -port $connection(port)}
            if {[info exists thread]} {
                worker::evaluate $thread(worker) {package require mysqltcl}                             ;# use a thread safe version
                set connection(name) [worker::wait $thread(worker) "mysqlconnect $arguments"]                     ;# do not hang GUI
            } else {
                package require mysqltcl
                set connection(name) [eval mysqlconnect $arguments]
            }
        }
    }

    proc update {} {
        variable thread

        if {[info exists thread]} {
            if {$thread(busy)} return
            set thread(busy) 1
        }
        getData
    }

    proc getData {{result {}} {errorInformation {}}} {
        variable thread
        variable odbc
        variable connection
        variable last
        variable data
        variable statement
        variable extended

        if {![info exists connection(name)] && [catch connect message]} {
            flashMessage "error: $message"
            resetData
            incr data(updates)
            return
        }
        set error 0
        if {[info exists thread]} {
            if {$result eq ""} {                                                                       ;# launch query in background
                if {$odbc} {
                    worker::evaluate $thread(worker)\
                        "$connection(name) statement $connection(name).query $statement; $connection(name).query execute; list 1"\
                        mystatus::getStatus
                } else {
                    worker::evaluate $thread(worker) "mysqlsel $connection(name) $statement; list 1" mystatus::getStatus
                }
                return                                       ;# this procedure is invoked back with a non-empty result (1) when done
            } elseif {$errorInformation ne ""} {                                                                 ;# an error occured
                set error 1
                set message $result
            }                                                                           ;# else the query was executed with no error
        } else {
            if {$odbc} {
                set error [catch {\
                    $connection(name) statement $connection(name).query $statement; $connection(name).query execute\
                } message]
            } else {
                set error [catch {mysqlsel $connection(name) $statement} message]
            }
        }
        set result {}
        if {$error} {                                                                                     ;# problem reaching server
            flashMessage "error: $message"
            resetData
        } else {
            set clock [expr {[clock clicks -milliseconds] / 1000.0}]                                       ;# store clock in seconds
            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(name).query fetch"]
                    } else {
                        set list [worker::evaluate $thread(worker) "mysqlnext $connection(name)"]
                    }
                } else {
                    if {$odbc} {
                        set list [$connection(name).query fetch]
                    } else {
                        set list [mysqlnext $connection(name)]
                    }
                }
                if {[llength $list] == 0} break
                set variable [string trim [lindex $list 0]]
                set value [string trim [lindex $list 1]]
                if {[catch {set row [hash64::string $variable 1]} message]} {                                     ;# repeatable mode
                    flashMessage "warning: duplicate row ($variable) removed: $message"                       ;# should be very rare
                    continue
                }
                if {![info exists data($row,0)]} {
                    set data($row,0) $variable
                }
                set data($row,1) $value
                if {[string is double -strict $value]} {
                    set data($row,2) $value
                    if {$extended} {
                        set data($row,3) ?                                                  ;# handle missing last data, divide by 0
                        # can wrap around, so force 32 bit integers subtractions (valid on 32 and 64 bit Tcl platforms)
                        catch {set data($row,3) [format %.2f [expr {(($value - $last($row)) & 0xFFFFFFFF) / $period}]]}
                        set last($row) $value
                    }
                } else {
                    set data($row,2) ?
                    if {$extended} {
                        set data($row,3) ?
                    }
                }
            }
        }
        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(name).query drop"}
            } else {
                catch {$connection(name).query drop}
            }
        }
        if {[info exists thread]} {
            set thread(busy) 0
        }
        incr data(updates)
    }

    proc resetData {} {
        variable last
        variable data
        variable extended

        unset -nocomplain last
        foreach name [array names data *,1] {set data($name) {}}
        foreach name [array names data *,2] {set data($name) ?}
        if {$extended} {
            foreach name [array names data *,3] {set data($name) ?}
        }
    }

    proc terminate {} {
        variable thread
        variable connection

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

}
