subproc.tcl

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