BgExec-Procdure (now translated to english language)
################################################################################
# Modul : bgexec1.4.tcl #
# Changed : 14.03.2005 #
# Purpose : running processes in the background, catching there output via #
# event handers #
# Author : M.Hoffmann #
# To do : - rewrite using NAMESPACEs #
# - incorporate a way to call an external KILL when appropiate; #
# using close alone blocks console processes, e.g. #
# 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 (yes 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 #
################################################################################
package provide bgexec 1.4
#-------------------------------------------------------------------------------
# If the <prog>ram successfully starts, STDOUT and STDERR of it's process are
# dispateched line by line to the <readHandler> (via bgExecGenericHandler).
# <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. Returns the handle of the process-pipeline.
#
proc bgExec {prog readHandler pCount {timeout 0}} {
upvar #0 $pCount myCount
if {![string length [auto_execok [lindex $prog 0]]]} {
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]]:{}}]
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} {
upvar #0 $pCount myCount
catch {close $chan}
incr myCount -1
}
#===============================================================================Testproc bgexec1.4_test.tcl
proc dummy what {
puts >>>$what<<<
}
proc dummy2 what {
puts >>>$what<<<
return -code error {Abbruch im readHandler! (Test)}
}
lappend auto_path .
package require bgexec 1.4
proc zeit {} {
puts [clock format [clock seconds]]
after 1000 [list zeit]
}
after 1000 [list zeit]
set h1 [bgExec {tclsh delayout1.tcl} dummy pCount]
puts "Handle: $h1"
catch {puts [pid $h1]}
set h2 [bgExec {tclsh delayout2.tcl} dummy2 pCount]
puts "Handle: $h2"
catch {puts [pid $h2]}
set h3 [bgExec {tclsh delayout3.tcl} dummy pCount 5000]
puts "Handle: $h3"
catch {puts [pid $h3]}
puts "pCount: $pCount"
# Eventloop muss abgearbeitet werden
# Problem bei VWAIT: Kontrolle nur ��¼ber EINE globale Var, aber WER soll die WANN setzen?
# Also evtl. so:
while {$pCount > 0} {
update; # NICHT: update idletasks!
}
puts "pCount (nach Loop): $pCount"
# oder SO (bei nur einem Prozess!)
# vwait pCountAnd the three-Testsubprocs:
delayout1.tcl:
puts "1 Ausgabe auf STDOUT" puts "1 Ausgabe auf STDOUT" puts "1 Ausgabe auf STDOUT" puts stderr "1 Ausgabe auf STDERR" puts stderr "1 Ausgabe auf STDERR" puts stderr "1 Ausgabe auf STDERR - und jetzt normales Ende via EOF"
delayout2.tcl:
puts "2 Ausgabe auf STDOUT - endet nach dieser Ausgabe ��¼ber Abbruch via UserReadHandler" puts "2 Ausgabe auf STDOUT" puts "2 Ausgabe auf STDOUT" puts stderr "2 Ausgabe auf STDERR" puts stderr "2 Ausgabe auf STDERR" puts stderr "2 Ausgabe auf STDERR"
delayout3.tcl:
puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR" after 3000 puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR" after 3000 puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts "3 Ausgabe auf STDOUT" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR" puts stderr "3 Ausgabe auf STDERR - dieses Ende wird nicht mehr angezeigt - Ende nach 5000s via Timeout"
To test everything:
LES: This looks interesting. Would someone be willing to translate and rewrite the comments and strings in English? M.H.: I will do it myself, now that it looks that some more find these interesting ;-) The first part of the work is done... the examples will follow soon!