# 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
 }