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
    }
        
}