# 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: instance.tcl,v 1.16 2006/01/28 19:16:59 jfontain Exp $

package provide instance [lindex {$Revision: 1.16 $} 1]


namespace eval instance {                                                                ;# internal database module instance module

    # use an empty index column otherwise cell labels in viewers would contain and display the first stored data cell value
    # poll time is 0 since user manually refreshes and this is not an asynchronous module
    array set data {
        updates 0
        0,label {} 0,type ascii 0,message {} 0,0 {}
        pollTimes 0
        switches {-anchors 1 -arguments 1 -cellsdata 1 -entries 1 -identifier 1 -instance 1 -messages 1 -module 1 -types 1}
    }                                       ;# note: arguments are wrapped in a list so that the first character of value is not a -

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable data
        variable cell
        variable instance
        variable columns

        foreach switch {-entries -types -messages -anchors} {                                              ;# do some validity check
            if {![info exists options($switch)]} {error "no $switch data"}
            if {![info exists length]} {set length [llength $options($switch)]}                    ;# initialize common lists length
            if {[llength $options($switch)] != $length} {
                error "$switch data list length is [llength $options($switch)] instead of $length"
            }
        }
        set instance $options(-instance)
        foreach entry $options(-entries) type $options(-types) message $options(-messages) anchor $options(-anchors) {
            set module($entry,type) $type                                ;# entry is the data column number from the original module
            set module($entry,message) $message
            if {[string length $anchor] > 0} {
                set module($entry,anchor) $anchor
            }
        }
        set columns {}
        set column 0
        foreach {row entry label comment} $options(-cellsdata) {                                      ;# cells with database history
            incr column
            if {[string length $comment] > 0} {                                             ;# use user-defined comment if it exists
                set data($column,label) $comment
            } else {                                                                               ;# instead of original cell label
                # prune module identifier header for data stored with moodss before 17.11 or moomps before 2.13
                regsub "^$options(-module): " $label {} data($column,label)
            }
            set data($column,type) [set type $module($entry,type)]
            set data($column,message) $module($entry,message)
            catch {set data($column,anchor) $module($entry,anchor)}                                                      ;# optional
            set cell($column) [list $row $entry]
            # initialize cells values so that incremental update works (see update{}):
            switch $type {
                integer - real {set data(0,$column) ?}
                default {set data(0,$column) {}}
            }
            lappend columns $column
        }
        set data(views) [list [list indices $columns swap 1]]    ;# swap display so that entries descriptions are in leftmost column
        set data(identifier) $options(-module)
        catch {set data(identifier) $options(-identifier)}                                   ;# use original identifier if available
    }

    # from cell row and column (in this module data), return row and entry, which, along with the instance number, allow accessing
    # cell history from database
    proc mapping {row column} {                                                                                   ;# row is always 0
        variable cell
        return $cell($column)
    }

    # when asked to be updated, ask the current values (as determined by the database instances container cursor) for the
    # monitored cells
    proc update {} {
        variable cell
        variable instance
        variable data
        variable columns

        foreach column $columns {
            foreach {row entry} $cell($column) {}
            set value [lindex [cellHistory $instance $row $entry 1] end]                   ;# retrieve last sample, ignore timestamp
            if {[string length $value] == 0} {
                switch $data($column,type) {
                    integer - real {
                        set value ?                                                     ;# convert numeric null values from database
                    }
                }
            }
            set data(0,$column) $value
        }
        incr data(updates)
    }

}
