Matthias Hoffmann - Tcl-Code-Snippets - Misc - Bgexec

Starting Process-Pipelines in the backgound, collecting their output via configurable callback. Requires the event loop to be running.

For a Object oriented variant, scroll down...


History until 1.7

  • 1.8: fixed version check [expr {[info patchlevel] >= "8.4.7"}] which does of course not always gave the right result ;-)
  • 1.9: Optionally signal EOF to given eofHandler
  • 1.10: fixed bug: number_of_processes remain incremented even if "open |..." failed. Now incr late.
  • 1.11: llength instead of string length for some tests. Calling EOF-handler when processing terminates via readhandler-break.
  • 1.12: bugfix: preventing invalid processcounter w/timeout (I hope). Only used a few hours...
  • 1.13: eof handler not fired if user readhandler breaks. logik of user timeout handler now equals user read handler.
  • 1.14: see script header
  • 1.15: Optional Err Handler. Internal changes.

BgExec-Procedure v1.16

 ################################################################################
 # Modul    : bgexec.tcl 1.16                                                   #
 # Changed  : 16.10.2015                                                        #
 # Purpose  : running processes in the background, catching their output via    #
 #            event handlers                                                    #
 # Author   : M.Hoffmann                                                        #
 # Hinweise : >&@ and 2>@stdout don't work on Windows. A work around probably   #
 #            could be using a temporay file. Beginning with Tcl 8.4.7 / 8.5    #
 #            there is another (yet undocumented) way of redirection: 2>@1.     #
 # History  :                                                                   #
 # 19.11.03 v1.0 1st version                                                    #
 # 20.07.04 v1.1 callback via UPLEVEL                                           #
 # 08.09.04 v1.2 using 2>@1 instead of 2>@stdout if Tcl >= 8.4.7;               #
 #               timeout-feature                                                #
 # 13.10.04 v1.3 bugfix in bgExecTimeout, readHandler is interruptable          #
 # 18.10.04 v1.4 bugfix: bgExecTimeout needs to be canceled when work is done;  #
 #               some optimizations                                             #
 # 14.03.05 v1.4 comments translated to english                                 #
 # 17.11.05 v1.5 If specidied, a user defined timeout handler `toExit` runs in  #
 #               case of a timeout to give chance to kill the PIDs given as     #
 #               arg. Call should be compatible (optional parameter).           #
 # 23.11.05 v1.6 User can give additional argument to his readhandler.          #
 # 03.07.07 v1.7 Some Simplifications (almost compatible, unless returned       #
 #               string where parsed):                                          #
 #               - don't catch error first then returning error to main...      #
 # 08.10.07 v1.8 fixed buggy version check!                                     #
 # 20.02.12 v1.9 Optionally signal EOF to eofHandler.                           #
 # 13.09.14 v1.10 bugfix: incr myCount later (in case of an (open)error it was  #
 #               erranously incremented yet)                                    #
 # 22.02.15 v1.11 llength instead of string length for some tests. Calling EOF- #
 #               handler when processing terminates via readhandler-break.      #
 # 28.02.15 v1.12 bugfix: preventing invalid processcounter w/timeout (I hope). #
 # 02.03.15 v1.13 eof handler not fired if user readhandler breaks.             #
 #               Logic of user timeout handler now equals user read handler.    #
 # 21.03.15 v1.14 Testing EOF right after read (man page); -buffering line.     #
 # 21.03.15 v1.15 CATCHing gets. New optional errHandler. Logic changed.        #
 # 16.10.15 v1.16 Bugfix: missing return after user-readhandler CATCHed.        #
 # ATTENTION: closing a pipe leads to error broken pipe if the opened process   #
 #             itself is a tclsh interpreter. Currently I don't know how to     #
 #             avoid this without killing the process via toExit before closing #
 #             the pipeline.                                                    #
 # - This Code uses one global var, the counter of currently started pipelines. #
 # TODO: Namespace or OO to clean up overall design.                            #
 ################################################################################

 # ATTENTION: This is the last version which maintains upward compatibility (I hope)
 package provide bgexec 1.16

 #-------------------------------------------------------------------------------
 # If the <prog>ram successfully starts, its STDOUT and STDERR is dispatched
 # line by line to the <readHandler> (via bgExecGenericHandler) as last arg. The
 # global var <pCount> holds the number of processes called this way. If a <timeout>
 # is specified (as msecs), the process pipeline will be automatically closed after
 # that duration. If specified, and a timeout occurs, <toExit> is called with the
 # PIDs of the processes right before closing the process pipeline.
 # Returns the handle of the process-pipeline.
 #
 proc bgExec {prog readHandler pCount {timeout 0} {toExit ""} {eofHandler ""} {errHandler ""}} {
      upvar #0 $pCount myCount
      set p [expr {[lindex [lsort -dict [list 8.4.7 [info patchlevel]]] 0] == "8.4.7"?"| $prog 2>@1":"| $prog 2>@stdout"}]
      set pH [open $p r]
      # Possible Problem if both after event and fileevents are delayed (no event loop) until timeout fires;
      # ProcessCount is then decremented before ever incremented. So increment ProcessCount early!
      set myCount [expr {[info exists myCount]?[incr myCount]:1}]; # precaution < 8.6
      fconfigure $pH -blocking 0 -buffering line
      set tID [expr {$timeout?[after $timeout [list bgExecTimeout $pH $pCount $toExit]]:{}}]
      fileevent $pH readable [list bgExecGenericHandler $pH $pCount $readHandler $tID $eofHandler $errHandler]
      return $pH
 }
 #-------------------------------------------------------------------------------
 proc bgExecGenericHandler {chan pCount readHandler tID eofHandler errHandler} {
      upvar #0 $pCount myCount
      if {[catch {gets $chan line} result]} {
         # read error -> abort processing. NOTE eof-handler NOT fired!
         after cancel $tID
         catch {close $chan}
         incr myCount -1
         if {[llength $errHandler]} {
            catch {uplevel $errHandler $chan $result}
         }
         return
      } elseif {$result >= 0} {
         # we got a whole line
         lappend readHandler $line; # readhandler doesn't get the chan...
         if {[catch {uplevel $readHandler}]} {
            # user-readHandler ended with errorcode which means here
            # "terminate the processing". NOTE eof-handler NOT fired!
            after cancel $tID
            catch {close $chan}
            incr myCount -1
            return
         }
      }; # not enough data (yet)
      if {[eof $chan]} {
         after cancel $tID; # terminate Timeout, no longer needed! 
         catch {close $chan}; # automatically deregisters the fileevent handler
         incr myCount -1
         if {[llength $eofHandler]} {
            catch {uplevel $eofHandler $chan}; # not called on timeout or user-break
         }
      }
 }
 #-------------------------------------------------------------------------------
 proc bgExecTimeout {chan pCount toExit} {
      upvar #0 $pCount myCount
      if {[llength $toExit]} {
         # The PIDs are one arg (list)
         if {[catch {uplevel [list {*}$toExit [pid $chan]]}]} {
            # user-timeoutHandler ended with error which means here
            # "we didn't kill the processes" (such a kill would have
            # normally triggered an EOF, so no other cleanup would be
            # required then), so end the processing explicitely and do
            # the cleanup. NOTE eof-handler NOT fired!
            catch {close $chan}
            incr myCount -1
         }
      } else {
         # No user-timeoutHandler exists, we must cleanup anyway
         #  NOTE eof-handler NOT fired!
         catch {close $chan}
         incr myCount -1
      }
 }
 #===============================================================================

So, what is this program for at all?

  • keep the user interface responding!
  • parallelizing processes

A user interface could be

  • A long running command line procedure
  • A long running CGI proc
  • A Tk interface

If you simply exec a long running external program, waiting around for it's output, the user interface will be blocked meanwhile. If you start it in the background with & and some redirection, you can continue with your process, but you have to detect and wait until the external program finishes before you can open the wanted file(s) with the program feedback (output). It would be better if the user begins receiving feedback as soon as possible, especially with webservers/cgi-scripts - that's what I wrote this module for originally. You quickly see the first output record of the called program. After all it's just a wrapper for open |prog and fileevent... However, there are some performance drawbacks driving programs this way.

Remarks

  • Due to TCL's lack of process killing cababilities, it's likely that processes continue to run in some state where they lost their stdout/stderr-channels after a timeout arised. Closing the TCL-channels doesn't seem to help. So it is better to additionally use an external process killer (many of them are available on windows). The "kill" subcommand of the TclX package works fine for this. With version 1.5, this can be triggered automatically via the new UserExit toExit , so the user can decide which process killer to use.
  • As of tcl 8.4.11.2, the 2>@1 still seems to be undocumented.... As of Tcl 8.4.11.2, 2>@1 is still undocumented.... (still seeing and hoping)

Remark: The following procs are not always up to date'

Testproc bgexec1.6_test.tcl

 # Testing and demonstrating bgExec v1.6
 # 23.11.2005

 lappend auto_path .
 package require bgexec 1.6

 proc dummy {userdata what} {
      # data from delayout1 & 3
      puts >>>$what<<<$userdata
 }

 proc dummy2 {userdata what} {
      # data from delayout2
      puts >>>$what<<<$userdata
      return -code error {Break triggerd via ReadHandler}
 }

 proc time {} {
      puts [clock format [clock seconds]]
      after 1000 [list time]
 }

 proc toExit {PIDs} {
      puts "Timeoutexit: $PIDs; trying to kill process"
      # avoid 'broken pipe'
      foreach PID $PIDs {
          # for PV, see http://www.xmlsp.com/pview/prcview.htm
          catch {exec -- [auto_execok pv] -k -f -i $PID} rc
          puts $rc
      }
 }

 after 1000 [list time]

 set h1 [bgExec "[info nameofexe] delayout1.tcl" [list dummy *1*] pCount]
 puts "Handle: $h1"
 catch {puts [pid $h1]}
 set h2 [bgExec "[info nameofexe] delayout2.tcl" [list dummy2 *2*] pCount]
 puts "Handle: $h2"
 catch {puts [pid $h2]}
 set h3 [bgExec "[info nameofexe] delayout3.tcl" [list dummy *3*]  pCount 5000 toExit]
 puts "Handle: $h3"
 catch {puts [pid $h3]}
 puts "pCount: $pCount"

 # alternative: vwait pCount (problematic as pCount has to be GLOBAL)
 while {$pCount > 0} {
       vwait pCount
       puts "pCount: $pCount"
       # or: update; # not: update idletasks!
 }
 puts "pCount (after loop): $pCount"

And the three-Testsubprocs:

delayout1.tcl:

 puts "1 output to STDOUT"
 puts "1 output to STDOUT"
 puts "1 output to STDOUT"
 puts stderr "1 output to STDERR"
 puts stderr "1 output to STDERR"
 puts stderr "1 output to STDERR - a normal end via EOF"

delayout2.tcl:

 puts "2 output to STDOUT - aborts after this, via UserReadHandler"
 puts "2 output to STDOUT"
 puts "2 output to STDOUT"
 puts stderr "2 output to STDERR"
 puts stderr "2 output to STDERR"
 puts stderr "2 output to STDERR"

delayout3.tcl:

 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR"
 after 3000
 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR"
 after 3000
 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts "3 output to STDOUT"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR"
 puts stderr "3 output to STDERR - this is not displayed anymore - script's ending somewhere before after 5000s via timeout"

To test everything:

  • do tclsh bgexec1.6_test.tcl

Output should appear similar to the following:

 Handle: file798570
 1336
 Handle: file841908
 1368
 2 Output To STDERR
 2 Output To STDERR
 2 Output To STDERR
 Handle: file840d08
 1380
 pCount: 3
 >>>2 Output To STDOUT - should be the last one due to Break via UserReadHandler<
 <<*2*
 pCount: 2
 >>>1 Output To STDOUT<<<*1*
 >>>1 Output To STDOUT<<<*1*
 >>>1 Output To STDOUT<<<*1*
 1 Output To STDERR
 1 Output To STDERR
 1 Output To STDERR - should normally end via EOF
 pCount: 1
 >>>3 Output To STDOUT<<<*3*
 >>>3 Output To STDOUT<<<*3*
 >>>3 Output To STDOUT<<<*3*
 3 Output To STDERR
 3 Output To STDERR
 3 Output To STDERR
 Wed Nov 23 09:50:17 Westeuropäische Normalzeit 2005
 Wed Nov 23 09:50:18 Westeuropäische Normalzeit 2005
 Wed Nov 23 09:50:19 Westeuropäische Normalzeit 2005
 >>>3 Output To STDOUT<<<*3*
 3 Output To STDERR
 3 Output To STDERR
 3 Output To STDERR
 >>>3 Output To STDOUT<<<*3*
 >>>3 Output To STDOUT<<<*3*
 Wed Nov 23 09:50:20 Westeuropäische Normalzeit 2005
 Wed Nov 23 09:50:21 Westeuropäische Normalzeit 2005
 Timeoutexit: 1380; trying to kill process
   Killing '1380'
 tclsh.exe       (1380)
 pCount: 0
 pCount (after loop): 0

LES: This looks interesting. Would someone be willing to translate and rewrite the comments and strings in English? M.H.: translated! I hope my english is not too bad to understand the code... If someone would review the code and we are able to make it fool proof, it would be a nice addition to tcllib...


How does this compare to BLT's bgexec function? MHo I don't know; it must be similar. But I don't need BLT for my bgExec, so my scripts keep small...

US BLT's bgexec belongs into Tcl's core. For ages. MHo But it's not there yet...


Test whats happening if calling a GUI-App through bgExec:

 # Testing and demonstrating bgExec v1.6, (2)
 # Test what happens if calling a 32bit-GUI-Tool
 # 23.11.2005

 lappend auto_path [pwd]
 package require bgexec 1.6

 proc dummy {what} {
      puts >>>$what<<<
 }

 set h1 [bgExec notepad.exe dummy pCount]
 vwait pCount

It seems to work! The program is blocking, though.

Remarks: unfortunally, STDERR-CATCHing with 2>@ doesn't seems to work with Windows 2000...... For 8.4.7 and above, there is or will be a fix, see https://www.tcl-lang.org/cgi-bin/tct/tip/202.html .


MB : Inspired by this package, I extended the bgexec command features and moved it into a SNIT class. The code is publicly available in the Tclrep project, in the module jobexec :

http://tclrep.cvs.sourceforge.net/viewvc/tclrep/modules/jobexec/

The jobexec class provides the method waitend, which allows to synchronize different jobs which were executed in background (this feature is not available in the current bgexec implementation). The waitend method is based on the vwait Tcl command presented earlier on this page.

I also developped the jobscheduler class, which allows to schedule a list of jobs, then to executes them all in background until all are processed. The algorithm is so that at most nbprocs jobs are running at the same time. See jobscheduler.tcl in the Tclrep project for more details.


MHo 2017-07-11: Here's my OO-variant of bgExec. There are some handling differences, see below.

oo::class create bgExec {
        self variable objNr
        self method nextObjNr {} {incr objNr}
        self method activeObjects {} {info class instances bgExec}
        self method activeObjectsCount {} {llength [my activeObjects]}; # := vwaitvar
        ###
        # Generische Handler (werden über Fileevent gerufen, müssen also public sein...)
        # $obj wird an den Userhandler übergeben, da hierüber bei Bedarf zusätzliche
        # Daten gelesen werden können (siehe getInfos).
        # Signatur UserHandler: proc callback {obj type {data ""}}.
        self method onFileEvent {obj chan callback} {
             if {[catch {gets $chan line} result]} {
                $obj cancelTimeout
                catch {uplevel 1 [list {*}$callback $obj error $result]}; # Fehler vor Close melden
                $obj destroy
             } elseif {$result >= 0} {
                catch {uplevel 1 [list {*}$callback $obj data $line]}   ; # Daten vorhanden
             } else {
                catch {uplevel 1 [list {*}$callback $obj nodata]}       ; # keine Daten vorhanden (Idle)
             }
             if {[eof $chan]} {
                $obj cancelTimeout
                catch {uplevel 1 [list {*}$callback $obj eof]}          ; # End-of-File vor Close melden
                $obj destroy
             }
        }
        self method onTimeout {obj callback pids} {
             catch {uplevel 1 [list {*}$callback $obj timeout $pids]}   ; # Timeout vor Close melden
             $obj destroy
        }
        variable pipe cb chan timeoutID userData objNr waitvar
        constructor {pipeline callback args} {
             set options [dict create -timeout 0 -userdata "" -fconf "" -vwaitvar ::bgExecVwaitVar]
             set keys [dict keys $options]
             foreach {arg val} $args {
                  set key [lsearch -glob -nocase -inline $keys $arg*]
                  if {$key ne ""} {
                     dict set options $key $val
                  } else {
                     return -code error "invalid option. Allowed are: $keys."
                  }
             }
             set pipe $pipeline
             set cb $callback
             set fconf [dict merge {-blocking 0 -buffering line} [dict get $options -fconf]]
             set chan [open "| $pipeline 2>@1" r]; # aktuell wieder nur READ-Channel
             fconfigure $chan {*}$fconf
             if {[dict get $options -timeout]} {
                set timeoutID [after [dict get $options -timeout] [list bgExec onTimeout [self] $callback [pid $chan]]]
             } else {
                set timeoutID ""
             }
             set waitvar [dict get $options -vwaitvar]
             incr $waitvar
             set userData [dict get $options -userdata]
             set objNr [bgExec nextObjNr]
             fileevent $chan readable [list bgExec onFileEvent [self] $chan $callback]
        }
        destructor {
            my cancelTimeout
            catch {close $chan}; # falls nicht bereits explizit getätigt (catch erforderlich?)
            incr $waitvar -1
        }
        method getInfos {} {
            return [list $objNr $chan $pipe $userData $waitvar $timeoutID]
        }
        method cancelTimeout {} {
            if {$timeoutID ne ""} {
               after cancel $timeoutID
            }
        }
}

Noticable differences from the non-OO-bgExec (besides the fact that this uses TclOO ;-), most of which I see as enhancements, are:

  • Only one usercallback. The callback can decide what to do by means of an type-argument (data, nodata, error, eof)
  • For now, no clean possibility to interrupt the processing from the outside (other than calling $obj destroy...)
  • Possibility to assign "userdata" to an bgExec instance (for any purpose)
  • Possibility to specify fconfigure-options for the open channel
  • when the user callback is called in case of error or eof, the channel isn't already closed
  • From within the callback, the mainprog can read some additional state data via [getInfo] (so not every peace have to be transferred via proc args)
  • The constructor takes only two required parameters, the others are optional an can be specified via -key value-syntax in any order (keys can be shortend)
  • In Case of a timeout, the PID(s) of the timed out process(es) is/are delivered to the callback (for killing, etc.)

I tried to use a class variable for counting instances to vwait upon, but I didn't succeed. So again, one have to specify a global variable (default name ::bgExecVwaitVar).

Here's some test script (to be called with a milliseconds-timeout-value):

package require twapi; # optional

proc cb {dummy obj typ {data ""}} {
     lassign [$obj getInfos] objNr chan pipe userData waitvar timeoutID
     switch -nocase $typ {
        "eof" {
           set PIDs [pid $chan]
           catch {twapi::get_process_handle [lindex $PIDs end]} sysHandle
           catch {twapi::get_process_exit_code $sysHandle} sysRC
           puts "$objNr <EOF>, SysRC=$sysRC"
        }
        "timeout" {
           puts "$objNr <TIMEOUT>, PID(s)=$data"
        }
        "data" {
           puts "$objNr $data (userData=$userData, objNr=$objNr, dummy=$dummy, chan=$chan, pipe=$pipe, after=$timeoutID)"
        }
        "nodata" {
           puts "$objNr <IDLE>"
        }
        default {
           puts "<Fehler:> $data"
        }
     }
}
for {set i 1} {$i <= 3} {incr i} {
    set to [expr {[lindex $argv 0]+30}]
    puts "handle   -> [bgExec new "tclkitsh emitter.tcl $i" [list cb dummyArg] -user XYZ -t $to]"
    puts "count    -> [bgExec activeObjectsCount]"
    puts "objects  -> [bgExec activeObjects]"
    puts "afterIDs -> [after info]"
    puts "waitVar  -> $::bgExecVwaitVar"
}
puts "Entering event loop..."
while {$::bgExecVwaitVar > 0} {
    vwait ::bgExecVwaitVar
    puts "count    -> [bgExec activeObjectsCount]"
    puts "objects  -> [bgExec activeObjects]"
    puts "afterIDs -> [after info]"
    puts "waitVar  -> $::bgExecVwaitVar"
}
bgExec new "tclkitsh emitter.tcl 99" -wrongparm falsch

Test output looks like this:

d:\home\Hoffmann\pgm\tcl\usr\Tst\ooBgExec>tclkitsh ooBgExec.tcl 170
handle   -> ::oo::Obj26
count    -> 1
objects  -> ::oo::Obj26
afterIDs -> after#0
waitVar  -> 1
handle   -> ::oo::Obj27
count    -> 2
objects  -> ::oo::Obj26 ::oo::Obj27
afterIDs -> after#1 after#0
waitVar  -> 2
handle   -> ::oo::Obj28
count    -> 3
objects  -> ::oo::Obj26 ::oo::Obj27 ::oo::Obj28
afterIDs -> after#2 after#1 after#0
waitVar  -> 3
Entering event loop...
3 3 - Zeile  1 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  2 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  3 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  4 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  5 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  6 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  7 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  8 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 3 - Zeile  9 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 <IDLE>
3 3 - Zeile 10 (userData=XYZ, objNr=3, dummy=dummyArg, chan=file3c093e0, pipe=tclkitsh emitter.tcl 3, after=after#2)
3 <EOF>, SysRC=3
count    -> 2
objects  -> ::oo::Obj26 ::oo::Obj27
afterIDs -> after#1 after#0
waitVar  -> 2
2 2 - Zeile  1 (userData=XYZ, objNr=2, dummy=dummyArg, chan=file3c091e0, pipe=tclkitsh emitter.tcl 2, after=after#1)
2 2 - Zeile  2 (userData=XYZ, objNr=2, dummy=dummyArg, chan=file3c091e0, pipe=tclkitsh emitter.tcl 2, after=after#1)
1 <TIMEOUT>, PID(s)=6308
count    -> 1
objects  -> ::oo::Obj27
afterIDs -> after#1
waitVar  -> 1
2 2 - Zeile  3 (userData=XYZ, objNr=2, dummy=dummyArg, chan=file3c091e0, pipe=tclkitsh emitter.tcl 2, after=after#1)
2 <TIMEOUT>, PID(s)=4604
count    -> 0
objects  ->
afterIDs ->
waitVar  -> 0
invalid option. Allowed are: -timeout -userdata -fconf -vwaitvar.
    while executing
"bgExec new "tclkitsh emitter.tcl 99" -wrongparm falsch"
    (file "ooBgExec.tcl" line 122)

d:\home\Hoffmann\pgm\tcl\usr\Tst\ooBgExec>

The program emitter.tcl is as follows:

for {set i 1} {$i < 10} {incr i} {
    puts [format {%s - Zeile %2i} [lindex $argv 0] $i]
}
puts -nonewline [format {%s - Zeile %2i} [lindex $argv 0] $i]
exit [lindex $argv 0]

The code is also available at http://chiselapp.com/user/MHo/repository/tcl-modules/index


MHo 2019-11-14: Turns out that the above code had some bugs. Fixed them as follows:

package require TclOO
package require Tcl 8.5
package provide oobgexec1 0.1

oo::class create bgExec {
        self variable objNr
        self method nextObjNr {} {incr objNr}
        self method activeObjects {} {info class instances bgExec}
        self method activeObjectsCount {} {llength [my activeObjects]}; # := vwaitvar
        ###
        # Generische Handler (werden über Fileevent gerufen, müssen also public sein...)
        # $obj wird an den Userhandler übergeben, da hierüber bei Bedarf zusätzliche
        # Daten gelesen werden können (siehe getInfos).
        # Signatur UserHandler: proc callback {obj type {data ""}}.
        self method onFileEvent {obj chan callback} {
             if {[catch {gets $chan line} result]} {
                $obj cancelTimeout
                catch {uplevel 1 [list {*}$callback $obj error $result]}; # Fehler vor Close melden
                $obj destroy
             } elseif {$result >= 0} {
                catch {uplevel 1 [list {*}$callback $obj data $line]}   ; # Daten vorhanden
             } else {
                catch {uplevel 1 [list {*}$callback $obj nodata]}       ; # keine Daten vorhanden (Idle)
             }
             if {[eof $chan]} {
                $obj cancelTimeout
                catch {uplevel 1 [list {*}$callback $obj eof]}          ; # End-of-File vor Close melden
                $obj destroy
             }
        }
        self method onTimeout {obj callback pids} {
             catch {uplevel 1 [list {*}$callback $obj timeout $pids]}   ; # Timeout vor Close melden
             $obj destroy
        }
        variable pipe cb chan timeoutID userData objNr waitvar
        constructor {pipeline callback args} {
             set options [dict create -timeout 0 -userdata "" -fconf "" -vwaitvar ::bgExecVwaitVar]
             set keys [dict keys $options]
             foreach {arg val} $args {
                  set key [lsearch -glob -nocase -inline $keys $arg*]
                  if {$key ne ""} {
                     dict set options $key $val
                  } else {
                     return -code error "invalid option. Allowed are: $keys."
                  }
             }
             set pipe $pipeline
             set cb $callback
             set fconf [dict merge {-blocking 0 -buffering line} [dict get $options -fconf]]
             set timeoutID ""
             set waitvar [dict get $options -vwaitvar]; # schon hier, weil im Falle des Scheiterns
             incr $waitvar; # des open der Destruktor aufgerufen wird und dekrementiert!
             set chan [open "| $pipeline 2>@1" r]; # aktuell wieder nur READ-Channel
             fconfigure $chan {*}$fconf
             if {[dict get $options -timeout]} {
                set timeoutID [after [dict get $options -timeout] [list bgExec onTimeout [self] $callback [pid $chan]]]
             }
             set userData [dict get $options -userdata]
             set objNr [bgExec nextObjNr]
             fileevent $chan readable [list bgExec onFileEvent [self] $chan $callback]
        }
        destructor {
            my cancelTimeout
            catch {close $chan}; # falls nicht bereits explizit getätigt (catch erforderlich?)
            incr $waitvar -1
        }
        method getInfos {} {
            return [list $objNr $chan $pipe $userData $waitvar $timeoutID]
        }
        method cancelTimeout {} {
            if {$timeoutID ne ""} {
               after cancel $timeoutID
            }
        }
}

[ Category Package | Category Interprocess Communication ]