- Timestamp:
- Sep 2, 2010, 7:20:04 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/bugreport.tcl
r1868 r1904 3 3 # 4 4 # This redefines the usual Tcl bgerror command to install a nicer 5 # looking bug handler. 5 # looking bug handler. Bug reports can be submitted back to a 6 # HUBzero-based site as support tickets. Additional information 7 # can be obtained by defining procedures as bugreport::instrumented 8 # proc (captures entrance/exit from proc) and by calling 9 # bugreport::remark with extra info along the way. 6 10 # ====================================================================== 7 11 # AUTHOR: Michael McLennan, Purdue University … … 25 29 26 30 namespace eval Rappture::bugreport { 27 # details from the current trouble report 31 # details from the current trouble report, which user may decide to submit 28 32 variable details 33 34 # status from bugreport::instrumented/remark in case a bug occurs 35 variable extraStack "" 36 variable extraInfo "" 29 37 30 38 # assume that if there's a problem launching a job, we should know it 31 39 variable reportJobFailures 1 40 41 # submit these kinds of tickets by default 42 variable settings 43 set settings(user) $::tcl_platform(user) 44 set settings(type) "automatic" 45 set settings(group) "" 46 set settings(category) "Rappture" 32 47 } 33 48 … … 40 55 # ---------------------------------------------------------------------- 41 56 proc Rappture::bugreport::install {} { 42 proc ::bgerror {err} { ::Rappture::bugreport::activate $err }57 ::proc ::bgerror {err} { ::Rappture::bugreport::activate $err } 43 58 } 44 59 … … 53 68 global env errorInfo 54 69 variable details 70 variable settings 55 71 56 72 if {"@SHOWDETAILS" == $err} { … … 103 119 .bugreport.details.info.text configure -state normal 104 120 .bugreport.details.info.text delete 1.0 end 105 .bugreport.details.info.text insert end " USER: $ details(login)\n"121 .bugreport.details.info.text insert end " USER: $settings(user)\n" 106 122 .bugreport.details.info.text insert end "HOSTNAME: $details(hostname)\n" 123 .bugreport.details.info.text insert end "PLATFORM: $details(platform)\n" 124 .bugreport.details.info.text insert end "CATEGORY: $details(category)\n" 107 125 .bugreport.details.info.text insert end " TOOL: $details(referrer)\n" 108 126 .bugreport.details.info.text insert end " SESSION: $details(session)\n" 109 .bugreport.details.info.text insert end "CATEGORY: $details(category)\n"110 127 .bugreport.details.info.text insert end " SUMMARY: $details(summary)\n" 111 128 .bugreport.details.info.text insert end "---------\n" … … 139 156 # reset the grab in case it's hosed 140 157 Rappture::grab::reset 158 } 159 160 # ---------------------------------------------------------------------- 161 # USAGE: instrumented <what> <name> <arglist> <body> 162 # 163 # Used instead of the usual Tcl "proc" or itcl::body to define a 164 # procedure that will automatically register information about its 165 # execution in the bugreport mechanism. The <what> parameter should 166 # be either "proc" or "itcl::body" or something like that. When the 167 # procedure starts, it pushes its call information onto the stack, 168 # then invokes the procedure body, then adds information about the 169 # return code. 170 # ---------------------------------------------------------------------- 171 proc Rappture::bugreport::instrumented {what name arglist body} { 172 set avals "" 173 foreach term $arglist { 174 set aname [lindex $term 0] 175 append avals "\$$aname " 176 } 177 uplevel [list $what $name $arglist [format { 178 Rappture::bugreport::remark -enter "PROC %s: %s" 179 set __status [catch {%s} __result] 180 Rappture::bugreport::remark -leave "PROC %s: code($__status) => $__result" 181 switch -- $__status { 182 0 - 2 { 183 return $__result 184 } 185 3 { 186 set __result "invoked \"break\" outside of a loop" 187 } 188 4 { 189 set __result "invoked \"continue\" outside of a loop" 190 } 191 } 192 error $__result $::errorInfo 193 } $name $avals $body $name]] 194 } 195 196 # ---------------------------------------------------------------------- 197 # USAGE: remark ?-enter|-leave? <message> 198 # 199 # Adds the <message> to the current "extraInfo" being kept about the 200 # program. This adds useful debugging info to the report that gets 201 # sent back when an unexpected error is trapped. The -enter and -leave 202 # options are used when a bugreport::instrumented proc starts/exits to 203 # change the indent level for future messages. 204 # ---------------------------------------------------------------------- 205 proc Rappture::bugreport::remark {args} { 206 variable extraStack 207 variable extraInfo 208 209 if {[llength $args] > 1} { 210 set option [lindex $args 0] 211 set args [lrange $args 1 end] 212 switch -- $option { 213 -enter { 214 if {[llength $args] != 1} { 215 error "wrong # args: should be \"remark -enter message\"" 216 } 217 set mesg [lindex $args 0] 218 if {[llength $extraStack] == 0} { 219 set extraInfo "" 220 } 221 append extraInfo [remark -indent ">> $mesg"] 222 set extraStack [linsert $extraStack 0 $mesg] 223 return 224 } 225 -leave { 226 if {[llength $args] != 1} { 227 error "wrong # args: should be \"remark -leave message\"" 228 } 229 set mesg [lindex $args 0] 230 set extraStack [lrange $extraStack 1 end] 231 append extraInfo [remark -indent "<< $mesg"] 232 return 233 } 234 -indent { 235 if {[llength $args] != 1} { 236 error "wrong # args: should be \"remark -indent message\"" 237 } 238 } 239 default { 240 error "bad option \"$option\": should be -enter, -leave, -indent" 241 } 242 } 243 } 244 set mesg [lindex $args 0] 245 set nlevel [llength $extraStack] 246 set indent [string repeat { } [expr {2*$nlevel}]] 247 foreach line [split $mesg \n] { 248 append extraInfo "$indent$line\n" 249 set prefix " " 250 } 141 251 } 142 252 … … 204 314 global errorInfo tcl_platform 205 315 variable details 316 variable settings 317 variable extraInfo 206 318 207 319 # … … 209 321 # submitted, so we can show the user. 210 322 # 211 set stackTrace "$err\n---------\n$errorInfo "323 set stackTrace "$err\n---------\n$errorInfo\n---------\n$extraInfo" 212 324 if {![regexp {^([^\n]+)\n} $stackTrace match summary]} { 213 325 if {[string length $stackTrace] == 0} { … … 224 336 set category "Tools" 225 337 } else { 226 set category "Rappture"338 set category $settings(category) 227 339 } 228 340 … … 265 377 set details(category) $category 266 378 set details(stackTrace) $stackTrace 267 set details(login) $tcl_platform(user)268 379 set details(hostname) [info hostname] 269 380 set details(session) [Rappture::Tool::resources -session] 270 set details(referrer) "tool \"[Rappture::Tool::resources -appname]\"" 381 set details(referrer) [Rappture::Tool::resources -appname] 382 set details(platform) [array get tcl_platform] 271 383 } 272 384 … … 282 394 proc Rappture::bugreport::send {} { 283 395 variable details 396 variable settings 284 397 285 398 package require http … … 298 411 no_html 1 \ 299 412 report $report \ 300 login $details(login) \301 413 sesstoken $details(session) \ 302 414 hostname $details(hostname) \ 415 os $settings(platform) \ 303 416 category $details(category) \ 304 417 summary $details(summary) \ 305 418 referrer $details(referrer) \ 419 login $settings(user) \ 420 group $settings(group) \ 421 type $settings(type) \ 306 422 ] 307 423
Note: See TracChangeset
for help on using the changeset viewer.