1: # commserver.tcl -- 2: 3: # This forks off an external server process with 'comm' loaded in it, 4: # for use as an IPC system. 5: 6: # Copyright 2003-2004 The Apache Software Foundation 7: 8: # Licensed under the Apache License, Version 2.0 (the "License"); 9: # you may not use this file except in compliance with the License. 10: # You may obtain a copy of the License at 11: 12: # http://www.apache.org/licenses/LICENSE-2.0 13: 14: # Unless required by applicable law or agreed to in writing, software 15: # distributed under the License is distributed on an "AS IS" BASIS, 16: # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 17: # See the License for the specific language governing permissions and 18: # limitations under the License. 19: 20: # $Id: commserver.tcl,v 1.4 2004/02/24 10:24:32 davidw Exp $ 21: 22: package provide commserver 0.1 23: 24: namespace eval ::commserver { 25: set Port 35100 26: set scriptlocation [info script] 27: set wait 5 28: } 29: 30: proc ::commserver::start {} { 31: variable Port 32: variable scriptlocation 33: variable wait 34: # Attempt to launch server. 35: exec [info nameofexecutable] \ 36: [file join [file dirname $scriptlocation] server.tcl] $Port & 37: 38: set starttime [clock seconds] 39: # If we don't get a connection in $wait seconds, abort. 40: while { [clock seconds] - $starttime < $wait } { 41: if { ![catch { 42: comm::comm send $Port { 43: puts stderr "Commserver server started on $Port" 44: } 45: }] } { 46: return 47: } 48: } 49: error "Connection to $Port failed after $wait seconds of trying." 50: } |