Tcl Source Code

Artifact [74b6dd06a9]
Login

Artifact 74b6dd06a9c587e7f8954cb2401a2ae15fc1d012:

Attachment "rttest.tcl" to ticket [2921116fff] added by sbron 2009-12-25 23:01:33.
set port [lindex [fconfigure [socket -server server 0] -sock] 2]

proc server {fd host port} {
    fconfigure $fd -blocking 0 -buffering line
    puts $fd "Hello"
}

namespace eval foo {
    namespace ensemble create -parameters fd -subcommands {
	initialize finalize read write
    }

    proc initialize {fd id mode} {
	return [namespace ensemble configure foo -subcommands]
    }

    proc finalize {fd id} {}

    proc read {fd id data} {
	# Send back an acknowledgement (without timestamp) to the sender
	chan pop $fd
	puts $fd "Ack"
	chan push $fd [list foo $fd]
	return $data
    }

    proc write {fd id data} {
	return "[clock format [clock seconds] -format %T]: $data"
    }
}

proc receive {fd} {
    if {[eof $fd]} {
	close $fd
    } elseif {[gets $fd line] != -1} {
	puts $line
    }
}

set f [socket localhost $port]
chan push $f [list foo $f]
fconfigure $f -blocking 0
fileevent $f readable [list receive $f]

vwait forever