Version 5 of Coronet

Updated 2009-01-29 00:35:12 by andy
    # Coronet - a simple skeleton for coroutine networking
    # CMcC and Mig 14Jan09

    namespace eval Coronet {
        # if you are adventurous, you can redefine yield in terms of ::yield
        # proc yield {{retval ""}} {...}

        variable maxline 1024

        # provide access to variables defined in top level of coroutine
        proc corovars {args} {
            foreach n $args {lappend v $n $n}
            uplevel 1 [list upvar #1 {*}$v]
        }

        # terminate coroutine
        proc terminate {args} {
            return -level [info level] $args        ;# terminate consumer
        }

        # coroutine-enabled gets
        proc get {socket {reason ""}} {
            variable maxline
            set result [yield]
            set line ""
            while {[chan gets $socket line] == -1 && ![chan eof $socket]} {
                set result [yield]
                if {$maxline && [chan pending input $socket] > $maxline} {
                    error "line length greater than $maxline"
                }
            }

            if {[chan eof $socket]} {
                terminate $reason        ;# check the socket for closure
            }

            # return the line
            return $line
        }

        # coroutine-enabled read
        proc read {socket size} {
            # read a chunk of $size bytes
            set chunk ""
            while {$size && ![chan eof $socket]} {
                set result [yield]
                set chunklet [chan read $socket $size]
                incr size [expr {-[string length $chunklet]}]
                append chunk $chunklet
            }

            if {[chan eof $socket]} {
                terminate entity        ;# check the socket for closure
            }

            # return the chunk
            return $chunk
        }

        proc do {args} {
            set x 1        ;# x is available via [corovars x]
            .... this is where your network code goes
        }

        proc init {name socket args} {
            set coro [coroutine $name ::Coronet::do {*}$args]
            fileevent $socket readable [list $coro INCOMING]
            return $coro
        }

        namespace export -clear *
        namespace ensemble create -subcommands {}
    }