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