Tcl 8.5 provides a facility to implement channels (as usually returned by open and socket) in pure tcl (see reflectedchan).This enables a library to implement transformations over channels (see stacked channel) or present a file-like interface (read/puts/chan event etc.) to any data structure.Reflected channels are created with chan create and their implementation is documented there, and http://www.tcl.tk/man/tcl8.5/TclCmd/refchan.htmAnd a reflected channel example.
Code edit
Meanwhile, here is an implementation of a simple reflected channel which acts as a buffer. package provide rchan 1.0
namespace eval rchan {
variable chan ;# set of known channels
array set chan {}
proc initialize {chanid args} {
variable chan
set chan($chanid) ""
puts [info level 0]
set map [dict create]
dict set map finalize [list ::rchan::finalize $chanid]
dict set map watch [list ::rchan::watch $chanid]
dict set map seek [list ::rchan::seek $chanid]
dict set map write [list ::rchan::write $chanid]
if { 1 } {
dict set map read [list ::rchan::read $chanid]
dict set map cget [list ::rchan::cget $chanid]
dict set map cgetall [list ::rchan::cgetall $chanid]
dict set map configure [list ::rchan::configure $chanid]
dict set map blocking [list ::rchan::blocking $chanid]
}
namespace ensemble create -map $map -command ::$chanid
return "initialize finalize watch read write configure cget cgetall blocking"
}
proc finalize {chanid} {
variable chan
unset chan($chanid)
puts [info level 0]
}
variable watching
array set watching {read 0 write 0}
proc watch {chanid events} {
variable watching
puts [info level 0]
# Channel no longer interested in events that are not in $events
foreach event {read write} {
set watching($event) 0
}
foreach event $events {
set watching($event) 1
}
}
proc read {chanid count} {
variable chan
puts [info level 0]
if {[string length $chan($chanid)] < $count} {
set result $chan($chanid); set chan($chanid) ""
} else {
set result [string range $chan($chanid) 0 $count-1]
set chan($chanid) [string range $chan($chanid) $count end]
}
# implement max buffering
variable watching
variable max
if {$watching(write) && ([string length $chan($chanid)] < $max)} {
chan postevent $chanid write
}
return $result
}
variable max 1048576 ;# maximum size of the reflected channel
proc write {chanid data} {
variable chan
variable max
variable watching
puts [info level 0]
set left [expr {$max - [string length $chan($chanid)]}] ;# bytes left in buffer
set dsize [string length $data]
if {$left >= $dsize} {
append chan($chanid) $data
if {$watching(write) && ([string length $chan($chanid)] < $max)} {
# inform the app that it may still write
chan postevent $chanid write
}
} else {
set dsize $left
append chan($chanid) [string range $data $left]
}
# inform the app that there's something to read
if {$watching(read) && ($chan($chanid) ne "")} {
puts "post event read"
chan postevent $chanid read
}
return $dsize ;# number of bytes actually written
}
proc blocking { chanid args } {
variable chan
puts [info level 0]
}
proc cget { chanid args } {
variable chan
puts [info level 0]
}
proc cgetall { chanid args } {
variable chan
puts [info level 0]
}
proc configure { chanid args } {
variable chan
puts [info level 0]
}
namespace export -clear *
namespace ensemble create -subcommands {}
}Test edit
catch {console show}
set fd [chan create [list read write] rchan]
puts $fd "Hello World"
$fd write "Hello World"
puts [gets $fd]
proc GetData { fd args } {
puts [info level 0]
puts [gets $fd]
}
fileevent $fd readable [list GetData $fd]
puts $fd "Hello Moon!"
$fd write "Hello Moon!"
fconfigure $fd -buffering lineOutput edit
::rchan::initialize rc0 {read write}
::rchan::write rc0 {Hello World}
::rchan::read rc0 4096
::rchan::read rc0 4085
Hello World
::rchan::watch rc0 read
::rchan::write rc0 {Hello Moon!}
post event read
GetData rc0
::rchan::read rc0 4096
::rchan::read rc0 4085
Hello Moon![Using reflected channels to do the equivalent of
open "|simple1 |& cat" rusing exec instead of open and the "cat" helper?]
Zarutian 27. January 2006: Are reflected channels just other name for rechans in Rchan allows channels to be implemented in Tcl?Lars H: Same idea, different implementations. From the TIP discussions, I recall it being mentioned that the handling of threads and errors were tricky points for a reflected channel API.
hae 2009-26-05 Strange. The code above works so far. But puts and fconfigure do not call rchan::write and rchan::configure. However with
fconfigure $fd -blocking 0the rchan::blocking is called.APN 2010-07-15 If you call puts, you need to do a flush or fconfigure the channel buffering to be line (it is full by default).APN 2010-07-15 Fixed what I think was a bug in the watch procedure when events is empty.AK APN has it right, the "rchan::write" is called when Tcl flushes the internally buffered data, per the configured -buffering policy. As for the "rchan::configure", that is called for your own options. The standard options like -buffering, etc. are handled by Tcl itself, with the exceptions, like -blocking having a specific callback, i.e. "rchan::blocking". Tcllib has a number of channel examples in the virtchannel_base/core modules.
