Posted to tcl by aspect at Sun Jun 26 08:33:05 GMT 2011view pretty
proc nbsock {args} { set args [lassign $args chan cmd] puts "nbsock $chan $cmd $args" switch -exact $cmd { initialize { return {initialize finalize read write watch} } read { lassign $args id count while {[set data [chan read $chan $count]] == ""} { if {[eof $channel]} { #return {} return -code error "EOF on $sock" } } yield } write { lassign $args id data chan puts -nonewline $chan $data string length $data } finalize { close $chan } default { error "Unsupported subcommand: $cmd" } } } proc echo {sock host port} { while {![chan eof $sock]} { puts "chan configure: [chan configure $sock]" chan puts $sock [chan gets $sock] } } namespace eval clients {} proc handle {sock host port} { puts "Connect: $host:$port" set sock [chan create [list read write] [list nbsock $sock]] yield if {[catch {echo $sock $host $port} result]} { puts "Error: $host:$port: $result" } puts "Closing: $host:$port" if {[catch {close $sock} res]} { puts "Error closing $host:$port: $res" } } proc accept {sock host port} { coroutine clients::$host:$port handle $sock $host $port chan configure $sock -blocking 0 -buffering line chan event $sock readable clients::$host:$port } socket -server accept 1234 if {!$::tcl_interactive} {vwait forever} proc accept {sock host port} { coroutine clients::$host:$port handle $sock $host $port chan configure $sock -blocking 0 -buffering line chan event $sock readable clients::$host:$port } socket -server accept 1234 if {!$::tcl_interactive} {vwait forever}