Предполагая, что вы делаете это в контексте графического интерфейса пользователя Tk…
Что вам нужно сделать, это запустить подпроцесс асинхронно, чтобы цикл событий GUI продолжал обслуживаться, пока подпроцесс работает.Это значительно проще сделать в вашем случае, если мы будем использовать Tcl 8.6 (или более позднюю версию), поскольку мы можем использовать сопрограмму для упрощения всего.
# A global variable that you can hook into the GUI to get a crash stop
set StopRightNow 0
coroutine doWget apply {{} {
global tout serverip url StopRightNow
while true {
set subprocess [open |[list wget.exe \
--no-check-certificate \
-q \
-O - \
-T $tout \
-t 1 \
$serverip$url]]
fconfigure $subprocess -blocking 0
# Arrange for the coroutine to resume whenever there's something to do
fileevent $subprocess readable [info coroutine]
set lines {}
while {![eof $subprocess]} {
yield
# Check for override!
if {$StopRightNow} return
if {[gets $subprocess line] >= 0} {
lappend lines $line
}
}
fconfigure $subprocess -blocking 1
if {![catch {close $subprocess} errors]} {
break
}
# Do something to handle the errors here...
puts "Problem when reading; will retry\n$errors"
}
# At this point, $lines has the list of lines read from the wget subprocess. For example:
puts "Read the output..."
foreach line $lines {
puts "[incr lineNumber]: $line"
}
}}
ОК, это немного большой кусок.Давайте разберем суть этого в процедуре.
proc asyncRunSubprocess args {
global StopRightNow
set subprocess [open |$args]
fconfigure $subprocess -blocking 0
# Arrange for the coroutine to resume whenever there's something to do
fileevent $subprocess readable [info coroutine]
# Accumulate the subprocess's stdout
set lines {}
while {![eof $subprocess]} {
yield
if {$StopRightNow} {
return {{} -1 interrupted {}}
}
if {[gets $subprocess line] >= 0} {
lappend lines $line
}
}
# Close down the subprocess; we've got an EOF
fconfigure $subprocess -blocking 1
set code [catch {close $subprocess} errors opts]
return [list $lines $code $errors $opts]
}
Затем мы можем сделать внешнюю сопрограмму такой:
coroutine doWget apply {{} {
global tout serverip url
while true {
set results [asyncRunSubprocess \
wget.exe --no-check-certificate -q -O - -T $tout -t 1 $serverip$url]
lassign $results lines code errors
if {$code < 0} return elseif {$code == 0} break
# Do something to handle the errors here...
puts "Problem when reading; will retry\n$errors"
}
# At this point, $lines has the list of lines read from the wget subprocess. For example:
puts "Read the output..."
foreach line $lines {
puts "[incr lineNumber]: $line"
}
}}
Обратите внимание, что сопрограммы Tcl (в отличие от многих других языков)вполне может приостановить выполнение процедур, которые они вызывают.