Attachment "refchan_example.tcl" to
ticket [1913876fff]
added by
andreas_kupries
2008-03-14 23:24:25.
# ===================
proc memchan {} {
return [chan create {read write} [mystringchan %AUTO% {}]]
}
# ===================
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 it to verify that it was
# not 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
}
}
