TclOO：如何在不污染命名空间的情况下添加类配置方法

问题描述 #

基于TclOO实现类能力注册模式，参考相关技巧构建类声明式配置接口，但存在以下问题：

• 不希望capability配置命令全局可用，仅在特定类及其子类中生效，不同类组可使用不同命名的命令；
• 当前register方法中通过if {![info exists _registry]} { set _registry {} }判断变量存在性，希望将该逻辑移至variable语句处初始化；
• 尝试通过元类解决第一个问题但未成功，疑惑是否可通过元类添加类定义专属的配置命令。

尝试的元类代码 #

::oo::class create ::demo::metaclass {
    superclass ::oo::class
    
    self method create {name args} {
        set inst [next $name {*}$args]
        # to ensure metaclass on method lookup?
        oo::define $inst superclass -append [self]
        return $inst
    }
    
    # on the class? how to use this?
    self method capability {args} {
        # implementation as below
    }
}

最小注册实现代码 #

# Tcl 8.5
package require TclOO
package require struct::set

namespace eval ::demo {}

# 全局注册中心对象
::oo::object create ::demo::registry
::oo::objdefine ::demo::registry {
    variable _registry
    
    method query {args} {
        set LoL {}
        foreach {cap val} $args {
            lappend LoL [dict get $_registry $cap $val]
        }
        set candidates [::struct::set intersect {*}$LoL]
        return $candidates
    }
    method register {capability value cls} {
        if {![info exists _registry]} { set _registry {} }
        
        dict update _registry $capability dval {
            dict lappend dval $value $cls
        }
    }
    unexport destroy
}

# 全局可用的capability配置命令
proc oo::define::capability {args} {
    set cls [lindex [info level -1] 1]
    foreach {cap val} $args {
        ::demo::registry register $cap $val $cls
    }
}

# 抽象能力类
oo::class create ::demo::ICapa {
    method connect {} {} ; # abstract
}

# 具体能力类
oo::class create ::demo::PayloadCapa {
    superclass ::demo::ICapa
    capability -type cargo -capacity 500kg
}

oo::class create ::demo::GroundCapa {
    superclass ::demo::ICapa
    capability -type cart -rating 20A
}

# 测试查询
::demo::registry query -type cargo

解决方案 #

问题b：变量初始化移至variable语句 #

在注册中心对象的定义中，直接通过variable语句为_registry设置初始空字典，替代方法内的存在性判断：

::oo::objdefine ::demo::registry {
    variable _registry {}  # 直接初始化空字典
    
    method query {args} {
        # ... 原有代码不变
    }
    method register {capability value cls} {
        # 移除if判断，直接使用dict update
        dict update _registry $capability dval {
            dict lappend dval $value $cls
        }
    }
    # ... 其他代码不变
}

问题a&c：通过元类实现类专属配置命令 #

修改元类逻辑，在创建类时为其添加专属的capability定义命令，该命令仅在当前类及其子类的oo::define块中可用：

::oo::class create ::demo::metaclass {
    superclass ::oo::class
    
    self method create {name args} {
        # 创建类实例
        set inst [next $name {*}$args]
        # 为该类添加专属的capability定义命令
        oo::define $inst proc capability {args} {
            # 获取当前正在定义的类名
            set cls [lindex [info level -1] 1]
            foreach {cap val} $args {
                ::demo::registry register $cap $val $cls
            }
        }
        return $inst
    }
}

然后用该元类创建抽象能力类，其所有子类都会自动继承该元类，从而拥有capability配置命令：

# 用元类创建抽象能力类
::demo::metaclass create ::demo::ICapa {
    method connect {} {} ; # 抽象方法
}

# 子类自动继承元类特性，可使用capability命令
oo::class create ::demo::PayloadCapa {
    superclass ::demo::ICapa
    capability -type cargo -capacity 500kg
}

oo::class create ::demo::GroundCapa {
    superclass ::demo::ICapa
    capability -type cart -rating 20A
}

此时，capability命令仅在::demo::ICapa及其子类的oo::define块中可用，其他类无法使用，实现了命令的隔离。

完整修改后的代码 #

# Tcl 8.5
package require TclOO
package require struct::set

namespace eval ::demo {}

# 全局注册中心对象
::oo::object create ::demo::registry
::oo::objdefine ::demo::registry {
    variable _registry {}  # 直接初始化空字典
    
    method query {args} {
        set LoL {}
        foreach {cap val} $args {
            lappend LoL [dict get $_registry $cap $val]
        }
        set candidates [::struct::set intersect {*}$LoL]
        return $candidates
    }
    method register {capability value cls} {
        dict update _registry $capability dval {
            dict lappend dval $value $cls
        }
    }
    unexport destroy
}

# 自定义元类，为创建的类添加专属配置命令
::oo::class create ::demo::metaclass {
    superclass ::oo::class
    
    self method create {name args} {
        set inst [next $name {*}$args]
        # 添加类专属的capability定义命令
        oo::define $inst proc capability {args} {
            set cls [lindex [info level -1] 1]
            foreach {cap val} $args {
                ::demo::registry register $cap $val $cls
            }
        }
        return $inst
    }
}

# 用元类创建抽象能力类
::demo::metaclass create ::demo::ICapa {
    method connect {} {} ; # 抽象方法
}

# 具体能力类，可使用capability命令
oo::class create ::demo::PayloadCapa {
    superclass ::demo::ICapa
    capability -type cargo -capacity 500kg
}

oo::class create ::demo::GroundCapa {
    superclass ::demo::ICapa
    capability -type cart -rating 20A
}

# 测试查询
puts [::demo::registry query -type cargo]

内容的提问来源于stack exchange，提问作者Christopher Horler