Posted to tcl by spjuth at Tue Feb 16 23:27:04 GMT 2010view raw

  1. proc Response {ch} {
  2. puts $ch "x"
  3. puts $ch ""
  4. # Slow down the response to make the wait visible in the client
  5. after 100 [info coroutine] ; yield
  6. set zd [zlib compress [string repeat 10000 10000]]
  7. puts -nonewline $ch $zd
  8. close $ch
  9. puts "Server Closed after sending [string length $zd]"
  10. }
  11.  
  12. proc Connect {ch addr port} {
  13. chan configure $ch -buffering none -translation binary
  14. puts "Server Connect"
  15. coroutine srv Response $ch
  16. }
  17.  
  18. socket -server Connect 46739
  19.  
  20. proc Readable {ch} {
  21. set n [gets $ch line]
  22. puts "Read line length [string length $line]"
  23.  
  24. if {[eof $ch]} {
  25. puts "EOF"
  26. set data [read $ch 4]
  27. if {$data ne ""} {
  28. puts "Data after EOF [string length $data]"
  29. }
  30. close $ch
  31. exit
  32. }
  33. if {$n == 0} {
  34. puts "Switch to zlib"
  35. zlib push decompress $ch
  36. }
  37. }
  38.  
  39. set ch [socket localhost 46739]
  40. chan configure $ch -translation binary
  41. # Skip this wait to make it work
  42. after 500 set forever 1 ; vwait forever
  43. chan event $ch readable [list Readable $ch]
  44. vwait forever