[NEM] ''12 Oct 2006'': Despite the generally very high-level of abstraction
offered by Tcl's built-in channel capabilities, I still find myself having to
search through documentation and examples to find exactly what combination of
[eof], [fblocked], [fileevent] and [fconfigure] magic I need to get a particular
example working. In most of these cases, the result is pretty similar. It
therefore seems like a good idea to try and package up some of the more common
patterns as reusable commands, possibly for inclusion in [tcllib]. To this end,
I've knocked up an initial "channel" [package]/[ensemble] to complement 8.5's
[chan] command. This initial version supports a single command "iterate" that
can be used to easily set-up a correct fileevent with much of the configuration
and error handling taken care of. The API is:

'''channel iterate''' ''chan ?options..? (cmd | params body)'':

Arranges for a callback to be invoked for every block of data read from the
channel. The callback can be given as either a command prefix list (like other
callbacks in Tcl), or as a pair of arguments specifying the parameters and body
of an anonymous procedure to be invoked using [apply]. In either case, the
callback will be invoked for each block of data read from the channel with the
channel and the actual data as arguments. Note that the callback is executed in
a new scope, so variables defined outside of the body will not be visible when
the body runs.

The options available are:

   -blocksize:   ''"line" or an integer (default: "line")''. Max # of chars read before each callback.
   -errorcommand:   ''command prefix (default: "channel error")''. Callback to invoke if an error occurs on the channel. Called with channel, errorCode and error message args.
   -eofcommand:   ''command prefix (default: "chan close")''. Callback to invoke when the channel reaches [eof]. Responsible for closing the channel.

As an example, here is a simple echo server that can handle multiple simultaneous
connections:

 proc accept {sock addr port} {
     puts "CONNECT: $sock $addr\:$port"
     chan configure $sock -buffering line
     channel iterate $sock {sock line} { puts $sock $line }
     # or just: channel iterate $sock puts, as puts takes the right args
 }
 socket -server accept 9000

That's it! We can add disconnection logging easily, just change the channel iterate to:
 channel iterate $sock -eofcommand cleanup {sock line} { puts $sock $line }
and add:
 proc cleanup sock {
     puts "DISCONNECT: $sock"
     close $sock
 }

Comments and suggestions very much welcome. In particular, if someone can check
through the logic to make sure I have actually dealt with the various error
conditions correctly. Possible future enhancements:

   * Add support for synchronous iteration too (i.e., basically just a read loop without using the event loop). Maybe make default, with a -async option?
   * Related to above; support for blocking channels (currently all chans are configured -blocking 0).
   * Should the "params body" form actually create a simple closure (as in [simple closures and objects]), to ease quoting issues? (Might then also add a -environment option to specify the environment dict).
   * Anything else? Other commands people would like to see?

[APN] 20101026 Neat, but perhaps it would be better to disable the read event handler before invoking the user callback and re-enable it once the user callback returns. Otherwise, unexpected behaviour might result if the callback enters the event loop (something as simple as a puts to tkcon) while more input data is pending in the channel.

----
[NEM] slightly later: added a "with" command, which is a slight variation on [using]. Example:

 channel with [open somefile.txt] fd { puts [read $fd] }

I re-arranged the args slightly so that the channel comes before the varName. This is partly
with an eye towards [TOOT]ification -- if channel is first arg of all methods, then you can
sugar an object-like interface:
 proc channel: {chan method args} {
     uplevel 1 [linsert $args 0 ::channel $method $chan]
 }
 proc def {name = cmd args} { interp alias {} $name {} $cmd {*}$args }
 def out = channel: [socket localhost 9000]
 out configure -blocking 0 -buffering line
 out puts "Enter text:"
 out iterate {sock line} {
     puts $line
     puts $sock [gets stdin]
 }
 vwait forever

Also changed the ensemble to delegate unknown commands to [chan], as you can see from the above.
----
'''Code'''

 # channel.tcl --
 #
 #       General high-level channel utilities to complement Tcl's [chan]
 #       ensemble.
 #
 # Copyright (c) 2006 Neil Madden.
 #
 # License: http://www.cs.nott.ac.uk/~nem/license.terms
 #
 
 package require Tcl     8.5
 package provide channel 0.2
 
 namespace eval channel {
     namespace export iterate error with
     namespace ensemble create -unknown ::channel::unknown

     # delegate unknown commands to the ::chan ensemble
     proc unknown {_ cmd args} { list ::chan $cmd }
 
     # channel iterate chan ?options..? [cmd | params body]
     #
     #       Arranges for a callback to be invoked for every block of data read
     #       from the channel. The callback can be given as either a command
     #       prefix list or as a pair of arguments specifying the parameters and
     #       body of an anonymous procedure to be invoked. In either case, the
     #       callback will be invoked for each block of data read from the
     #       channel with the channel and the data read as arguments. Note that
     #       the callback is executed in a new scope, rather than in the caller's
     #       scope, so variables defined outside of the body will not be
     #       visible when the body runs.
     #
     # OPTIONS
     #       -blocksize      "line" or an integer > 0 [default: "line"]
     #                       Maximum number of characters to read before each
     #                       callback. If the value is "line" then [chan gets] is
     #                       used rather than [chan read].
     #       -errorcommand   cmd [default "channel error"]
     #                       Callback to invoke if an error occurs on the
     #                       channel. Called with the channel, the errorCode and
     #                       the error message of the error as arguments.
     #       -eofcommand     cmd [default "chan close"]
     #                       Callback to invoke when the end of the channel is
     #                       reached.
     #
     # RETURNS
     #       The channel.
     #
     # SIDE-EFFECTS
     #       Sets up a channel event handler to invoke the callback. Other
     #       side-effects may be caused by various callbacks. Configures the
     #       channel to be non-blocking.
     #
     proc iterate {chan args} {
         set usage "channel iterate chan ?options..? (cmd | params body)"
         if {[llength $args] < 1} {
             return -code error "wrong # args: should be \"$usage\""
         }
         set options {
             -blocksize          "line"
             -errorcommand       ::channel::error
             -eofcommand         {::chan close}
         }
         if {[llength $args] % 2 == 0} {
             if {[llength $args] < 2} {
                 return -code error "wrong # args: should be \"$usage\""
             }
             set params  [lindex $args end-1]
             set body    [lindex $args end]
             set ns      [uplevel 1 { namespace current }]
             set command [list ::apply [list $params $body $ns]]
             set args [lrange $args 0 end-2]
         } else {
             set command [lindex $args end]
             set args [lrange $args 0 end-1]
         }
         dict for {option value} $args {
             if {![dict exists $options $option]} {
                 set ops [CommaJoin [dict keys $options]]
                 return -code error "invalid option \"$option\": must be $ops"
             }
             dict set options $option $value
         }
         chan configure $chan -blocking 0
         chan event $chan readable [list [my ReadChan] $chan $command $options]
         return $chan
     }
 
     # channel error chan code message --
     #
     #       Default callback for handling errors on a channel. This callback
     #       simply closes the channel and then rethrows the error.
     #
     proc error {chan code message} {
         catch { chan close $chan }
         return -code error -errorcode $code $message
     }

     # channel with chan varName body --
     #
     #      Assigns the varName with the channel given and then evaluates the
     #      body in the caller's scope. Once the body has completed the channel
     #      is closed (even in the case of error).
     #
     proc with {chan varName body} {
         upvar 1 $varName var
         set var $chan
         set rc [catch { uplevel 1 $body } result ops]
         catch { chan close $chan }
         # TODO: do we need to process -level specially?
         return -options $ops $result
     }
 
     interp alias {} [namespace current]::my {} namespace which -command
 
     # CommaJoin list --
     # 
     #       Creates a human-readable version of the list, by separating elements
     #       with commas. The last two elements are separated by ", or " if there
     #       are more than 2 elements in total, and by " or " if there are
     #       exactly two elements.
     #
     proc CommaJoin list {
         if {[llength $list] < 2} {
             return $list
         } elseif {[llength $list] == 2} {
             return [join $list " or "]
         } else {
             set start [join [lrange $list 0 end-1] ", "]
             return [concat $start ", or " [lindex $list end]]
         }
     }
 
     # ReadChan chan command options --
     #
     #       Main channel readable event handler. Invokes appropriate callbacks
     #       according to the condition of the channel.
     #
     proc ReadChan {chan command options} {
         set size [dict get $options -blocksize]
         if {$size eq "line"} {
             set status [catch { gets $chan } data]
         } else {
             set status [catch { read $chan $size } data]
         }
         if {$status != 0} {
             # Error occurred
             invoke [dict get $options -errorcommand] $chan $::errorCode $result
         } elseif {[chan eof $chan]} {
             invoke [dict get $options -eofcommand] $chan
         } elseif {[chan blocked $chan]} {
             # Not enough data, just return
             return
         } else {
             # OK
             invoke $command $chan $data
         }
     }
     proc invoke {cmd args} { uplevel #0 $cmd $args }
 }
----
[[ [Category Networking] | [Category Package] | [Category File] | [Category Event Loop] | [Category Channel] ]]