# a little server to inspect local variable state over httpd
#
# usage:
# - source this script in some app
# - do "hpeek::start 8056" to activate it
# - do "vwait forever" if the app would exit otherwise
# - point your browser to URL http://localhost:8056/
#
# inspired by Harold Kaplan's "DustMote"
namespace eval hpeek {
set about {a little server to inspect local variable state over httpd}
set cvs {$Id: 9154,v 1.5 2005-04-01 06:00:42 jcw Exp $}
namespace export start
# start must be called to set up a server socket
proc start {port} {
if {$port} {
variable fd [socket -server hpeek::accept $port]
}
}
# accept a new incoming tcp/ip connection
proc accept {sock h p} {
fconfigure $sock -blocking 0
fileevent $sock readable [list hpeek::request $sock]
}
# process a single request
proc request {sock} {
catch {
set line [gets $sock]
if {[fblocked $sock]} return
fileevent $sock readable ""
fconfigure $sock -translation binary -buffering full
set p /
regexp {/[^ ]*} $line p
regsub -all / $p :: p
set r "HTTP/1.0 200 OK\n\n"
if {[catch {display $p r} err]} {
set r "HTTP/1.0 404 Not found\n\n<h3>No such URL</h3>\
<pre>$::errorInfo</pre>"
}
puts $sock $r
}
catch {close $sock}
}
# make a string suitable for viewing as HTML
proc htmlize {s} {
regsub -all {&} $s {\&} s
regsub -all {<} $s {\<} s
regsub -all {>} $s {\>} s
return $s
}
# htmlize, show in fixed font if text contains newlines
proc showtext {s} {
set s [htmlize $s]
if {[string first "\n" $s] >= 0} { set s "<pre>$s</pre>" }
return $s
}
# generate a page with the requested information
proc display {x result} {
upvar $result r
append r "<html><body><table cellspacing=0 cellpadding=0>"
set a "<tr><td align=right valign=top>"
set b " </td><td>"
if {[namespace tail $x] == ""} {
set c [namespace children $x]
if {[llength $c] > 0} {
append r $a "<b>Namespaces:</b>" $b
foreach y [lsort -dictionary $c] {
set z [namespace tail $y]
append r "<a href=\"$z/\">$z</a> "
}
append r "</td></tr>"
}
foreach k [lsort -dictionary [info vars $x*]] {
append r $a [htmlize [namespace tail $k]] $b
if {[array exists $k]} {
set n [array size $k]
append r "<a href=\"[namespace tail $k]\">$n entries</a>"
} elseif {[info exists $k]} {
set v [set $k]
append r [showtext $v]
} else {
append r "<b>?</b>"
}
append r "</td></tr>"
}
} else {
foreach k [lsort -dictionary [array names $x]] {
append r $a [htmlize [namespace tail $k]] $b
set v [set ${x}($k)]
append r [showtext $v] "</td></tr>"
}
}
append r "</table></body></html>"
}
}Luciano ES - Does this script require some arcane package, by any chance? I just tried to run it and the entity tells me that the 'module' command (called by the 'hpeek' proc) does not exist.Fixed -jcw
