subproc.tcl

   1
   2 package require Tclx
   3
   4 namespace eval subproc {
   5
   6 #----- general purpose subprocess handling -----
   7 #
   8 # One useful procedure:
   9 #    subprocess::fork ONDEATH INCHILD
  10 # forks, evaluates INCHILD in the calling context but in the child
  11 # and when the child dies evaluates [concat [list ONDEATH] W2 W3]
  12 # where W2 and W3 are the 2nd and 3rd elements of the list returned
  13 # by tclx's wait.
  14 #
  15 # INCHILD should not return; if it does or if it gets an error, the
  16 # result is that the child gets a SIGKILL.
  17
  18 variable children
  19
  20 proc fork {ondeath inchild} {
  21     variable children
  22     global errorCode errorInfo
  23     foreach f {stdout stderr} {
  24         if {[catch { flush $f } emsg]} {
  25             catch { bgerror $emsg }
  26         }
  27     }
  28     set pid [::fork]
  29     if {!$pid} {
  30         if {[catch {
  31             uplevel 1 $inchild
  32         } emsg]} {
  33             puts stderr "CHILD ERROR $emsg\n$errorCode\n$errorInfo\n"
  34         }
  35         kill KILL [id process]
  36     }
  37     set children($pid) $ondeath
  38     return $pid
  39 }
  40
  41 proc chld-handler {} {
  42     variable children
  43     while 1 {
  44         if {[catch { set got [wait -nohang] }]} break
  45         if {![llength $got]} break
  46         manyset $got pid how how2
  47         if {[info exists children($pid)]} {
  48             set l $children($pid)
  49             unset children($pid)
  50             if {[catch {
  51                 uplevel #0 [concat [list $l] $how $how2]
  52             } emsg]} {
  53                 catch { bgerror $emsg }
  54             }
  55         }
  56     }
  57 }
  58
  59 signal -restart trap CHLD { after idle subproc::chld-handler }
  60
  61 }