Posted to tcl by schelte at Sat May 10 13:57:18 GMT 2014view pretty
proc cosocket {args} { set coro [info coroutine] if {$coro eq ""} {tailcall socket {*}$args} set sock [socket -async {*}$args] fileevent $sock writable [list [info coroutine] cosock] while {[yield] ne "cosock"} {} fileevent $sock writable {} set err [fconfigure $sock -error] if {$err eq ""} { # Success return $sock } switch -- $err { "connection refused" { set perror ECONNREFUSED } "host is unreachable" { set perror EHOSTUNREACH } default { set perror EUNKNOWN } } close $sock throw [list POSIX $perror $err] "couldn't open socket: $err" } ::http::register http 80 cosocket