reflected channel example

See reflected channel for background.

An example of a memory channel based on Tcl 8.5 reflected channel support. Untested.


   snit::type mystringchan {
   
       constructor {data} {
           # Initialize the buffer, current read location, and limit
           set mydata $data
           set myend [string length $mydata]
           set mypos 0
       }
   
       # Setting up, shutting down.
   
       method initialize {chan mode} {
           # Note: We can assume that mode is a list containing 'read'
           # and/or 'write'. No checking required. We don't do anything
           # with it in this example.
   
           # A read-only type of channel can use to verify that it was no
           # opened for writing.
   
           set mychan $chan
           return
       }
   
       method finalize {chan} {
           # We have nothing to finalize. Other channels may have to
           # release external resources.
           return
       }
   
       # Option handling. This channel has no options.
   
       method configure {chan option value} {
           # No options, trying to write to any specific one is bogus.
           return -code error "Invalid option '$option'"
       }
   
       method cget {chan option} {
           # No options, trying to get any specific one is bogus.
           return -code error "Invalid option '$option'"
       }
   
       method cgetall {chan} {
           # No options, nothing to report.
           return {}
       }
   
       # Basic I/O
   
       method read {chan n} {
           # This is only called for a channel opened for reading. No
           # need to check. Do checks in 'initialize'.
   
           set endofrequest [expr ($mypos + $n - 1)]
           if {$endofrequest < $myend} {
               # Get requested chunk, and move seek location behind it.
               set res [string range $mydata $mypos $endofrequest]
               set mypos $endofrequest
           } else {
               # Cut short at end of buffer. Move to end of buffer.
               set res [string range $mydata $mypos end]
               set mypos $myend
           }
   
           return $res
       }
   
       method write {chan data} {
           # This is only called for a channel opened for writing. No
           # need to check. Do checks in 'initialize'.
   
           set n [string length $data]
   
           if {$mypos >= $myend} {
               # Append at end
               append mydata $data
               set myend [string length $mydata]
               set mypos $myend
               return $n
           }
   
           # Overwrite in the middle, may extend after the end
   
           set endofrequest [expr ($mypos + $n - 1)]
           if {$endofrequest >= $myend} {
               # Yes, extending beyond.
               set mydata [string replace $mydata $mypos end $data]
               set myend [string length $mydata]
               set mypos $myend
               return $n
           }
   
           # Replace in the middle.
   
           set mydata [string replace $mydata $mypos $endofrequest $data]
           set myend [string length $mydata]
           set mypos $endofrequest
           return $n
       }
   
       method seek {chan offset base} {
           # Do a quick check for and bypass if this is a 'tell' request,
           # i.e. do not seek, just report position.
   
           if {!$offset && ($base eq "current")} {
               return $mypos
           }
   
           # Compute new location per the arguments.
   
           switch -exact -- $base {
               start   { set newloc $offset}
               current { set newloc [expr {$mypos + $offset    }] }
               end     { set newloc [expr {$myend + $offset - 1}] }
           }
   
           # Check for new location getting out of range
   
           if {$newloc < 0} {
               return -code error "Cannot seek before the start of the channel"
           } elseif {$newloc > $myend} {
               # Here a different semantics is possible: Allow seeking
               # behind the end of the channel, auto-append \0. The
               # append may be defered until the data is actually needed,
               # or not happen at all, if the system is made complex
               # enough to handle disparate fragments instead of using a
               # single string as the buffer. That however is all beyond
               # the scope of this example.
   
               return -code error "Cannot seek after the end of the channel"
           }
   
           # Commit to new location and report.
   
           set mypos $newloc
           return $newloc
       }
   
       # Event management.
   
       method blocking {chan mode} {
           # We are like a file, not really blocking even in blocking
           # mode.
           return
       }
   
       method watch {chan eventstowatch} {
           # Set up and/or shut down the timers used to generate events
           # based on the set of events asked for.
   
           # Note: A possible expansion is the export of one or more
           # options through which a user can specify the time interval
           # between events, either in general, or separately for
           # read/write.
   
           if {"read" in $eventstowatch} {
               set myreadtimer [after 5 [mymethod Readable]]
           } else {
               after cancel $myreadtimer
           }
   
           if {"write" in $eventstowatch} {
               set mywritetimer [after 5 [mymethod Writable]]
           } else {
               after cancel $mywritetimer
           }
           return
       }
   
       # Internals. State
   
       variable mydata       {} ; # The data delivered by the channel. Binary.
       variable mypos        0  ; # Current read location.
       variable myend        0  ; # First location after end of the buffer.
       variable mychan       {} ; # Handle of the channel we are at the Tcl level.
       variable myreadtimer  {} ; # Timer for generation of read events
       variable mywritetimer {} ; # Ditto for write events.
   
       # Internals. Methods. Event generation.
   
       method Readable {} {
           set myreadtimer [after 5 [mymethod Readable]]
           chan postevent $mychan read
           return
       }
   
       method Writable {} {
           set mywritetimer [after 5 [mymethod Writable]]
           chan postevent $mychan write
           return
       }
   }