coserv.tcl

Go to the documentation of this file.

/*  -*- 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.*/

/*  Can assume that tcltest is present, and its commands imported into*/
/*  the global namespace.*/

/*  ### ### ### ######### ######### #########*/
/*  Load "comm" into the master.*/

namespace ::coserv {variable subcode {}}

package forget comm
catch {namespace delete comm}

if {[package vsatisfies [package present Tcl] 8.5]} {
     ::coserv = ::snitsrc [file join [file dirname [file dirname [info script]]] snit snit2.tcl]
} else {
     ::coserv = ::snitsrc [file join [file dirname [file dirname [info script]]] snit snit.tcl]
}
 ::coserv = ::commsrc [file join [file dirname [file dirname [info script]]] comm comm.tcl]

if {[catch {source $::coserv::snitsrc} msg]} {
    puts "Error 
    error ""
}
if {[catch {source $::coserv::commsrc} msg]} {
    puts "Error 
    error ""
}

package require comm

puts "- coserv (comm server)"
/* puts "Main       @ [::comm::comm self]"*/

/*  ### ### ### ######### ######### #########*/
/*  Core of all sub processes.*/

ret  ::coserv::setup () {
    variable subcode
    if {$subcode != {}} return
    set 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 {snitsrc 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 $snitsrc
    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] ; # {}
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Command used by sub processes to signal that they are ready.*/

ret  ::coserv::ready (type cookie , type id) {
    #puts "Sub server @ $id\t\[$cookie\]"
    set ::coserv::go $id
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Start a new sub server process, talk to it.*/

ret  ::coserv::start (type cookie) {
    variable subcode
    variable snitsrc
    variable commsrc
    variable go

    set go {}

    setup
    exec [info nameofexecutable] $subcode \
        $snitsrc $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
}

ret  ::coserv::run (type id , type script) {
    return [comm::comm send $id $script]
}

ret  ::coserv::task (type id , type script) {
    comm::comm send -async $id $script
    return
}

ret  ::coserv::shutdown (type id) {
    variable subcode
    #puts "Sub server @ $id\tShutting down ..."
    task $id exit
    tcltest::removeFile $subcode
    set subcode {}
    return
}

/*  ### ### ### ######### ######### #########*/