This tutorial will explain how to convert a synchronous program into an event driven program.
The starting program makes two HTTP requests and then compares the output. It does this in a synchronous fashion, sending one request, waiting for the response, sending the second request, waiting for the response and then it can process the data.
These type of synchronous requests will prevent the program from doing other processing in the event loop. Within a Tk program, this will lock up the GUI.
If the HTTP requests are large or the responding server slow, you may want to send out the HTTP requests simultaneously and wait for both responses to save time.
References:
The starting program (synchronous):
#!/usr/bin/tclsh
# tested 2017-8
package require http
proc fetchURL { url } {
set htoken {}
set htoken [http::geturl $url]
set ncode [::http::ncode $htoken]
set data [::http::data $htoken]
::http::cleanup $htoken
return [list $ncode $data]
}
proc processData { } {
lassign [fetchURL http://ballroomdj.org/versioncheck.txt] ncodeA dataA
lassign [fetchURL http://ballroomdj.org/versioncheck.html] ncodeB dataB
if { $ncodeA != 200 || $ncodeB != 200 } {
puts "HTTP error return"
} else {
set verA [string trim $dataA]
regexp {<p>([\d.]+)</p>} $dataB junk verB
if { $verA eq $verB } {
puts "version match ($verA)"
} else {
puts "version mismatch $verA/$verB"
}
}
}
proc main { } {
processData
}
mainThe first step is to change the ::http::geturl command to use its -command callback.
A global array is introduced to store the return values from the HTTP requests and to store other data items.
A tag value (A and B in this example) is passed to the fetchURL procedure to indicate under what name the data should be stored.
This tag is passed on to the ::http::geturl -command callback process.
As this tutorial uses a Tcl program, the event loop must be explicitly entered, and a vwait forever is added at the end of the program.
(Note: the after idle trick in the ::http::geturl -command callback prevents the http module from swallowing errors (it's a design bug in the http module). This will save you a lot of trouble debugging the program.)
# this is a code fragment
variable vars
proc httpProcess { tag htoken } {
variable vars
set ncode [::http::ncode $htoken]
set data [::http::data $htoken]
::http::cleanup $htoken
set vars(http.data.$tag) [list $ncode $data]
}
proc fetchURL { tag url } {
set htoken {}
set htoken [http::geturl $url -command \
[list after idle [list ::httpProcess $tag $callback]]]
}
...
proc processData { } {
fetchURL A http://ballroomdj.org/versioncheck.txt
fetchURL B http://ballroomdj.org/versioncheck.html
...
}
...
main
vwait foreverNow the program is broken. The HTTP return data is probably getting saved, but how does it get processed, and when?
It is tempting to say "I want to process this data when I get a good return value". But then the program will hang when an HTTP error occurs.
The trace facility from Tcl is used to track variable access. The HTTP callback will update a variable indicating completion. The HTTP callback must update upon any response, good or bad.
Two new values are added: one to say how many HTTP responses are expected and one to track how many HTTP requests have been processed. A trace command is added to track the HTTP completion counter and a new procedure is added to handle the completion.
# this is a code fragment
proc httpProcess { tag htoken } {
...
incr vars(http.return.count)
}
...
proc processCheck { } {
variable vars
if { $vars(http.return.count) >= $vars(http.return.expect) } {
trace remove variable vars(http.return.count) write ::processCheck
# do something
}
}
proc processData { } {
variable vars
set vars(http.return.count) 0
set vars(http.return.expect) 2
trace add variable vars(http.return.count) write ::processCheck
fetchURL A http://ballroomdj.org/versioncheck.txt
fetchURL B http://ballroomdj.org/versioncheck.html
}
In this example, there are two types of requests, and corresponding processes that need to be executed upon receipt of the data. Let's generalize that processing and configure it to happen when the HTTP request is received.
To do this, an additional callback routine is passed to the fetchUrl procedure. This callback routine is passed on to the httpProcess procedure which will call it upon receipt of the data. The httpProcess procedure will also pass the tag value on to the processing procedure so it knows which data set to work with.
# this is a code fragment
proc httpProcess { tag callback htoken } {
...
# the callback may be a list with additional arguments.
# the {*} operator will split it apart into words.
{*}$callback $tag
incr vars(http.return.count)
}
proc fetchURL { tag callback url } {
set htoken {}
set htoken [http::geturl $url -command \
[list after idle [list ::httpProcess $tag $callback]]]
}
proc processText { tag } {
variable vars
lassign $vars(http.data.$tag) ncode data
set vars(ncode.$tag) $ncode
set vars(data.$tag) {}
if { $ncode == 200 } {
set vars(data.$tag) [string trim $data]
}
}
proc processHTML { tag } {
variable vars
lassign $vars(http.data.$tag) ncode data
set vars(ncode.$tag) $ncode
set vars(data.$tag) {}
if { $ncode == 200 } {
regexp {<p>([\d.]+)</p>} $data junk vars(data.$tag)
}
}
...
proc processData { } {
fetchURL A ::processText http://ballroomdj.org/versioncheck.txt
fetchURL B ::processHTML http://ballroomdj.org/versioncheck.html
}
Now the final step is to actually do something when the HTTP requests are finished. Let's keep the processCheck procedure generic so that it can be used for other purposes.
# this is a code fragment
proc processFinal { } {
variable vars
if { $vars(ncode.A) != 200 || $vars(ncode.B) != 200 } {
puts "HTTP error return"
} else {
if { $vars(data.A) eq $vars(data.B) } {
puts "version match ($vars(data.A))"
} else {
puts "version mismatch $vars(data.A)/$vars(data.B)"
}
}
exit
}
proc processCheck { args } {
variable vars
if { $vars(http.return.count) >= $vars(http.return.expect) } {
trace remove variable vars(http.return.count) write ::processCheck
{*}$vars(finalproc)
}
}
proc processData { } {
...
set vars(finalproc) ::processFinal
...
}Now the program is finished. The procedures have been generalized for reuse. Our processing is contained within the processData and processFinal procedures.
The program is now event driven and other concurrent processing will proceed normally.
The final program (event driven):
#!/usr/bin/tclsh
# tested 2017-8
package require http
variable vars
proc httpProcess { tag callback htoken } {
variable vars
set ncode [::http::ncode $htoken]
set data [::http::data $htoken]
::http::cleanup $htoken
set vars(http.data.$tag) [list $ncode $data]
{*}$callback $tag
incr vars(http.return.count)
}
proc fetchURL { tag callback url } {
set htoken {}
set htoken [http::geturl $url -command \
[list after idle [list ::httpProcess $tag $callback]]]
}
proc processText { tag } {
variable vars
lassign $vars(http.data.$tag) ncode data
set vars(ncode.$tag) $ncode
set vars(data.$tag) {}
if { $ncode == 200 } {
set vars(data.$tag) [string trim $data]
}
}
proc processHTML { tag } {
variable vars
lassign $vars(http.data.$tag) ncode data
set vars(ncode.$tag) $ncode
set vars(data.$tag) {}
if { $ncode == 200 } {
regexp {<p>([\d.]+)</p>} $data junk vars(data.$tag)
}
}
proc processFinal { } {
variable vars
if { $vars(ncode.A) != 200 || $vars(ncode.B) != 200 } {
puts "HTTP error return"
} else {
if { $vars(data.A) eq $vars(data.B) } {
puts "version match ($vars(data.A))"
} else {
puts "version mismatch $vars(data.A)/$vars(data.B)"
}
}
exit
}
proc processCheck { args } {
variable vars
if { $vars(http.return.count) >= $vars(http.return.expect) } {
trace remove variable vars(http.return.count) write ::processCheck
{*}$vars(finalproc)
}
}
proc processData { } {
variable vars
set vars(http.return.count) 0
set vars(http.return.expect) 2
set vars(finalproc) ::processFinal
trace add variable vars(http.return.count) write ::processCheck
fetchURL A ::processText http://ballroomdj.org/versioncheck.txt
fetchURL B ::processHTML http://ballroomdj.org/versioncheck.html
}
proc main { } {
processData
}
main
vwait ::forever