Description edit
A reflected channel is not a virtual file system, but a single channel. chan create returns a new reflected channel.Reflected channels make it possible to implement transformations over channels, much like stacked channels, to present a channel interface (read/puts/chan event etc.) to any data structure, and for various other novel purposes.Documentation edit
- Reflecting and Transforming Channels
, AK, 2009 - A paper presented at the Sixteenth Annual Tcl/Tk Conference.
Examples edit
- reflected channel example
- ycl chan chunked
- A reflected channel that wraps another channel, translating its contents from HTTP chunked format.
A Buffer 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
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
::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!An In-Memory Reflected Channel edit
PT: Here is an implementation of a memchan type memory channel. That is a channel interface to a variable holding some data that you write into it. We can use this in the vfs package to provide various implementations of memchan channels depending upon what packages are loaded into what version of Tcl. It illustrates the necessary construction of a simple reflected channel.AK Tcllib has a number of examples as well, see keyword reflected channel. The equivalent of this one likely is memchanproc vfs::memchan {} {
# Create the channel and obtain a generated channel identifier
set fd [chan create {read write} [namespace origin memchan_handler]]
# Initialize the data and seek position
set ::vfs::_memchan_buf($fd) ""
set ::vfs::_memchan_pos($fd) 0
return $fd
}
proc vfs::memchan_handler {cmd chan args} {
upvar 1 ::vfs::_memchan_buf($chan) buf
upvar 1 ::vfs::_memchan_pos($chan) pos
switch -exact -- $cmd {
initialize {
foreach {mode} $args break
return [list initialize finalize watch read write seek]
}
finalize {
unset buf pos
}
seek {
foreach {offset base} $args break
switch -exact -- $base {
current { incr offset $pos }
end { incr offset [string length $buf] }
}
return [set pos $offset]
}
read {
foreach {count} $args break
set r [string range $buf $pos [expr {$pos + $count - 1}]]
incr pos [string length $r]
return $r
}
write {
foreach {data} $args break
set count [string length $data]
if { $pos >= [string length $buf] } {
append buf $data
} else {
set last [expr { $pos + $count - 1 }]
set buf [string replace $buf $pos $last $data]
}
incr pos $count
return $count
}
watch {
# We are required to implement 'watch' but are doing nothing.
foreach {eventspec} $args break
}
}
}Usage is something like:set chan [vfs::memchan] puts $chan "data from somewhere" seek $chan 0 read $chan close $chan
No Coroutine Support edit
PYK 2016-04-20: yield is currently not supported in refchan commands:#! /bin/env tclsh
proc r {} {
set name [info cmdcount]
namespace eval $name {
namespace export *
namespace ensemble create
proc finalize {id} {
}
proc initialize {id spec} {
return {finalize initialize read watch}
}
proc read {id count} {
after 0 [list after idle [list [info coroutine]]]
yield
return hello\n
}
proc watch {id spec} {
}
}
return $name
}
after 0 [list coroutine main apply {{} {
set r1 [r]
set chan [chan create read $r1]
gets $chan line
puts $line
}}]
vwait foreverThe resulting error iscannot yield: C stack busy
Misc edit
[Using reflected channels to do the equivalent ofopen "|simple1 |& cat" rusing exec instead of open and the "cat" helper?]
Zarutian 2006-01-27: 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, rchan::write is called when Tcl flushes the internally buffered data, per the configured -buffering policy. As for 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.
