Tcl Source Code

Artifact 4722158c573e76ea0afeeefae50757e7e0b25615:

proc Usage {} {
   puts stderr {Usage: tclsh sdtest.tcl <server|client>}
   exit 1
}

if {[llength $argv]!=1} { Usage }

proc Report { chan } {
   if {[gets $chan msg] < 0} {
	if {[fblocked $chan]} {return}
	if {[eof $chan]} {
   	   close $chan
   	   exit
	}
   }
   set msg [string range $msg 0 70]
   puts stdout $msg
   flush stdout
}

proc ServerProc { chan addr port } {
   fileevent $chan readable [list Report $chan]
}

if {[string match server [lindex $argv 0]]} {
   # Server
   socket -server ServerProc -myaddr localhost 12345
   vwait forever
}

set send_count 10
set msg "%5d Missed it by *that* much!"
while {[string length $msg]<10000} {
   append msg " The oldest trick in the book."
}

proc Tell { sock } {
   global msg send_count
   puts $sock [format $msg $send_count]
   incr send_count -1
   if {$send_count>0} {
      return
   }
   fileevent $sock writable {}

   ####### Uncomment this to make things work #######
   # fconfigure $sock -blocking 1
   ##################################################

   flush $sock
   close $sock
   exit
}   

if {[string match client [lindex $argv 0]]} {
   # Client
   set sock [socket localhost 12345]
   fconfigure $sock -blocking 0
   fileevent $sock writable [list Tell $sock]
   vwait forever
}

# Invalid command line
Usage