1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
# copyright (C) 1997-2005 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.15 2005/01/02 00:45:07 jfontain Exp $
package provide instance [lindex {$Revision: 1.15 $} 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)
}
}
|
