(CMCc 20120207) It is possible to derive from [TclOO]'s [oo::class] and create meta classes that perform additional actions upon object instance creation, method creation, etc..

oo::socket looks like [oo::class], but as a side-effect creates a listener socket (specified by additional arguments to the oo::socket create or oo::socket new commands) that constructs a new instance of the class to service each new connection.  The object created will be named for the socket.  The example class, ::echo (given below) merely echoes what it receives.

======
# oo::socket.tcl - class to listen on a given port, etc
package provide oo::socket 1.0

oo::class create oo::socket {
    method listen {params} {
        set -tls {}
        set -port 8080
        dict with params {}

        ::socket -server [list ::apply [list {class opts sock ipaddr rport} {
            if {[dict exists $opts -tls] && [dict get $opts -tls] ne {}} {
                set tlsopts [dict merge {
                    -certfile server-public.pem
                    -keyfile server-private.pem
                    -cadir .
                    -cafile ca.pem
                    -ssl2 0
                    -ssl3 1
                    -tls1 1
                    -require 0
                    -request 1
                } [dict get $opts -tls]]
                
                if {[dict exists $opts -progress]} {
                    set progress "-command [dict get $opts -progress]"
                } else {
                    set progress {}
                }
                if {[dict exists $opts -password]} {
                    set password [list -password [list ::apply [list {} [list return "\"[dict get $opts -password]\""]]]]
                } else {
                    set password {}
                }
                
                chan configure $sock -blocking 1 -translation {binary binary}
                tls::import $sock -server 1 {*}$tlsopts {*}$progress {*}$password
                tls::handshake $sock
            }

            {*}$class create $sock {*}[expr {[dict exists $opts -args]? [dict get $opts -args] : {}}]
        } [namespace current]] [self] [list -tls ${-tls}]] {*}[expr {([info exists -myaddr] && ${-myaddr} ne "")?"-myaddr ${-myaddr}":""}] ${-port}
    }

    superclass ::oo::class
    constructor {definition args} {
        next $definition
        my listen $args
        return [self]
    }
}

if {[info script] eq $argv0} {
    oo::socket create echo {
        method readable {} {
            variable sock
            if {[chan eof $sock]} {
                my destroy
            } else {
                puts $sock [gets $sock]
            }
        }

        destructor {
            puts stderr "[self] destroyed"
            catch {variable sock; close $sock}
        }

        constructor {args} {
            variable sock [namespace tail [self]]
            puts stderr "[self] connected to $sock"
            chan configure $sock -buffering line
            chan event $sock readable [list [self] readable]
        }
    }
    vwait forever
}
======

<<categories>>Object Orientation