reflected channel

A reflected channel is a virtual channel created via chan create and implemented in conformance with the refchan API specification.

Description

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

Reflecting and Transforming Channels , AK, 2009
A paper presented at the Sixteenth Annual Tcl/Tk Conference.

Examples

reflected channel example
ycl chan chunked
A reflected channel that wraps another channel, translating its contents from HTTP chunked format.

A Buffer

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 line

Output

::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

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 memchan

proc 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

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 forever

The resulting error is

cannot yield: C stack busy

Misc

[Using reflected channels to do the equivalent of

open "|simple1 |& cat" r

using 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 0

the 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.