'''BgExec-Procedure v1.5''' ################################################################################ # Modul : bgexec1.5.tcl # # Changed : 17.11.2005 # # Purpose : running processes in the background, catching there output via # # event handlers # # Author : M.Hoffmann # # To do : - rewrite using NAMESPACEs # # Hinweise : >&@ und 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 a (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). # # 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. # ################################################################################ package provide bgexec 1.5 #------------------------------------------------------------------------------- # If the ram successfully starts, STDOUT and STDERR of it's process are # dispatched line by line to the (via bgExecGenericHandler). # holds the number of processes called this way. If a is # specified (as msecs), the process pipeline will be automatically closed after # that duration. If specified, and a timeout occurs, 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 ""}} { upvar #0 $pCount myCount if {![string length [auto_execok [lindex $prog 0]]]} { # perhaps additional checking with [file executable] return -code error "error: could not locate '$prog'" } set myCount [expr {[info exists myCount]?[incr myCount]:1}] set redir [expr {[info patchlevel] >= "8.4.7"?{2>@1}:{2>@stdout}}] if [catch {open "| $prog $redir" r} pH] { return -code error "error: could not start '$prog' ($pH)" } fconfigure $pH -blocking 0; # -buffering line (does it really matter?!) set tID [expr {$timeout?[after $timeout [list bgExecTimeout $pH $pCount $toExit]]:{}}] fileevent $pH readable [list bgExecGenericHandler $pH $pCount $readHandler $tID] return $pH } #------------------------------------------------------------------------------- proc bgExecGenericHandler {chan pCount readHandler tID} { upvar #0 $pCount myCount if {[eof $chan]} { after cancel $tID; # empty tID is ignored catch {close $chan}; # automatically deregisters the fileevent handler # (see Practical Programming in Tcl an Tk, page 229) incr myCount -1 } elseif {[gets $chan line] != -1} { # we are not blocked (manpage gets, Practical... page.233) if {[catch {uplevel [list $readHandler $line]} rc]} { # user-readHandler ended with error -> terminate the processing after cancel $tID catch {close $chan} incr myCount -1 } } } #------------------------------------------------------------------------------- proc bgExecTimeout {chan pCount toExit} { upvar #0 $pCount myCount if {[string length $toExit]} { catch {uplevel [list $toExit [pid $chan]]} } catch {close $chan} incr myCount -1 } #=============================================================================== ---- '''So, what is this program for at all?''' It is for '''keeping the user interface responding'''! 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. 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. '''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). 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) ---- '''Testproc bgexec1.5_test.tcl''' # Testing and demonstrating bgExec v1.5 # 17.11.2005 lappend auto_path . package require bgexec 1.5 proc dummy what { # data from delayout1 & 3 puts >>>$what<<< } proc dummy2 what { # data from delayout2 puts >>>$what<<< 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" dummy pCount] puts "Handle: $h1" catch {puts [pid $h1]} set h2 [bgExec "[info nameofexe] delayout2.tcl" dummy2 pCount] puts "Handle: $h2" catch {puts [pid $h2]} set h3 [bgExec "[info nameofexe] delayout3.tcl" dummy 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 # 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.5_test.tcl''' ---- [LES]: This looks interesting. Would someone be willing to translate and rewrite the comments and strings in English? '''M.H.''': translated! 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.