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