Posted to tcl by evilotto at Tue Dec 03 17:50:03 GMT 2013view raw
- # simple queuer
- Url_PrefixInstall /queue Simple_Queue::handle -readpost 1
- package require struct
- namespace eval ::Simple_Queue {
- proc handle {sock suffix} {
- upvar #0 Httpd$sock data
- set qn ::Simple_Queue::queues::$suffix
- set rq ::Simple_Queue::responses::$suffix
- if {[info commands $qn] == ""} {
- struct::queue $qn
- struct::queue $rq
- }
- if {$data(proto) == "POST"} {
- $qn put $data(query)
- respond $rq
- if {[$qn size] > 100} {
- after 500 [list Httpd_ReturnData $sock "text/plain" "message accepted\n" 202]
- } else {
- Httpd_ReturnData $sock "text/plain" "message accepted\n" 202
- }
- } elseif {$data(proto) == "GET"} {
- $rq put [list $sock $qn [after 120000 [namespace code [list timeout $rq]]]]
- respond $rq
- } else {
- Httpd_ReturnData $sock "text/plain" "$data(proto) not implemented\n" 501
- }
- }
- proc respond {rq} {
- if {[$rq size] == 0} return
- set rt [$rq peek]
- set qn [lindex $rt 1]
- if {[$qn size] > 0} {
- Httpd_ReturnData [lindex $rt 0] "text/plain" [$qn get] 200
- after cancel [lindex $rt 2]
- $rq get
- } else {
- return
- }
- }
- proc timeout {rq} {
- set rt [$rq get]
- Httpd_ReturnData [lindex $rt 0] "text/plain" timeout 204
- }
- }