Posted to tcl by evilotto at Tue Dec 03 17:50:03 GMT 2013view raw

  1. # simple queuer
  2.  
  3. Url_PrefixInstall /queue Simple_Queue::handle -readpost 1
  4.  
  5. package require struct
  6.  
  7. namespace eval ::Simple_Queue {
  8.  
  9. proc handle {sock suffix} {
  10. upvar #0 Httpd$sock data
  11.  
  12. set qn ::Simple_Queue::queues::$suffix
  13. set rq ::Simple_Queue::responses::$suffix
  14. if {[info commands $qn] == ""} {
  15. struct::queue $qn
  16. struct::queue $rq
  17. }
  18.  
  19. if {$data(proto) == "POST"} {
  20. $qn put $data(query)
  21. respond $rq
  22. if {[$qn size] > 100} {
  23. after 500 [list Httpd_ReturnData $sock "text/plain" "message accepted\n" 202]
  24. } else {
  25. Httpd_ReturnData $sock "text/plain" "message accepted\n" 202
  26. }
  27. } elseif {$data(proto) == "GET"} {
  28. $rq put [list $sock $qn [after 120000 [namespace code [list timeout $rq]]]]
  29. respond $rq
  30. } else {
  31. Httpd_ReturnData $sock "text/plain" "$data(proto) not implemented\n" 501
  32. }
  33. }
  34.  
  35. proc respond {rq} {
  36. if {[$rq size] == 0} return
  37. set rt [$rq peek]
  38. set qn [lindex $rt 1]
  39. if {[$qn size] > 0} {
  40. Httpd_ReturnData [lindex $rt 0] "text/plain" [$qn get] 200
  41. after cancel [lindex $rt 2]
  42. $rq get
  43. } else {
  44. return
  45. }
  46. }
  47.  
  48. proc timeout {rq} {
  49. set rt [$rq get]
  50. Httpd_ReturnData [lindex $rt 0] "text/plain" timeout 204
  51. }
  52.  
  53. }