Tcl Source Code

Artifact 8204073e95cef9dc30a2ad313b9a82fe4ed7cc40:

Attachment "zlibtest1.tcl" to ticket [3525907fff] added by teopetuk 2012-05-12 00:27:34.

---

#! /usr/bin/tclsh8.6

proc accept {chan addr port} {
    fconfigure $chan -buffering none
    zlib push compress $chan
    puts $chan qwertyuiop
    chan configure $chan -flush sync
    after 5000 [list print $chan asdfghjkl]
}

proc print {chan msg} {
    puts $chan $msg
    close $chan
}

proc report {chan} {
    set int [expr {[clock seconds] - $::start}]
    set msg [read $chan]
    puts -nonewline $msg
    flush stdout

    if {[eof $chan]} {
	close $chan
	exit 0
    }
}

socket -server accept 43210

set start [clock seconds]
set chan [socket localhost 43210]
fconfigure $chan -blocking 0 -buffering none
zlib push decompress $chan
fileevent $chan readable [list report $chan]

vwait forever