Posted to tcl by patthoyts at Mon Jun 09 20:06:47 GMT 2008view raw
- proc K {a b} {set a}
- proc identity {cmd args} {
- puts stderr "$cmd"
- switch -exact -- $cmd {
- initialize { return [list initialize finalize read write] }
- finalize { return }
- write { return [lindex $args 1] }
- read { return [lindex $args 1] }
- default { return -code error "method \"$cmd\" not impl" }
- }
- }
- proc identity-buffered {cmd args} {
- if {$cmd ni {read drain}} { puts stderr "$cmd" }
- switch -exact -- $cmd {
- initialize {
- foreach {handle} $args break
- variable $handle {}
- return [list initialize finalize read write drain clear]
- }
- finalize {
- foreach {handle} $args break
- variable $handle
- unset $handle
- return
- }
- write { return [lindex $args 1] }
- read {
- foreach {handle data} $args break
- upvar #0 [namespace which -variable $handle] state
- set len [string length $data]
- append state $data
- set res [string range $state 0 1023]
- set state [string range $state 1024 end]
- incr ::Count [string length $res]
- puts stderr "read data:[string length $data]\
- result:[string length $res]\
- state:[string length $state]"
- return $res
- }
- drain {
- foreach {handle} $args break
- upvar #0 [namespace which -variable $handle] state
- set res $state
- #set state ""
- puts stderr "drain ($args) result:[string length $res]\
- ::Data:[string length $::Data]\
- state:[string length $state]"
- #K $state [set state ""]
- return $res
- }
- clear { return }
- default { return -code error "method \"$cmd\" not impl" }
- }
- }
- proc Test {filename {chunk 4096} {transform ::identity-buffered}} {
- variable Data ""; variable Count 0
- set f [open $filename r]
- chan push $f $transform
- set Data [read $f]
- close $f
- puts "orig:[file size $filename] read:[string length $Data] count:$Count"
- }
- if {!$tcl_interactive} {
- set r [catch [linsert $argv 0 Test] err]
- if {$r} {puts $::errorInfo} elseif {[string length $err]>0} {puts $err}
- exit $r
- }