1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
# -*- tcl -*-
# CoServ - Comm Server
# Copyright (c) 2004, Andreas Kupries <andreas_kupries@users.sourceforge.net>
# ### ### ### ######### ######### #########
## Commands to create server processes ready to talk to their parent
## via 'comm'. They assume that the 'tcltest' environment is present
## without having to load it explicitly. We do load 'comm' explicitly.
# ### ### ### ######### ######### #########
## Load "comm" into the master.
namespace eval ::coserv {}
package forget comm
catch {namespace delete comm}
set ::coserv::commsrc [file join [file dirname [file dirname [info script]]] comm comm.tcl]
if {[catch {source $::coserv::commsrc} msg]} {
puts "Error loading \"comm\": $msg"
error ""
}
package require comm
puts "- comm [package present comm]"
puts "Main @ [::comm::comm self]"
# ### ### ### ######### ######### #########
## Core of all sub processes.
set ::coserv::subcode [::tcltest::makeFile {
puts "Subshell is \"[info nameofexecutable]\""
catch {wm withdraw .}
# ### ### ### ######### ######### #########
## Get main configuration data out of the command line, i.e.
## - Id of the main process for sending information back.
## - Path to the sources of comm.
foreach {commsrc main cookie} $argv break
# ### ### ### ######### ######### #########
## Load and initialize "comm" in the sub process. The latter
## includes a report to main that we are ready.
source $commsrc
::comm::comm send $main [list ::coserv::ready $cookie [::comm::comm self]]
# ### ### ### ######### ######### #########
## Now wait for scripts sent by main for execution in sub.
#comm::comm debug 1
vwait forever
# ### ### ### ######### ######### #########
exit
} coserv.sub]
# ### ### ### ######### ######### #########
## Command used by sub processes to signal that they are ready.
proc ::coserv::ready {cookie id} {
puts "Sub server @ $id\t\[$cookie\]"
set ::coserv::go $id
return
}
# ### ### ### ######### ######### #########
## Start a new sub server process, talk to it.
proc ::coserv::start {cookie} {
variable subcode
variable commsrc
variable go
set go {}
exec [info nameofexecutable] $subcode \
$commsrc [::comm::comm self] $cookie &
puts "Waiting for sub server to boot"
vwait ::coserv::go
# We return the id of the server
return $::coserv::go
}
proc ::coserv::run {id script} {
return [comm::comm send $id $script]
}
proc ::coserv::task {id script} {
comm::comm send -async $id $script
return
}
proc ::coserv::shutdown {id} {
puts "Sub server @ $id\tShutting down ..."
task $id exit
}
# ### ### ### ######### ######### #########
|
