Version 14 of reflected channel

Updated 2010-07-15 12:17:21 by dkf

Sometimes called virtual channel or stacked channel, not to be confused with virtual file systems.


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

And a reflected channel example.


Code

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!

[Using reflected channels to do the equivalent of

  open "|simple1 |& cat" r

using exec instead of open and the "cat" helper?]


Zarutian 27. january 2006: are reflected chans just other name over 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.