1: ### 2: ## debug ?-option value? ?-option value?... 3: ## A command to make debugging more convenient. Print strings, arrays 4: ## and the values of variables as specified by the arguments. 5: ## 6: ## Also allows the setting of an array called debug which will pick up 7: ## options for all debug commands. 8: ## 9: ## We create this command in the ::request namespace because we want the 10: ## user to be able to use the debug array without actually having to set 11: ## it at the global level. 12: ## 13: ## Options: 14: ## -subst <on|off> - Each word should be considered a variable and subst'd. 15: ## -separator <string> - A text string that goes between each variable. 16: ## -ip <ip address> - A list of IP addresses to display to. 17: ### 18: 19: proc debug {args} { 20: ## If they've turned off debugging, we don't do anything. 21: if {[info exists ::RivetUserConf(Debug)] && !$::RivetUserConf(Debug)} { 22: return 23: } 24: 25: ## We want to save the REMOTE_ADDR for any subsequent calls to debug. 26: if {![info exists ::RivetUserConf(REMOTE_ADDR)]} { 27: set REMOTE_ADDR [env REMOTE_ADDR] 28: set ::RivetUserConf(REMOTE_ADDR) $REMOTE_ADDR 29: } 30: 31: 32: ## Set some defaults for the options. 33: set data(subst) 0 34: set data(separator) <br> 35: 36: ## Check RivetUserConf for globally set options. 37: if {[info exists ::RivetUserConf(DebugIp)]} { 38: set data(ip) $::RivetUserConf(DebugIp) 39: } 40: if {[info exists ::RivetUserConf(DebugSubst)]} { 41: set data(subst) $::RivetUserConf(DebugSubst) 42: } 43: if {[info exists ::RivetUserConf(DebugSeparator)]} { 44: set data(separator) $::RivetUserConf(DebugSeparator) 45: } 46: 47: import_keyvalue_pairs data $args 48: 49: if {[info exists data(ip)]} { 50: set can_see 0 51: foreach ip $data(ip) { 52: if {[string match $data(ip)* $::RivetUserConf(REMOTE_ADDR)]} { 53: set can_see 1 54: break 55: } 56: } 57: if {!$can_see} { return } 58: } 59: 60: if {[string tolower $data(subst)] != "on"} { 61: html [join $data(args)] 62: return 63: } 64: 65: set lastWasArray 0 66: foreach varName $data(args) { 67: upvar $varName var 68: if {[array exists var]} { 69: parray $varName 70: set lastWasArray 1 71: } elseif {[info exists var]} { 72: if {!$lastWasArray} { 73: html $data(separator) 74: } 75: html $var 76: set lastWasArray 0 77: } else { 78: if {!$lastWasArray} { 79: html $data(separator) 80: } 81: html $varName 82: set lastWasArray 0 83: } 84: } 85: } |