This is an example how to use fileevent.
# usage: tclsh clisrv.tcl [secs]
# Andy Tannenbaum, June 2001
# all lines prepended with one space, for the wiki.
# a parent/client and child/server both in this file,
# communicating with fileevent.
# should run on tcl 7.5 and later.
# the two sides share names of things, but they will
# never be invoked in the same address space.
# the child ticks every second,
# and accepts commands from the parent.
# if invoked with no command line args, run parent.
# with args, run child.
if [string match "" $argv] {
# parent/client process
# calls clisrv.tcl with args to invoke child/server
# opening a read/write pipe
# using fileevent.
#
# done gets set when the child exits.
# cfd is the child file descriptor
global done cfd
# gotline is the fileevent callback,
# called when this proc receives input.
proc gotline f {
global done
if {[gets $f line]<0} {
catch {close $f} ret
if ![string match "" $ret] {
puts "parent: gotline: child exited with \
error, ret = $ret, errorCode = $::errorCode"
} else {
puts "parent: gotline: child exited ok"
}
set done 1
return
}
puts "parent: got ==> $line"
}
proc fputs {f str} {
puts $f $str
flush $f
}
# prints:
# parent: got ==> tick: 10
# parent: got ==> tick: 9
# parent: got ==> child: got ==> hello 1
# parent: got ==> tick: 8
# parent: got ==> child: got ==> hello 2
# parent: got ==> tick: 7
# parent: got ==> child: got ==> hello 3
# parent: got ==> tick: 6
# parent: got ==> tick: 5
# parent: got ==> tick: 4
# parent: got ==> child: got quit - q
# parent: gotline: child exited ok
proc pa {} {
global cfd
# run this script with arg, tick for 10 seconds
set cfd [open "|tclsh [info script] 10 2>@ stderr" r+]
fileevent $cfd readable "gotline $cfd"
}
# send commands to child process.
# q means quit, others get echoed back to parent.
after 1500 {
global cfd
fputs $cfd "hello 1"
}
after 2500 {
global cfd
fputs $cfd "hello 2"
}
after 3500 {
global cfd
fputs $cfd "hello 3"
}
after 6500 {
global cfd
fputs $cfd q
}
pa
# vwait gives us an event loop
# it returns when the child exits
vwait done
# end of parent/client
# <<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>>
} else {
# <<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>><<>>
# beginning of child/server
# if invoked with args.
# child process, ticks every second.
# waits for stdin with fileevent.
# echoes stdin back to stdout.
# done gets set when the parent exits
global done
# gotline gets called on each line of input
proc gotline f {
global done
if {[gets $f line]<0} {
# it died !
catch {close $f}
set done 1
return
}
# if parent sends quit, then quit.
if [string match q* $line] {
puts "child: got quit - $line"
set done 1
return
}
# else echo the input
puts "child: got ==> $line"
}
fileevent stdin readable "gotline stdin"
# print a tick every second, for n seconds, counting down.
proc tick {n} {
global done
if {$n <= 0} {
set done 1
return
}
puts "tick: $n"
incr n -1
after 1000 tick $n
}
set arg1 [lindex $argv 0]
tick $arg1
vwait done
}
Also see "Simple Server/Client Sockets" and telnet.