+---------- On Sep 20, Peter M. Jansson said:
> OK, I'm sorry to do this to you, but you seem to be the best candidate to
> be an experimental subject for this. Can you make some changes to your
> Tcl libraries and report on the findings? The changes I have in mind are
> as follows:
>
> - define a new command called "rl_proc", which takes three arguments, and
> is used instead of "proc" to define your commands. In rl_proc, you would
> store the arg list and body in an nsv keyed by the proc name
>
> - define an unknown proc which consults the nsv for the command name, and
> if it's found, executes "proc" with the arg list and body from the nsv.
> If the proc is unknown, you can return an error
You must define the unknown command first, because library scripts can
call procs as well as define them.
You could just rename proc to _proc and then define a new proc:
proc unknown {args} {
set name [lindex $args 0]
if [nsv_exists procs $name] {
eval _proc [nsv_get procs $name]
uplevel 1 $args
} else {
uplevel 1 _unknown $args
}
}
rename proc _proc
_proc proc {name args body} {
nsv_set procs $name [list $name $args $body]
}
However, this will not handle namespaces correctly. Anyway, I wouldn't
redefine the proc command. I'd rather redefine the _ns_getnamespace
command, which is ultimately responsible for putting proc definitions
into the init script.
The _ns_getnamespace proc is defined in namespace.tcl. Put this in
zzz-last.tcl to make it load after namespace.tcl:
proc unknown {args} {
ns_log notice "unknown $args"
set name [lindex $args 0]
if {[string equal -length 2 :: $name]} {
if {[nsv_exists procs $name]} {
eval proc [nsv_get procs $name]
} else {
error "invalid command name \"$name\""
}
} else {
set ns [uplevel 1 {namespace current}]
if {$ns != "::" && [nsv_exists procs "${ns}::$name"]} {
eval proc [nsv_get procs "${ns}::$name"]
} elseif {[nsv_exists procs "::$name"]} {
eval proc [nsv_get procs "::$name"]
} else {
error "invalid command name \"$name\""
}
}
set code [catch {uplevel 1 $args} result]
return -code $code -errorcode $::errorCode -errorinfo $::errorInfo $result
}
rename _ns_getnamespace ""
proc _ns_getnamespace n {
ns_log notice "_ns_getnamespace $n"
namespace eval $n {
set n [namespace current]
set script ""
foreach v [info vars] {
switch $v {
n -
v -
script continue
default {
if [info exists ${n}::$v] {
if [array exists $v] {
append script [list variable $v]\n
append script [list array set $v [array get $v]]\n
} else {
append script [list variable $v [set $v]]\n
}
}
}
}
}
foreach p [info procs] {
if {$n == "::"} {
set np "::$p"
} else {
set np "${n}::$p"
}
set args ""
foreach a [info args $p] {
if [info default $p $a def] {
set a [list $a $def]
}
lappend args $a
}
if {$np == "::unknown"} {
append script [list proc $p $args [info body $p]]\n
} else {
nsv_set procs $np [list $np $args [info body $p]]
}
}
append script [concat namespace export [namespace export]]\n
return $script
}
}
There is another danger, though. The first time that nsd calls a
register proc or filter, it looks at the number of arguments that the
proc takes to decide whether to pass a connId argument. In this case,
nsd won't be able to determine the number of arguments, because the proc
isn't defined yet, so nsd assumes that it should NOT pass the connId
argument. This means that if you do this:
proc myfilter {conn args why} {
# whatever
}
ns_register_filter preauth GET /* myfilter
That you'll get an error on every request because nsd won't pass the
conn argument when it calls myfilter. You need to change the definition
of myfilter to not use the conn argument:
proc myfilter {args why} {
# whatever
}
ns_register_filter preauth GET /* myfilter
