Posted to tcl by evilotto at Tue Dec 03 17:50:03 GMT 2013view pretty
# 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 } }