haiv icon

Processes-main.tcl

haiv | PRO | 01/23/13 04:57:48 AM UTC | 0 ⭐ | 446 👁️ | Never ⏰ | []
TCL |

2.52 KB

|

None

|

0 👍

/

0 👎

#!/usr/bin/env tclsh
 
# Launches many processes and wait for them to finish.
# This script will works on systems that has the ps command such as
# BSD, Linux, and OS X
 
package require Tclx; # For process-management utilities
package require struct::set
 
proc updatePidList {stat} {
    global pidList
    global allFinished
 
    # Parse the process ID of the just-finished process
    lassign $stat processId howProcessEnded exitCode
 
    # Remove this process ID from the list of process IDs
    #set pidList [lindex [intersect3 $pidList $processId] 0]
    struct::set exclude pidList $processId
    set processCount [llength $pidList]
 
    # Occasionally, a child process quits but the signal was lost. This
    # block of code will go through the list of remaining process IDs
    # and remove those that has finished
    set updatedPidList {}
    foreach pid $pidList {
        if {![catch {exec ps $pid} errmsg]} {
            lappend updatedPidList $pid
        }
    }
 
    set pidList $updatedPidList
 
    # Show the remaining processes
    if {$processCount > 0} {
        puts "Waiting for [struct::set size $pidList] processes"
    } else {
        set allFinished 1
        puts "All finished"
    }
}
 
# A signal handler that gets called when a child process finished.
# This handler needs to exit quickly, so it delegates the real works to
# the proc updatePidList
proc childTerminated {} {
    # Restart the handler
    signal -restart trap SIGCHLD childTerminated
 
    # Update the list of process IDs
    while {![catch {wait -nohang} stat] && $stat ne {}} {
        after idle [list updatePidList $stat]
    }
}
 
#
# Main starts here
#
 
puts "Main begins"
set pidList {}
set allFinished 0
 
# When a child process exits, call proc childTerminated
signal -restart trap SIGCHLD childTerminated
 
# Spawn 3 processes
set childId [exec tclsh child.tcl 1 7 &]; #  #1 runs for 7 secs
struct::set include pidList $childId
 
set childId [exec tclsh child.tcl 2 5 &]; # #2 runs for 5 secs
struct::set include pidList $childId
 
set childId [exec tclsh child.tcl 3 20 &]; #3 runs for 20 secs
struct::set include pidList $childId
 
# Do some processing
puts "list of processes: $pidList"
puts "Waiting for child processes to finish"
# Do some more processing if required
 
# After all done, wait for all to finish before exiting
# Will time out in 2 minutes
after 120000 { set allFinished "timedout" }
vwait allFinished
 
if {$allFinished == "timedout"} {
    puts "Timed out"
}
puts "Main ends"

Comments