Tcl Source Code

Artifact e21cba03c029aa55f28257bc30d9f6c7f749f847:

if {[llength $argv]!=1} {
    puts stderr "Usage: tclsh client.tcl <PAUSE_TIME>"
    puts stderr "  where PAUSE_TIME is in ms."
    exit
}

set PAUSE_TIME [lindex $argv 0]

set write_queue {}
lappend write_queue "This is message  1"
lappend write_queue "This is message  2"
lappend write_queue "This is message  3"
lappend write_queue "This is message  4"
lappend write_queue "This is message  5"
lappend write_queue "This is message  6"
lappend write_queue "This is message  7"
lappend write_queue "This is message  8"
lappend write_queue "This is message  9"
lappend write_queue "This is message 10"

set write_count 0
proc WriteMe { chan } {
    global write_queue write_count PAUSE_TIME

    if {[llength $write_queue]<1} {
	close $chan
	puts "\7Socket closed"
	exit
    }

    puts [format "Writing message %2d" [incr write_count]] ; flush stdout
    if {[catch {puts $chan [lindex $write_queue 0]} errmsg]} {
	puts "OUTPUT ERROR on socket $chan: $errmsg"
	return
    }
    set write_queue [lrange $write_queue 1 end]
}

proc ReadMe { chan } {
    if {[catch {gets $chan line} bytes]} {
	puts "INPUT ERROR on socket $chan: $bytes"
	return
    }
    if {$bytes < 0} {
	if {[fblocked $chan]} {
	    # 'gets' call is blocked until a whole line is available
	    return
	}
	if {[eof $chan]} {
	    puts "INPUT EOF detected on socket $chan; closing socket."
	    close $chan
	    return
	}
    }
    puts " Reply from server: $line" ; flush stdout
}

set clientsock [socket localhost 11111]
fconfigure $clientsock -blocking 0 -buffering line -translation {auto crlf}
fileevent $clientsock readable [list ReadMe $clientsock]
fileevent $clientsock writable "[list WriteMe $clientsock]; after \$PAUSE_TIME"

vwait forever