1# $Id$
2
3namespace eval stats {}
4
5set ::NS(stats) http://jabber.org/protocol/stats
6
7
8proc stats::open_window {} {
9    variable lastline
10    variable f
11
12    set w .stats
13
14    if {[winfo exists $w]} {
15	return
16    }
17
18
19    add_win $w -title [::msgcat::mc "Statistics monitor"] \
20	-tabtitle [::msgcat::mc "Statistics"] \
21	-class Stats \
22	-raise 1
23	#-raisecmd [list focus $w.tree] \
24
25    set sw [ScrolledWindow $w.sw]
26    pack $sw -side top -fill both -expand yes
27    set sf [ScrollableFrame $w.sf]
28    $sw setwidget $sf
29
30    set f [$sf getframe]
31
32    set i 0
33    foreach label [list [::msgcat::mc "JID"] \
34			[::msgcat::mc "Node"] \
35			[::msgcat::mc "Name "] \
36			[::msgcat::mc "Value"] \
37			[::msgcat::mc "Units"]] {
38	set l [label $f.titlelabel$i -text $label]
39	grid $l -row 0 -column $i -sticky w
40
41	incr i
42    }
43
44    set i 7
45    set l [label $f.titlelabel$i -text [::msgcat::mc "Timer"]]
46    grid $l -row 0 -column $i -sticky w -columnspan 2
47
48    set lastline 1
49}
50
51proc stats::add_line {jid node name} {
52    variable data
53    variable lastline
54    variable f
55
56    set n $lastline
57    incr lastline
58
59    set l [label $f.ljid$n -text $jid]
60    grid $l -row $n -column 0 -sticky w
61
62    set l [label $f.lnode$n -text $node]
63    grid $l -row $n -column 1 -sticky w
64
65    set l [label $f.lname$n -text $name]
66    grid $l -row $n -column 2 -sticky w
67
68    set l [label $f.lvalue$n \
69	       -textvariable [namespace current]::data(value,$jid,$node,$name)]
70    grid $l -row $n -column 3 -sticky e
71
72    set l [label $f.lunits$n \
73	       -textvariable [namespace current]::data(units,$jid,$node,$name)]
74    grid $l -row $n -column 4 -sticky w
75
76    set b [button $f.brequest$n -text [::msgcat::mc "Request"] \
77	       -command [list [namespace current]::request_value \
78			     $jid $node $name]]
79    grid $b -row $n -column 5 -sticky w
80
81    set b [button $f.bremove$n -text [::msgcat::mc "Remove"] \
82	       -command [list [namespace current]::remove_line \
83			     $n]]
84    grid $b -row $n -column 6 -sticky w
85
86    set s [Spinbox $f.spin$n 0 1000000000 1 \
87		   [namespace current]::data(tmpperiod,$jid,$node,$name) \
88		   -width 4]
89    trace variable [namespace current]::data(tmpperiod,$jid,$node,$name) w \
90	  [list [namespace current]::unset_timer $n $jid $node $name]
91    grid $s -row $n -column 7 -sticky w
92
93    catch {unset data(period,$jid,$node,$name)}
94
95    set b [button $f.bsettimer$n -text [::msgcat::mc "Set"] \
96	       -relief raised \
97	       -command [list [namespace current]::toggle_timer \
98			     $n $jid $node $name]]
99    grid $b -row $n -column 8 -sticky w
100
101}
102
103proc stats::query_list {xlib jid node args} {
104    set vars {}
105    if {$node != ""} {
106	lappend vars node $node
107    }
108
109    if {$xlib == ""} {
110	set xlib [lindex [connections] 0]
111    }
112
113    ::xmpp::sendIQ $xlib get \
114	-query [::xmpp::xml::create query \
115			-xmlns $::NS(stats) \
116			-attrs $vars] \
117	-to $jid \
118	-command [list [namespace current]::recv_query_list_result $jid $node]
119}
120
121proc stats::recv_query_list_result {jid node res child} {
122    variable data
123
124    if {![cequal $res ok]} {
125	return
126    }
127
128    open_window
129
130    ::xmpp::xml::split $child tag xmlns attrs cdata subels
131
132    foreach item $subels {
133	::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
134
135	if {$stag == "stat"} {
136	    set name [::xmpp::xml::getAttr $sattrs name]
137	    add_line $jid $node $name
138	}
139    }
140}
141
142proc stats::request_value {jid node name} {
143    set vars {}
144    if {$node != ""} {
145	lappend vars node $node
146    }
147
148    ::xmpp::sendIQ [lindex [connections] 0] get \
149	-query [::xmpp::xml::create query \
150			-xmlns $::NS(stats) \
151			-attrs $vars \
152			-subelement [::xmpp::xml::create stat \
153					    -attrs [list name $name]]] \
154	-to $jid \
155	-command [list [namespace current]::recv_values_result $jid $node]
156}
157
158proc stats::recv_values_result {jid node res child} {
159    variable data
160
161    if {![cequal $res ok]} {
162	return
163    }
164
165    open_window
166
167    ::xmpp::xml::split $child tag xmlns attrs cdata subels
168
169    foreach item $subels {
170	::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
171
172	if {$stag == "stat"} {
173	    set name  [::xmpp::xml::getAttr $sattrs name]
174	    set value [::xmpp::xml::getAttr $sattrs value]
175	    set units [::xmpp::xml::getAttr $sattrs units]
176
177	    foreach sitem $ssubels {
178		::xmpp::xml::split $sitem sstag ssxmlns ssattrs sscdata sssubels
179		if {$sstag == "error"} {
180		    set error [error_to_string \
181				   [list [::xmpp::xml::getAttr $ssattrs code] \
182					 $sscdata]]
183		    break
184		}
185	    }
186
187	    if {[info exists error]} {
188		set data(value,$jid,$node,$name) $error
189		set data(units,$jid,$node,$name) error
190	    } else {
191		set data(value,$jid,$node,$name) $value
192		set data(units,$jid,$node,$name) $units
193	    }
194	}
195    }
196}
197
198
199proc stats::remove_line {n} {
200    variable f
201
202    foreach slave [grid slaves $f -row $n] {
203	destroy $slave
204    }
205}
206
207proc stats::unset_timer {n jid node name args} {
208    variable data
209    variable f
210
211    if {[info exists data(period,$jid,$node,$name)]} {
212	unset data(period,$jid,$node,$name)
213	$f.bsettimer$n configure -relief raised
214    }
215}
216
217proc stats::toggle_timer {n jid node name} {
218    variable data
219    variable f
220
221    if {![info exists data(period,$jid,$node,$name)]} {
222	if {[string is integer -strict $data(tmpperiod,$jid,$node,$name)] && \
223		$data(tmpperiod,$jid,$node,$name) > 0} {
224	    set data(period,$jid,$node,$name) $data(tmpperiod,$jid,$node,$name)
225	    $f.bsettimer$n configure -relief sunken
226
227	    timer $n $jid $node $name
228	}
229    } else {
230	unset data(period,$jid,$node,$name)
231	$f.bsettimer$n configure -relief raised
232    }
233}
234
235proc stats::timer {n jid node name} {
236    variable data
237    variable f
238
239    if {![winfo exists $f.spin$n]} return
240
241    request_value $jid $node $name
242
243    if {![info exists data(period,$jid,$node,$name)]} return
244
245    set p $data(period,$jid,$node,$name)
246
247    after cancel \
248	[list [namespace current]::timer $n $jid $node $name]
249    if {$p > 0 && [winfo exists $f.spin$n]} {
250	after [expr {$p * 1000}] \
251	    [list [namespace current]::timer $n $jid $node $name]
252    }
253}
254
255
256
257proc stats::setup_menu {} {
258    catch {
259        set m [.mainframe getmenu admin]
260
261        $m add command -label [::msgcat::mc "Open statistics monitor"] \
262	    -command [namespace current]::open_window
263    }
264}
265hook::add finload_hook [namespace current]::stats::setup_menu
266
267stats::setup_menu
268
269
270hook::add postload_hook \
271    [list disco::browser::register_feature_handler $::NS(stats) \
272	 [namespace current]::stats::query_list -node 1 \
273	  -desc [list * [::msgcat::mc "Service statistics"]]]
274
275