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:
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 }
}
socket -server accept 9000That'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:
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.1
namespace eval channel {
namespace export iterate error
namespace ensemble create
# 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
}
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 }
}
proc accept {sock addr port} {
puts "CONNECT: $sock $addr\:$port"
chan configure $sock -buffering line
channel iterate $sock -eofcommand cleanup {sock line} { puts $sock $line }
}
proc cleanup chan {
puts "DISCONNECT: $chan"
close $chan
}
socket -server accept 9000
vwait forever[ Category Networking | Category Package | Category File | Category Event Loop ]